From 04d5cb917f4288c26a308dfda4ba788d77fda8fd Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 13 May 2020 00:18:16 +0200
Subject: compiler: add plain text file format support through simple copy

---
 compiler/src/Processors.hs | 7 +++++--
 compiler/src/Resource.hs   | 1 +
 2 files changed, 6 insertions(+), 2 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 02db325..ca8a74c 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -47,8 +47,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show
 instance Exception ProcessingException
 
 
--- TODO: handle video, music, text...
-data Format = PictureFormat | Unknown
+-- TODO: handle video, music, markdown, pdf...
+data Format = PictureFormat | PlainTextFormat | Unknown
 
 formatFromPath :: Path -> Format
 formatFromPath =
@@ -66,6 +66,8 @@ formatFromPath =
       ".tiff" -> PictureFormat
       ".hdr" -> PictureFormat
       ".gif" -> PictureFormat
+      ".txt" -> PlainTextFormat
+      ".md" -> PlainTextFormat -- TODO: handle markdown separately
       _ -> Unknown
 
 
@@ -170,6 +172,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber)
     processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps)
     processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps)
+    processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText)
     -- TODO: handle video reencoding and others?
     processorFor Unknown _ = (copyFileProcessor, const $ return . Other)
 
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index e134468..5c175f1 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -75,6 +75,7 @@ data GalleryItemProps =
   | Picture
     { resource :: Resource
     , resolution :: Resolution }
+  | PlainText { resource :: Resource }
   | Other { resource :: Resource }
   deriving (Generic, Show)
 
-- 
cgit v1.2.3


From e9e46a3b3392ab435f7414729592b2b5af4071b6 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 18 May 2020 20:05:14 +0200
Subject: compiler: add pdf resource type

---
 compiler/src/Processors.hs | 6 ++++--
 compiler/src/Resource.hs   | 1 +
 2 files changed, 5 insertions(+), 2 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index ca8a74c..2988f83 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -47,8 +47,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show
 instance Exception ProcessingException
 
 
--- TODO: handle video, music, markdown, pdf...
-data Format = PictureFormat | PlainTextFormat | Unknown
+-- TODO: handle video, music, markdown...
+data Format = PictureFormat | PlainTextFormat | PortableDocumentFormat | Unknown
 
 formatFromPath :: Path -> Format
 formatFromPath =
@@ -68,6 +68,7 @@ formatFromPath =
       ".gif" -> PictureFormat
       ".txt" -> PlainTextFormat
       ".md" -> PlainTextFormat -- TODO: handle markdown separately
+      ".pdf" -> PortableDocumentFormat
       _ -> Unknown
 
 
@@ -173,6 +174,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps)
     processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps)
     processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText)
+    processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF)
     -- TODO: handle video reencoding and others?
     processorFor Unknown _ = (copyFileProcessor, const $ return . Other)
 
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 5c175f1..129a817 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -76,6 +76,7 @@ data GalleryItemProps =
     { resource :: Resource
     , resolution :: Resolution }
   | PlainText { resource :: Resource }
+  | PDF { resource :: Resource }
   | Other { resource :: Resource }
   deriving (Generic, Show)
 
-- 
cgit v1.2.3


From 516ee7c5599f2c90a636fd9301806bef67830046 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 19 May 2020 21:06:16 +0200
Subject: compiler: add audio and video extensions

---
 compiler/src/Processors.hs | 24 ++++++++++++++++++++++--
 compiler/src/Resource.hs   |  2 ++
 2 files changed, 24 insertions(+), 2 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 2988f83..0efbf6d 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -47,8 +47,13 @@ data ProcessingException = ProcessingException FilePath String deriving Show
 instance Exception ProcessingException
 
 
