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/ItemProcessors.hs | 132 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) create mode 100644 compiler/src/ItemProcessors.hs (limited to 'compiler/src/ItemProcessors.hs') diff --git a/compiler/src/ItemProcessors.hs b/compiler/src/ItemProcessors.hs new file mode 100644 index 0000000..209bc2a --- /dev/null +++ b/compiler/src/ItemProcessors.hs @@ -0,0 +1,132 @@ +-- 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 ItemProcessors + ( ItemProcessor + , itemFileProcessor + , ThumbnailProcessor + , thumbnailFileProcessor + ) where + + +import Data.Function ((&)) +import Data.Char (toLower) +import System.FilePath (takeExtension) + +import Config (Resolution(..)) +import Resource (ItemProcessor, ThumbnailProcessor, Thumbnail(..), GalleryItemProps(..)) +import Caching (Cache) +import FileProcessors +import Files + + +data Format = + PictureFormat + | PlainTextFormat + | PortableDocumentFormat + | VideoFormat + | AudioFormat + | Unknown + +formatFromPath :: Path -> Format +formatFromPath = + maybe Unknown ((fromExt . map toLower) . takeExtension) . fileName + where + fromExt :: String -> Format + fromExt ext = case ext of + ".bmp" -> PictureFormat + ".jpg" -> PictureFormat + ".jpeg" -> PictureFormat + ".png" -> PictureFormat + ".tiff" -> PictureFormat + ".hdr" -> PictureFormat + ".gif" -> PictureFormat + ".txt" -> PlainTextFormat + ".md" -> PlainTextFormat -- TODO: handle markdown separately + ".pdf" -> PortableDocumentFormat + ".wav" -> AudioFormat + ".oga" -> AudioFormat + ".ogg" -> AudioFormat + ".spx" -> AudioFormat + ".opus" -> AudioFormat + ".flac" -> AudioFormat + ".m4a" -> AudioFormat + ".mp3" -> AudioFormat + ".ogv" -> VideoFormat + ".ogx" -> VideoFormat + ".webm" -> VideoFormat + ".mkv" -> VideoFormat + ".mp4" -> VideoFormat + _ -> Unknown + + +type ItemFileProcessor = + FileName -- ^ Input base path + -> FileName -- ^ Output base path + -> FileName -- ^ Output class (subdir) + -> ItemProcessor + +itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor +itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = + cached processor inPath outPath + >> resourceAt outPath relOutPath + >>= descriptor outPath + where + relOutPath = resClass /> inputRes + inPath = localPath $ inputBase /> inputRes + outPath = localPath $ outputBase /> relOutPath + (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution + + processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) + processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) + processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) + processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) + processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF) + processorFor VideoFormat _ = (copyFileProcessor, const $ return . Video) + processorFor AudioFormat _ = (copyFileProcessor, const $ return . Audio) + -- TODO: handle video reencoding and others? + processorFor Unknown _ = (copyFileProcessor, const $ return . Other) + + +type ThumbnailFileProcessor = + FileName -- ^ Input base path + -> FileName -- ^ Output base path + -> FileName -- ^ Output class (subdir) + -> ThumbnailProcessor + +thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor +thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = + cached <$> processorFor (formatFromPath inputRes) + & process + where + relOutPath = resClass /> inputRes + inPath = localPath $ inputBase /> inputRes + outPath = localPath $ outputBase /> relOutPath + + process :: Maybe FileProcessor -> IO (Maybe Thumbnail) + process Nothing = return Nothing + process (Just proc) = + do + proc inPath outPath + resource <- resourceAt outPath relOutPath + resolution <- getImageResolution outPath + return $ Just $ Thumbnail resource resolution + + processorFor :: Format -> Maybe FileProcessor + processorFor PictureFormat = Just $ resizePictureUpTo maxRes + processorFor _ = Nothing -- 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/ItemProcessors.hs | 85 +++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 51 deletions(-) (limited to 'compiler/src/ItemProcessors.hs') diff --git a/compiler/src/ItemProcessors.hs b/compiler/src/ItemProcessors.hs index 209bc2a..f967954 100644 --- a/compiler/src/ItemProcessors.hs +++ b/compiler/src/ItemProcessors.hs @@ -19,17 +19,15 @@ module ItemProcessors ( ItemProcessor , itemFileProcessor - , ThumbnailProcessor , thumbnailFileProcessor ) where -import Data.Function ((&)) import Data.Char (toLower) import System.FilePath (takeExtension) import Config (Resolution(..)) -import Resource (ItemProcessor, ThumbnailProcessor, Thumbnail(..), GalleryItemProps(..)) +import Resource (ItemProcessor, Thumbnail(..), GalleryItemProps(..)) import Caching (Cache) import FileProcessors import Files @@ -75,58 +73,43 @@ formatFromPath = _ -> Unknown -type ItemFileProcessor = - FileName -- ^ Input base path - -> FileName -- ^ Output base path - -> FileName -- ^ Output class (subdir) - -> ItemProcessor +type ItemFileProcessor a = + FilePath -- ^ Filesystem input base path + -> FilePath -- ^ Filesystem output base path + -> FileName -- ^ Output class (subdir) + -> ItemProcessor a -itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor -itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = - cached processor inPath outPath - >> resourceAt outPath relOutPath - >>= descriptor outPath - where - relOutPath = resClass /> inputRes - inPath = localPath $ inputBase /> inputRes - outPath = localPath $ outputBase /> relOutPath - (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution - - processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) - processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) - processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) - processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) - processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF) - processorFor VideoFormat _ = (copyFileProcessor, const $ return . Video) - processorFor AudioFormat _ = (copyFileProcessor, const $ return . Audio) - -- TODO: handle video reencoding and others? - processorFor Unknown _ = (copyFileProcessor, const $ return . Other) +callFileProcessor :: (Path -> FileProcessor a) -> Cache a -> ItemFileProcessor a +callFileProcessor processorProvider withCache inputBase outputBase resClass itemPath resPath = + withCache (processorProvider resPath) + itemPath + (resClass /> resPath) + (localPath $ inputBase /> resPath) + (localPath $ outputBase /> (resClass /> resPath)) -type ThumbnailFileProcessor = - FileName -- ^ Input base path - -> FileName -- ^ Output base path - -> FileName -- ^ Output class (subdir) - -> ThumbnailProcessor -thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor -thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = - cached <$> processorFor (formatFromPath inputRes) - & process +itemFileProcessor :: Maybe Resolution -> Cache GalleryItemProps -> ItemFileProcessor GalleryItemProps +itemFileProcessor maxResolution = + callFileProcessor (flip processorFor maxResolution . formatFromPath) where - relOutPath = resClass /> inputRes - inPath = localPath $ inputBase /> inputRes - outPath = localPath $ outputBase /> relOutPath + processorFor :: Format -> Maybe Resolution -> FileProcessor GalleryItemProps + processorFor PictureFormat (Just maxRes) = + transformThenDescribe (resizePictureUpTo maxRes) getPictureProps + processorFor PictureFormat Nothing = + transformThenDescribe copyFileProcessor getPictureProps + processorFor PlainTextFormat _ = copyResource PlainText + processorFor PortableDocumentFormat _ = copyResource PDF + processorFor VideoFormat _ = copyResource Video + processorFor AudioFormat _ = copyResource Audio + processorFor Unknown _ = copyResource Other + -- TODO: handle video reencoding and others? - process :: Maybe FileProcessor -> IO (Maybe Thumbnail) - process Nothing = return Nothing - process (Just proc) = - do - proc inPath outPath - resource <- resourceAt outPath relOutPath - resolution <- getImageResolution outPath - return $ Just $ Thumbnail resource resolution - processorFor :: Format -> Maybe FileProcessor - processorFor PictureFormat = Just $ resizePictureUpTo maxRes - processorFor _ = Nothing +thumbnailFileProcessor :: Resolution -> Cache (Maybe Thumbnail) -> ItemFileProcessor (Maybe Thumbnail) +thumbnailFileProcessor maxRes = + callFileProcessor (processorFor . formatFromPath) + where + processorFor :: Format -> FileProcessor (Maybe Thumbnail) + processorFor PictureFormat = transformThenDescribe (resizePictureUpTo maxRes) getThumbnailProps + processorFor _ = noopProcessor -- cgit v1.2.3