From 8905383e2d17e2adb4097e1ce2e7f90ab9ceb5f5 Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 10:58:00 +0200 Subject: compiler: split ItemProcessors, FileProcessors and Caching --- compiler/src/FileProcessors.hs | 95 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 compiler/src/FileProcessors.hs (limited to 'compiler/src/FileProcessors.hs') diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs new file mode 100644 index 0000000..8ea04d1 --- /dev/null +++ b/compiler/src/FileProcessors.hs @@ -0,0 +1,95 @@ +-- ldgallery - A static generator which turns a collection of tagged +-- pictures into a searchable web gallery. +-- +-- Copyright (C) 2019-2020 Pacien TRAN-GIRARD +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as +-- published by the Free Software Foundation, either version 3 of the +-- License, or (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see . + +module FileProcessors + ( FileProcessor + , copyFileProcessor + , resizePictureUpTo + , resourceAt + , getImageResolution + , ItemDescriber + , getPictureProps + ) where + + +import Control.Exception (Exception, throwIO) +import System.Process (readProcess, callProcess) +import Text.Read (readMaybe) + +import System.Directory (getModificationTime) +import qualified System.Directory + +import Config (Resolution(..)) +import Resource (Resource(..), GalleryItemProps(..)) +import Files + + +data ProcessingException = ProcessingException FilePath String deriving Show +instance Exception ProcessingException + +type FileProcessor = + FileName -- ^ Input path + -> FileName -- ^ Output path + -> IO () + +copyFileProcessor :: FileProcessor +copyFileProcessor inputPath outputPath = + putStrLn ("Copying:\t" ++ outputPath) + >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath + +resizePictureUpTo :: Resolution -> FileProcessor +resizePictureUpTo maxResolution inputPath outputPath = + putStrLn ("Generating:\t" ++ outputPath) + >> ensureParentDir (flip resize) outputPath inputPath + where + maxSize :: Resolution -> String + maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" + + resize :: FileName -> FileName -> IO () + resize input output = callProcess "magick" + [ input + , "-auto-orient" + , "-resize", maxSize maxResolution + , output ] + + +resourceAt :: FilePath -> Path -> IO Resource +resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath + +getImageResolution :: FilePath -> IO Resolution +getImageResolution fsPath = + readProcess "magick" ["identify", "-format", "%w %h", firstFrame] [] + >>= parseResolution . break (== ' ') + where + firstFrame :: FilePath + firstFrame = fsPath ++ "[0]" + + parseResolution :: (String, String) -> IO Resolution + parseResolution (widthString, heightString) = + case (readMaybe widthString, readMaybe heightString) of + (Just w, Just h) -> return $ Resolution w h + _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." + + +type ItemDescriber = + FilePath + -> Resource + -> IO GalleryItemProps + +getPictureProps :: ItemDescriber +getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath -- cgit v1.2.3 From 52abb806a3bde6eb69d64564d971efae2cbfda24 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 15 Jun 2020 04:46:11 +0200 Subject: compiler: reuse derived item properties from last compilation A benchmark on an already bulit gallery with ~600 pictures shows a ~90% speedup: Before: Time (mean ± σ): 2.879 s ± 0.125 s [User: 14.686 s, System: 5.511 s] Range (min … max): 2.774 s … 3.203 s 10 runs After: Time (mean ± σ): 289.5 ms ± 15.1 ms [User: 596.1 ms, System: 359.3 ms] Range (min … max): 272.8 ms … 323.0 ms 10 runs GitHub: closes #97 --- compiler/src/FileProcessors.hs | 59 ++++++++++++++++++++++++++++++++---------- 1 file changed, 46 insertions(+), 13 deletions(-) (limited to 'compiler/src/FileProcessors.hs') diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs index 8ea04d1..5c4e1c8 100644 --- a/compiler/src/FileProcessors.hs +++ b/compiler/src/FileProcessors.hs @@ -18,12 +18,18 @@ module FileProcessors ( FileProcessor + , transformThenDescribe + , copyResource + , noopProcessor + , FileTransformer , copyFileProcessor , resizePictureUpTo , resourceAt , getImageResolution - , ItemDescriber + , FileDescriber + , getResProps , getPictureProps + , getThumbnailProps ) where @@ -35,24 +41,43 @@ import System.Directory (getModificationTime) import qualified System.Directory import Config (Resolution(..)) -import Resource (Resource(..), GalleryItemProps(..)) +import Resource (Resource(..), GalleryItemProps(..), Thumbnail(..)) import Files data ProcessingException = ProcessingException FilePath String deriving Show instance Exception ProcessingException -type FileProcessor = +type FileProcessor a = + Path -- ^ Item path + -> Path -- ^ Target resource path + -> FilePath -- ^ Filesystem input path + -> FilePath -- ^ Filesystem output path + -> IO a + +transformThenDescribe :: FileTransformer -> FileDescriber a -> FileProcessor a +transformThenDescribe transformer describer _itemPath resPath fsInPath fsOutPath = + transformer fsInPath fsOutPath >> describer resPath fsOutPath + +copyResource :: (Resource -> a) -> FileProcessor a +copyResource resPropConstructor = + transformThenDescribe copyFileProcessor (getResProps resPropConstructor) + +noopProcessor :: FileProcessor (Maybe a) +noopProcessor _ _ _ _ = return Nothing + + +type FileTransformer = FileName -- ^ Input path -> FileName -- ^ Output path -> IO () -copyFileProcessor :: FileProcessor +copyFileProcessor :: FileTransformer copyFileProcessor inputPath outputPath = putStrLn ("Copying:\t" ++ outputPath) >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath -resizePictureUpTo :: Resolution -> FileProcessor +resizePictureUpTo :: Resolution -> FileTransformer resizePictureUpTo maxResolution inputPath outputPath = putStrLn ("Generating:\t" ++ outputPath) >> ensureParentDir (flip resize) outputPath inputPath @@ -68,8 +93,10 @@ resizePictureUpTo maxResolution inputPath outputPath = , output ] -resourceAt :: FilePath -> Path -> IO Resource -resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath +type FileDescriber a = + Path -- ^ Target resource path + -> FilePath -- ^ Filesystem path + -> IO a getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = @@ -85,11 +112,17 @@ getImageResolution fsPath = (Just w, Just h) -> return $ Resolution w h _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." +resourceAt :: FileDescriber Resource +resourceAt resPath fsPath = Resource resPath <$> getModificationTime fsPath + +getResProps :: (Resource -> a) -> FileDescriber a +getResProps resPropsConstructor resPath fsPath = + resPropsConstructor <$> resourceAt resPath fsPath -type ItemDescriber = - FilePath - -> Resource - -> IO GalleryItemProps +getPictureProps :: FileDescriber GalleryItemProps +getPictureProps resPath fsPath = + Picture <$> resourceAt resPath fsPath <*> getImageResolution fsPath -getPictureProps :: ItemDescriber -getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath +getThumbnailProps :: FileDescriber (Maybe Thumbnail) +getThumbnailProps resPath fsPath = + Just <$> (Thumbnail <$> resourceAt resPath fsPath <*> getImageResolution fsPath) -- cgit v1.2.3