--- TODO: handle video, music, markdown...
-data Format = PictureFormat | PlainTextFormat | PortableDocumentFormat | Unknown
+data Format =
+    PictureFormat
+  | PlainTextFormat
+  | PortableDocumentFormat
+  | VideoFormat
+  | AudioFormat
+  | Unknown
 
 formatFromPath :: Path -> Format
 formatFromPath =
@@ -69,6 +74,19 @@ formatFromPath =
       ".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
 
 
@@ -175,6 +193,8 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     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)
 
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 129a817..c08677d 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -77,6 +77,8 @@ data GalleryItemProps =
     , resolution :: Resolution }
   | PlainText { resource :: Resource }
   | PDF { resource :: Resource }
+  | Video { resource :: Resource }
+  | Audio { resource :: Resource }
   | Other { resource :: Resource }
   deriving (Generic, Show)
 
-- 
cgit v1.2.3


From 00c6216259d8a7b131307953ba5000d2b5dc564b Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 00:06:18 +0200
Subject: compiler: trivial code simplifications

Following HLint's advice.
---
 compiler/src/Compiler.hs   | 18 +++++++++---------
 compiler/src/Config.hs     |  4 ++--
 compiler/src/Files.hs      | 15 ++++++++-------
 compiler/src/Input.hs      | 13 +++++++------
 compiler/src/Processors.hs | 15 +++++----------
 compiler/src/Resource.hs   | 16 ++++++++--------
 6 files changed, 39 insertions(+), 42 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 749872d..2bb27f9 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -81,16 +81,16 @@ writeJSON outputPath object =
 (|||) = liftM2 (||)
 
 anyPattern :: [String] -> String -> Bool
-anyPattern patterns string = any (flip Glob.match string) (map Glob.compile patterns)
+anyPattern patterns string = any (flip Glob.match string . Glob.compile) patterns
 
 galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool
 galleryDirFilter config excludedCanonicalDirs =
       (not . isHidden)
   &&& (not . isExcludedDir)
-  &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
-       (matchesFile $ anyPattern $ includedFiles config))
-  &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
-              (matchesFile $ anyPattern $ excludedFiles config)))
+  &&& (matchesDir (anyPattern $ includedDirectories config) |||
+       matchesFile (anyPattern $ includedFiles config))
+  &&& (not . (matchesDir (anyPattern $ excludedDirectories config) |||
+              matchesFile (anyPattern $ excludedFiles config)))
 
   where
     matchesDir :: (FileName -> Bool) -> FSNode -> Bool
@@ -102,17 +102,17 @@ galleryDirFilter config excludedCanonicalDirs =
     matchesFile _ Dir{} = False
 
     isExcludedDir :: FSNode -> Bool
-    isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs
+    isExcludedDir Dir{canonicalPath} = canonicalPath `elem` excludedCanonicalDirs
     isExcludedDir File{} = False
 
 inputTreeFilter :: GalleryConfig -> InputTree -> Bool
 inputTreeFilter GalleryConfig{includedTags, excludedTags} =
-      (hasTagMatching $ anyPattern includedTags)
-  &&& (not . (hasTagMatching $ anyPattern excludedTags))
+      hasTagMatching (anyPattern includedTags)
+  &&& (not . hasTagMatching (anyPattern excludedTags))
 
   where
     hasTagMatching :: (String -> Bool) -> InputTree -> Bool
-    hasTagMatching cond = (any cond) . (fromMaybe [""] . tags) . sidecar
+    hasTagMatching cond = any cond . (fromMaybe [""] . tags) . sidecar
 
 
 compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO ()
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 0ae0fa1..3c38a17 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -73,8 +73,8 @@ instance FromJSON GalleryConfig where
     <*> v .:? "includedTags" .!= ["*"]
     <*> v .:? "excludedTags" .!= []
     <*> v .:? "tagCategories" .!= []
