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/Caching.hs | 56 +++++++++++
compiler/src/Compiler.hs | 7 +-
compiler/src/FileProcessors.hs | 95 ++++++++++++++++++
compiler/src/ItemProcessors.hs | 132 ++++++++++++++++++++++++
compiler/src/Processors.hs | 223 -----------------------------------------
5 files changed, 286 insertions(+), 227 deletions(-)
create mode 100644 compiler/src/Caching.hs
create mode 100644 compiler/src/FileProcessors.hs
create mode 100644 compiler/src/ItemProcessors.hs
delete mode 100644 compiler/src/Processors.hs
(limited to 'compiler/src')
diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
new file mode 100644
index 0000000..b2b1ee1
--- /dev/null
+++ b/compiler/src/Caching.hs
@@ -0,0 +1,56 @@
+-- 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 Caching
+ ( Cache
+ , skipCache
+ , withCache
+ ) where
+
+
+import Control.Monad (when)
+import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
+
+import FileProcessors (FileProcessor)
+import Files
+
+
+type Cache = FileProcessor -> FileProcessor
+
+skipCache :: Cache
+skipCache processor inputPath outputPath =
+ removePathForcibly outputPath
+ >> processor inputPath outputPath
+
+withCache :: Cache
+withCache processor inputPath outputPath =
+ do
+ isDir <- doesDirectoryExist outputPath
+ when isDir $ removePathForcibly outputPath
+
+ fileExists <- doesFileExist outputPath
+ if fileExists then
+ do
+ needUpdate <- isOutdated True inputPath outputPath
+ if needUpdate then update else skip
+ else
+ update
+
+ where
+ update = processor inputPath outputPath
+ skip = putStrLn $ "Skipping:\t" ++ outputPath
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5a7632d..92e6ed6 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -43,9 +43,8 @@ import Files
, nodeName
, filterDir
, ensureParentDir )
-import Processors
- ( itemFileProcessor, thumbnailFileProcessor
- , skipCached, withCached )
+import ItemProcessors (itemFileProcessor, thumbnailFileProcessor)
+import Caching (skipCache, withCache)
defaultGalleryConf :: String
@@ -127,7 +126,7 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
inputTree <- readInputTree sourceTree
let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
- let cache = if rebuildAll then skipCached else withCached
+ let cache = if rebuildAll then skipCache else withCache
let itemProc = itemProcessor config cache
let thumbnailProc = thumbnailProcessor config cache
let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
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
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
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
deleted file mode 100644
index 73529ee..0000000
--- a/compiler/src/Processors.hs
+++ /dev/null
@@ -1,223 +0,0 @@
--- 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 Processors
- ( Resolution(..)
- , ItemFileProcessor, itemFileProcessor
- , ThumbnailFileProcessor, thumbnailFileProcessor
- , skipCached, withCached
- ) where
-
-
-import Control.Exception (Exception, throwIO)
-import Control.Monad (when)
-import Data.Function ((&))
-import Data.Char (toLower)
-import Text.Read (readMaybe)
-
-import System.Directory hiding (copyFile)
-import qualified System.Directory
-import System.FilePath
-
-import System.Process (callProcess, readProcess)
-
-import Resource
- ( ItemProcessor, ThumbnailProcessor
- , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) )
-
-import Files
-
-
-data ProcessingException = ProcessingException FilePath String deriving Show
-instance Exception ProcessingException
-
-
-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 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 ]
-
-
-type Cache = FileProcessor -> FileProcessor
-
-skipCached :: Cache
-skipCached processor inputPath outputPath =
- removePathForcibly outputPath
- >> processor inputPath outputPath
-
-withCached :: Cache
-withCached processor inputPath outputPath =
- do
- isDir <- doesDirectoryExist outputPath
- when isDir $ removePathForcibly outputPath
-
- fileExists <- doesFileExist outputPath
- if fileExists then
- do
- needUpdate <- isOutdated True inputPath outputPath
- if needUpdate then update else skip
- else
- update
-
- where
- update = processor inputPath outputPath
- skip = putStrLn $ "Skipping:\t" ++ outputPath
-
-
-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."
-
-getPictureProps :: ItemDescriber
-getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath
-
-
-type ItemDescriber =
- FilePath
- -> Resource
- -> IO GalleryItemProps
-
-
-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