-    <*> v .:? "tagsFromDirectories" .!= (TagsFromDirectoriesConfig 0 "")
-    <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300)
+    <*> v .:? "tagsFromDirectories" .!= TagsFromDirectoriesConfig 0 ""
+    <*> v .:? "thumbnailMaxResolution" .!= Resolution 400 300
     <*> v .:? "pictureMaxResolution"
 
 readConfig :: FileName -> IO GalleryConfig
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index c769815..40149e1 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -30,6 +30,7 @@ module Files
 
 import Data.List (isPrefixOf, length, subsequences, sortOn)
 import Data.Function ((&))
+import Data.Functor ((<&>))
 import Data.Text (pack)
 import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
@@ -53,7 +54,7 @@ type LocalPath = String
 type WebPath = String
 
 -- | Reversed path component list
-data Path = Path [FileName] deriving Show
+newtype Path = Path [FileName] deriving Show
 
 instance ToJSON Path where
   toJSON = JSON.String . pack . webPath
@@ -120,7 +121,7 @@ isHidden = hiddenName . nodeName
 -- | DFS with intermediate dirs first.
 flattenDir :: FSNode -> [FSNode]
 flattenDir file@File{} = [file]
-flattenDir dir@Dir{items} = dir:(concatMap flattenDir items)
+flattenDir dir@Dir{items} = dir:concatMap flattenDir items
 
 -- | Filters a dir tree. The root is always returned.
 filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -133,7 +134,7 @@ filterDir cond (AnchoredFSNode anchor root) =
     filter cond items & map filterNode & Dir path canonicalPath
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
-readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
+readDirectory root = AnchoredFSNode root <$> mkNode (Path [])
   where
     mkNode :: Path -> IO FSNode
     mkNode path =
@@ -151,10 +152,10 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
 
     mkDirNode :: Path -> FilePath -> IO FSNode
     mkDirNode path canonicalPath =
-      (listDirectory $ localPath (root /> path))
-      >>= mapM (mkNode . ((</) path))
-      >>= return . sortOn nodeName
-      >>= return . Dir path canonicalPath
+      listDirectory (localPath (root /> path))
+      >>= mapM (mkNode . (path </))
+      <&> sortOn nodeName
+      <&> Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
 copyTo target AnchoredFSNode{anchor, root} = copyNode root
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 6ed7471..1316cdd 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -27,6 +27,7 @@ import GHC.Generics (Generic)
 import Control.Exception (Exception, AssertionFailed(..), throw, throwIO)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Function ((&))
+import Data.Functor ((<&>))
 import Data.Maybe (catMaybes)
 import Data.Bool (bool)
 import Data.List (find)
@@ -90,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar
 readSidecarFile filepath =
   doesFileExist filepath
   >>= bool (return Nothing) (decodeYamlFile filepath)
-  >>= return . maybe emptySidecar id
+  <&> maybe emptySidecar id
 
 
 readInputTree :: AnchoredFSNode -> IO InputTree
@@ -100,13 +101,13 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
   where
     mkInputNode :: FSNode -> IO (Maybe InputTree)
     mkInputNode file@File{path}
-      | (not $ isSidecar file) && (not $ isThumbnail file) =
+      | not (isSidecar file) && not (isThumbnail file) =
         do
           sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt)
           modTime <- getModificationTime $ localPath (anchor /> path)
           return $ Just $ InputFile path modTime sidecar
     mkInputNode File{} = return Nothing
-    mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just
+    mkInputNode dir@Dir{} = Just <$> mkDirNode dir
 
     mkDirNode :: FSNode -> IO InputTree
     mkDirNode File{} = throw $ AssertionFailed "Input directory is a file"
@@ -121,17 +122,17 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
     isSidecar Dir{} = False
     isSidecar File{path} =
       fileName path
-      & (maybe False $ isExtensionOf sidecarExt)
+      & maybe False (isExtensionOf sidecarExt)
 
     isThumbnail :: FSNode -> Bool
     isThumbnail Dir{} = False
     isThumbnail File{path} =
       fileName path
       & fmap dropExtension
-      & (maybe False (dirPropFile ==))
+      & maybe False (dirPropFile ==)
 
     findThumbnail :: [FSNode] -> Maybe Path
-    findThumbnail = (fmap Files.path) . (find isThumbnail)
+    findThumbnail = fmap Files.path . find isThumbnail
 
 -- | Filters an InputTree. The root is always returned.
 filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 0efbf6d..73529ee 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -57,10 +57,7 @@ data Format =
 
 formatFromPath :: Path -> Format
 formatFromPath =
-  maybe Unknown fromExt
-  . fmap (map toLower)
-  . fmap takeExtension
-  . fileName
+  maybe Unknown ((fromExt . map toLower) . takeExtension) . fileName
   where
     fromExt :: String -> Format
     fromExt ext = case ext of
@@ -97,12 +94,12 @@ type FileProcessor =
 
 copyFileProcessor :: FileProcessor
 copyFileProcessor inputPath outputPath =
-  (putStrLn $ "Copying:\t" ++ outputPath)
+  putStrLn ("Copying:\t" ++ outputPath)
   >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
 
 resizePictureUpTo :: Resolution -> FileProcessor
 resizePictureUpTo maxResolution inputPath outputPath =
-  (putStrLn $ "Generating:\t" ++ outputPath)
+  putStrLn ("Generating:\t" ++ outputPath)
   >> ensureParentDir (flip resize) outputPath inputPath
   where
     maxSize :: Resolution -> String
@@ -143,7 +140,7 @@ withCached processor inputPath outputPath =
 
 
 resourceAt :: FilePath -> Path -> IO Resource
-resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
+resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath
 
 getImageResolution :: FilePath -> IO Resolution
 getImageResolution fsPath =
@@ -160,9 +157,7 @@ getImageResolution fsPath =
         _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution."
 
 getPictureProps :: ItemDescriber
-getPictureProps fsPath resource =
-      getImageResolution fsPath
-  >>= return . Picture resource
+getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath
 
 
 type ItemDescriber =
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c08677d..607c7f6 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -29,6 +29,7 @@ import Data.List.Ordered (minusBy)
 import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
+import Data.Functor ((<&>))
 import qualified Data.Set as Set
 import Data.Text (pack)
 import Data.Time.Clock (UTCTime)
@@ -119,8 +120,8 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
 buildGalleryTree ::
      ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig
   -> InputTree -> IO GalleryItem
-buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree =
-  mkGalleryItem [] inputTree
+buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
+  mkGalleryItem []
   where
     mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
     mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} =
@@ -190,7 +191,7 @@ flattenGalleryTree simple = [simple]
 
 galleryOutputDiff :: GalleryItem -> FSNode -> [Path]
 galleryOutputDiff resources ref =
-  (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources)
+  filesystemPaths ref \\ compiledPaths (flattenGalleryTree resources)
   where
     filesystemPaths :: FSNode -> [Path]
     filesystemPaths = map Files.path . tail . flattenDir
@@ -212,8 +213,7 @@ galleryOutputDiff resources ref =
 
     thumbnailPaths :: [GalleryItem] -> [Path]
     thumbnailPaths =
-        map resourcePath
-      . map (resource :: (Thumbnail -> Resource))
+        map (resourcePath . (resource :: (Thumbnail -> Resource)))
       . mapMaybe thumbnail
 
     (\\) :: [Path] -> [Path] -> [Path]
@@ -235,7 +235,7 @@ galleryOutputDiff resources ref =
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
 galleryCleanupResourceDir resourceTree outputDir =
   readDirectory outputDir
-  >>= return . galleryOutputDiff resourceTree . root
-  >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs
-  >>= return . map (localPath . (/>) outputDir)
+  <&> galleryOutputDiff resourceTree . root
+  <&> sortOn ((0 -) . pathLength) -- nested files before their parent dirs
+  <&> map (localPath . (/>) outputDir)
   >>= mapM_ remove
-- 
cgit v1.2.3


From 34b90f08a21fbe3f1928e16a8ea48f1fc7453e4e Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 15 Jun 2020 05:34:33 +0200
Subject: compiler/Files: simplify subPaths computation

Ignoring subsequences that aren't rooted
---
 compiler/src/Files.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 40149e1..1f14e7f 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -28,7 +28,7 @@ module Files
   ) where
 
 
-import Data.List (isPrefixOf, length, subsequences, sortOn)
+import Data.List (isPrefixOf, length, sortOn)
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.Text (pack)
@@ -81,7 +81,10 @@ fileName (Path (name:_)) = Just name
 fileName _ = Nothing
 
 subPaths :: Path -> [Path]
-subPaths (Path path) = map Path $ subsequences path
+subPaths (Path path) = map Path $ subpaths path
+  where
+    subpaths [] = []
+    subpaths full@(_:r) = full : subpaths r
 
 pathLength :: Path -> Int
 pathLength (Path path) = Data.List.length path
-- 
cgit v1.2.3


From ce2210e6deff1d981186b6d7ddb1176f27e41f49 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 03:41:39 +0200
Subject: compiler: make GalleryIndex loadable from JSON

---
 compiler/src/Compiler.hs |  4 ++--
 compiler/src/Config.hs   |  2 +-
 compiler/src/Files.hs    | 14 ++++++++++----
 compiler/src/Resource.hs | 28 +++++++++++++++-------------
 4 files changed, 28 insertions(+), 20 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 2bb27f9..5a7632d 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -29,7 +29,7 @@ import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
 import System.Directory (canonicalizePath)
 
-import Data.Aeson (ToJSON)
+import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import Config
@@ -64,7 +64,7 @@ thumbnailsDir = "thumbnails"
 data GalleryIndex = GalleryIndex
   { properties :: ViewerConfig
   , tree :: GalleryItem
-  } deriving (Generic, Show, ToJSON)
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 writeJSON :: ToJSON a => FileName -> a -> IO ()
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 3c38a17..afcfb36 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -84,7 +84,7 @@ readConfig = decodeYamlFile
 data ViewerConfig = ViewerConfig
   { galleryTitle :: String
   , tagCategories :: [String]
-  } deriving (Generic, ToJSON, Show)
+  } deriving (Generic, ToJSON, FromJSON, Show)
 
 viewerConfig :: GalleryConfig -> ViewerConfig
 viewerConfig GalleryConfig{galleryTitle, tagCategories} = ViewerConfig galleryTitle tagCategories
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 1f14e7f..023546b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -20,7 +20,7 @@ module Files
   ( FileName, LocalPath, WebPath, Path(..)
   , (</>), (</), (/>), (<.>)
   , fileName, subPaths, pathLength
-  , localPath, webPath
+  , localPath, webPath, fromWebPath
   , FSNode(..), AnchoredFSNode(..)
   , nodeName, isHidden, flattenDir, filterDir
   , readDirectory, copyTo
@@ -31,8 +31,8 @@ module Files
 import Data.List (isPrefixOf, length, sortOn)
 import Data.Function ((&))
 import Data.Functor ((<&>))
-import Data.Text (pack)
-import Data.Aeson (ToJSON)
+import Data.Text (pack, unpack)
+import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import System.Directory
@@ -59,8 +59,11 @@ newtype Path = Path [FileName] deriving Show
 instance ToJSON Path where
   toJSON = JSON.String . pack . webPath
 
+instance FromJSON Path where
+  parseJSON = JSON.withText "Path" (return . fromWebPath . unpack)
+
 instance Eq Path where
-  (Path left) == (Path right) = left == right
+  left == right = webPath left == webPath right
 
 (</>) :: Path -> Path -> Path
 (Path l) </> (Path r) = Path (r ++ l)
@@ -95,6 +98,9 @@ localPath (Path path) = System.FilePath.joinPath $ reverse path
 webPath :: Path -> WebPath
 webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
 
+fromWebPath :: WebPath -> Path
+fromWebPath = Path . reverse . System.FilePath.Posix.splitDirectories
+
 
 data FSNode =
     File
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 607c7f6..fa139e0 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -31,14 +31,14 @@ import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import qualified Data.Set as Set
-import Data.Text (pack)
+import Data.Text (pack, unpack, breakOn)
 import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import Data.Time.Format (formatTime, defaultTimeLocale)
+import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
+import Data.Aeson (ToJSON, FromJSON, genericToJSON, genericToEncoding, genericParseJSON)
 import qualified Data.Aeson as JSON
 
 import Files
@@ -70,6 +70,13 @@ instance ToJSON Resource where
     where
       timestamp = formatTime defaultTimeLocale "%s" modTime
 
+instance FromJSON Resource where
+  parseJSON = JSON.withText "Resource" (unpackRes . breakOn "?")
+    where
+      unpackRes (resPathStr, modTimeStr) =
+        Resource (fromWebPath $ unpack resPathStr)
+        <$> parseTimeM True defaultTimeLocale "?%s" (unpack modTimeStr)
+
 
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
@@ -87,15 +94,14 @@ instance ToJSON GalleryItemProps where
   toJSON = genericToJSON encodingOptions
   toEncoding = genericToEncoding encodingOptions
 
+instance FromJSON GalleryItemProps where
+  parseJSON = genericParseJSON encodingOptions
+
 
 data Thumbnail = Thumbnail
   { resource :: Resource
   , resolution :: Resolution
-  } deriving (Generic, Show)
-
-instance ToJSON Thumbnail where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 data GalleryItem = GalleryItem
@@ -106,11 +112,7 @@ data GalleryItem = GalleryItem
   , path :: Path
   , thumbnail :: Maybe Thumbnail
   , properties :: GalleryItemProps
-  } deriving (Generic, Show)
-
-instance ToJSON GalleryItem where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 type ItemProcessor = Path -> IO GalleryItemProps
-- 
cgit v1.2.3


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 <https://www.gnu.org/licenses/>.
+
+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 <https://www.gnu.org/licenses/>.
+
+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 <https://www.gnu.org/licenses/>.
+
+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 <https://www.gnu.org/licenses/>.
-
-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


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/Caching.hs        | 52 ++++++++++++++++++--------
 compiler/src/Compiler.hs       | 51 +++++++++++++++++++++----
 compiler/src/FileProcessors.hs | 59 ++++++++++++++++++++++-------
 compiler/src/Input.hs          |  4 +-
 compiler/src/ItemProcessors.hs | 85 +++++++++++++++++-------------------------
 compiler/src/Resource.hs       | 38 ++++++++++++-------
 6 files changed, 185 insertions(+), 104 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
index b2b1ee1..c2b5a43 100644
--- a/compiler/src/Caching.hs
+++ b/compiler/src/Caching.hs
@@ -18,39 +18,59 @@
 
 module Caching
   ( Cache
-  , skipCache
-  , withCache
+  , noCache
+  , ItemCache
+  , buildItemCache
+  , useCached
   ) where
 
 
 import Control.Monad (when)
+import qualified Data.Map.Strict as Map
 import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
 
 import FileProcessors (FileProcessor)
+import Resource (GalleryItem(..), flattenGalleryTree)
 import Files
 
 
-type Cache = FileProcessor -> FileProcessor
+type Cache a = FileProcessor a -> FileProcessor a
 
-skipCache :: Cache
-skipCache processor inputPath outputPath =
-  removePathForcibly outputPath
-  >> processor inputPath outputPath
 
-withCache :: Cache
-withCache processor inputPath outputPath =
+noCache :: Cache a
+noCache processor itemPath resPath inputFsPath outputFsPath =
+  removePathForcibly outputFsPath
+  >> processor itemPath resPath inputFsPath outputFsPath
+
+
+type ItemCache = Path -> Maybe GalleryItem
+
+buildItemCache :: Maybe GalleryItem -> ItemCache
+buildItemCache cachedItems = lookupCache
+  where
+    withKey item = (webPath $ Resource.path item, item)
+    cachedItemList = maybe [] flattenGalleryTree cachedItems
+    cachedMap = Map.fromList (map withKey cachedItemList)
+    lookupCache path = Map.lookup (webPath path) cachedMap
+
+useCached :: ItemCache -> (GalleryItem -> a) -> Cache a
+useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
   do
-    isDir <- doesDirectoryExist outputPath
-    when isDir $ removePathForcibly outputPath
+    isDir <- doesDirectoryExist outputFsPath
+    when isDir $ removePathForcibly outputFsPath
 
-    fileExists <- doesFileExist outputPath
+    fileExists <- doesFileExist outputFsPath
     if fileExists then
       do
-        needUpdate <- isOutdated True inputPath outputPath
-        if needUpdate then update else skip
+        needUpdate <- isOutdated True inputFsPath outputFsPath
+        case (needUpdate, cache itemPath) of
+          (False, Just props) -> fromCache props
+          _ -> update
     else
       update
 
   where
-    update = processor inputPath outputPath
-    skip = putStrLn $ "Skipping:\t" ++ outputPath
+    update = processor itemPath resPath inputFsPath outputFsPath
+    fromCache props =
+      putStrLn ("From cache:\t" ++ outputFsPath)
+      >> return (propGetter props)
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 92e6ed6..1ec55c5 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -24,17 +24,25 @@ module Compiler
 
 import GHC.Generics (Generic)
 import Control.Monad (liftM2, when)
+import Data.Bool (bool)
 import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
-import System.Directory (canonicalizePath)
+import System.Directory (canonicalizePath, doesFileExist)
 
 import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import Config
 import Input (InputTree, readInputTree, filterInputTree, sidecar, tags)
-import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
+import Resource
+  ( GalleryItem
+  , GalleryItemProps
+  , Thumbnail
+  , buildGalleryTree
+  , galleryCleanupResourceDir
+  , properties
+  , thumbnail)
 import Files
   ( FileName
   , FSNode(..)
@@ -43,8 +51,8 @@ import Files
   , nodeName
   , filterDir
   , ensureParentDir )
-import ItemProcessors (itemFileProcessor, thumbnailFileProcessor)
-import Caching (skipCache, withCache)
+import ItemProcessors (ItemProcessor, itemFileProcessor, thumbnailFileProcessor)
+import Caching (Cache, noCache, buildItemCache, useCached)
 
 
 defaultGalleryConf :: String
@@ -72,6 +80,15 @@ writeJSON outputPath object =
     putStrLn $ "Generating:\t" ++ outputPath
     ensureParentDir JSON.encodeFile outputPath object
 
+loadGalleryIndex :: FilePath -> IO (Maybe GalleryIndex)
+loadGalleryIndex path =
+  doesFileExist path >>= bool (return Nothing) decodeIndex
+  where
+    decodeIndex =
+      JSON.eitherDecodeFileStrict path
+      >>= either (\err -> warn err >> return Nothing) (return . Just)
+    warn = putStrLn . ("Warning:\tUnable to reuse existing index as cache: " ++)
+
 
 (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 (&&&) = liftM2 (&&)
@@ -126,14 +143,17 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     inputTree <- readInputTree sourceTree
     let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
 
-    let cache = if rebuildAll then skipCache else withCache
-    let itemProc = itemProcessor config cache
-    let thumbnailProc = thumbnailProcessor config cache
+    let galleryIndexPath = outputGalleryIndex outputIndexPath
+    cachedIndex <- loadCachedIndex galleryIndexPath
+    let cache = mkCache cachedIndex
+
+    let itemProc = itemProcessor config (cache Resource.properties)
+    let thumbnailProc = thumbnailProcessor config (cache Resource.thumbnail)
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder curatedInputTree
 
     when cleanOutput $ galleryCleanupResourceDir resources outputDirPath
-    writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources
+    writeJSON galleryIndexPath $ GalleryIndex (viewerConfig config) resources
 
   where
     inputGalleryConf :: FilePath -> FilePath
@@ -144,10 +164,25 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     outputGalleryIndex "" = outputDirPath </> defaultIndexFile
     outputGalleryIndex file = file
 
+    loadCachedIndex :: FilePath -> IO (Maybe GalleryIndex)
+    loadCachedIndex galleryIndexPath =
+      if rebuildAll
+        then return Nothing
+        else loadGalleryIndex galleryIndexPath
+
+    mkCache :: Maybe GalleryIndex -> (GalleryItem -> a) -> Cache a
+    mkCache refGalleryIndex =
+      if rebuildAll
+        then const noCache
+        else useCached (buildItemCache $ fmap tree refGalleryIndex)
+
+    itemProcessor :: GalleryConfig -> Cache GalleryItemProps -> ItemProcessor GalleryItemProps
     itemProcessor config cache =
       itemFileProcessor
         (pictureMaxResolution config) cache
         inputDirPath outputDirPath itemsDir
+
+    thumbnailProcessor :: GalleryConfig -> Cache (Maybe Thumbnail) -> ItemProcessor (Maybe Thumbnail)
     thumbnailProcessor config cache =
       thumbnailFileProcessor
         (thumbnailMaxResolution config) cache
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)
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 1316cdd..2480f5b 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -28,7 +28,7 @@ import Control.Exception (Exception, AssertionFailed(..), throw, throwIO)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Function ((&))
 import Data.Functor ((<&>))
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Bool (bool)
 import Data.List (find)
 import Data.Time.Clock (UTCTime)
@@ -91,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar
 readSidecarFile filepath =
   doesFileExist filepath
   >>= bool (return Nothing) (decodeYamlFile filepath)
-  <&> maybe emptySidecar id
+  <&> fromMaybe emptySidecar
 
 
 readInputTree :: AnchoredFSNode -> IO InputTree
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
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index fa139e0..6b4b44c 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -17,9 +17,15 @@
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Resource
-  ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
-  , buildGalleryTree, galleryCleanupResourceDir
+  ( ItemProcessor
+  , GalleryItem(..)
+  , GalleryItemProps(..)
+  , Resolution(..)
+  , Resource(..)
+  , Thumbnail(..)
+  , buildGalleryTree
+  , galleryCleanupResourceDir
+  , flattenGalleryTree
   ) where
 
 
@@ -115,12 +121,14 @@ data GalleryItem = GalleryItem
   } deriving (Generic, Show, ToJSON, FromJSON)
 
 
-type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
+type ItemProcessor a =
+     Path -- Item path
+  -> Path -- Resource Path
+  -> IO a
 
 
 buildGalleryTree ::
-     ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig
+     ItemProcessor GalleryItemProps -> ItemProcessor (Maybe Thumbnail) -> TagsFromDirectoriesConfig
   -> InputTree -> IO GalleryItem
 buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
   mkGalleryItem []
@@ -128,29 +136,31 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
     mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
     mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} =
       do
-        properties <- processItem path
-        processedThumbnail <- processThumbnail path
+        let itemPath = "/" /> path
+        properties <- processItem itemPath path
+        processedThumbnail <- processThumbnail itemPath path
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path)
-          , path = "/" /> path
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = properties }
 
     mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} =
       do
+        let itemPath = "/" /> path
         let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
         processedItems <- parallel $ map (mkGalleryItem dirTags) items
-        processedThumbnail <- maybeThumbnail dirThumbnailPath
+        processedThumbnail <- maybeThumbnail itemPath dirThumbnailPath
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
                                               ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique (aggregateTags processedItems ++ parentDirTags