From 987eb81cb5d98262299c7917d752c54907cbbc33 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 23 Jan 2020 22:36:21 +0100
Subject: compiler: add directory incl and excl glob settings

GitHub: closes #41
---
 compiler/src/Compiler.hs | 37 ++++++++++++++++++++-----------------
 compiler/src/Config.hs   | 12 ++++++++----
 2 files changed, 28 insertions(+), 21 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index a347433..13e9232 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -71,30 +71,35 @@ writeJSON outputPath object =
     ensureParentDir JSON.encodeFile outputPath object
 
 
-galleryDirFilter :: ([Glob.Pattern], [Glob.Pattern]) -> FSNode -> Bool
-galleryDirFilter (inclusionPatterns, exclusionPatterns) =
+galleryDirFilter :: CompilerConfig -> FSNode -> Bool
+galleryDirFilter config =
       (not . isHidden)
-  &&& (matchName True $ anyPattern inclusionPatterns)
-  &&& (not . isConfigFile)
+  &&& (not . matchesFile (== galleryConf))
   &&& (not . containsOutputGallery)
-  &&& (not . (matchName False $ anyPattern exclusionPatterns))
+  &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
+       (matchesFile $ anyPattern $ includedFiles config))
+  &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
+              (matchesFile $ anyPattern $ excludedFiles config)))
 
   where
     (&&&) = liftM2 (&&)
     (|||) = liftM2 (||)
 
-    matchName :: Bool -> (FileName -> Bool) -> FSNode -> Bool
-    matchName matchDir _ Dir{} = matchDir
-    matchName _ cond file@File{} = maybe False cond $ nodeName file
+    matchesDir :: (FileName -> Bool) -> FSNode -> Bool
+    matchesDir cond dir@Dir{} = maybe False cond $ nodeName dir
+    matchesDir _ File{} = False
 
-    anyPattern :: [Glob.Pattern] -> FileName -> Bool
-    anyPattern patterns filename = any (flip Glob.match filename) patterns
+    matchesFile :: (FileName -> Bool) -> FSNode -> Bool
+    matchesFile cond file@File{} = maybe False cond $ nodeName file
+    matchesFile _ Dir{} = False
 
-    isConfigFile = matchName False (== galleryConf)
-    isGalleryIndex = matchName False (== indexFile)
-    isViewerIndex = matchName False (== viewerMainFile)
+    anyPattern :: [String] -> FileName -> Bool
+    anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns)
+
+    containsOutputGallery :: FSNode -> Bool
     containsOutputGallery File{} = False
-    containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items
+    containsOutputGallery Dir{items} =
+      any (matchesFile (== indexFile) ||| matchesFile (== viewerMainFile)) items
 
 
 compileGallery :: FilePath -> FilePath -> Bool -> IO ()
@@ -104,9 +109,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     let config = compiler fullConfig
 
     inputDir <- readDirectory inputDirPath
-    let inclusionPatterns = map Glob.compile $ includeFiles config
-    let exclusionPatterns = map Glob.compile $ excludeFiles config
-    let sourceFilter = galleryDirFilter (inclusionPatterns, exclusionPatterns)
+    let sourceFilter = galleryDirFilter config
     let sourceTree = filterDir sourceFilter inputDir
     inputTree <- readInputTree sourceTree
 
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 53333a5..d670aae 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -34,8 +34,10 @@ import Resource (Resolution(..))
 
 data CompilerConfig = CompilerConfig
   { galleryName :: String
-  , includeFiles :: [String]
-  , excludeFiles :: [String]
+  , includedDirectories :: [String]
+  , excludedDirectories :: [String]
+  , includedFiles :: [String]
+  , excludedFiles :: [String]
   , tagsFromDirectories :: Int
   , thumbnailMaxResolution :: Resolution
   , pictureMaxResolution :: Maybe Resolution
@@ -44,8 +46,10 @@ data CompilerConfig = CompilerConfig
 instance FromJSON CompilerConfig where
   parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig
     <$> v .:? "galleryName" .!= "Gallery"
-    <*> v .:? "includeFiles" .!= ["*"]
-    <*> v .:? "excludeFiles" .!= []
+    <*> v .:? "includedDirectories" .!= ["*"]
+    <*> v .:? "excludedDirectories" .!= []
+    <*> v .:? "includedFiles" .!= ["*"]
+    <*> v .:? "excludedFiles" .!= []
     <*> v .:? "tagsFromDirectories" .!= 0
     <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
     <*> v .:? "pictureMaxResolution"
-- 
cgit v1.2.3


From cf91102432b1196b8f3c1fa388b3963948ad49a6 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 23 Jan 2020 23:16:07 +0100
Subject: compiler: add jpeg export quality setting

GitHub: closes #2
---
 compiler/src/Compiler.hs   | 16 ++++++----
 compiler/src/Config.hs     |  2 ++
 compiler/src/Processors.hs | 80 ++++++++++++++++++++++++----------------------
 3 files changed, 54 insertions(+), 44 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 13e9232..aca96bc 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -114,8 +114,8 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     inputTree <- readInputTree sourceTree
 
     let cache = if rebuildAll then skipCached else withCached
-    let itemProc = itemProcessor (pictureMaxResolution config) cache
-    let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
+    let itemProc = itemProcessor config cache
+    let thumbnailProc = thumbnailProcessor config cache
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder (galleryName config) inputTree
 
@@ -128,7 +128,11 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     outputIndex = outputDirPath </> indexFile
     outputViewerConf = outputDirPath </> viewerConfFile
 
-    itemProcessor maxRes cache =
-      itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
-    thumbnailProcessor thumbRes cache =
-      thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir
+    itemProcessor config cache =
+      itemFileProcessor
+        (pictureMaxResolution config) (jpegExportQuality config) cache
+        inputDirPath outputDirPath itemsDir
+    thumbnailProcessor config cache =
+      thumbnailFileProcessor
+        (thumbnailMaxResolution config) (jpegExportQuality config) cache
+        inputDirPath outputDirPath thumbnailsDir
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index d670aae..4446c14 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -41,6 +41,7 @@ data CompilerConfig = CompilerConfig
   , tagsFromDirectories :: Int
   , thumbnailMaxResolution :: Resolution
   , pictureMaxResolution :: Maybe Resolution
+  , jpegExportQuality :: Int
   } deriving (Generic, Show)
 
 instance FromJSON CompilerConfig where
@@ -53,6 +54,7 @@ instance FromJSON CompilerConfig where
     <*> v .:? "tagsFromDirectories" .!= 0
     <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
     <*> v .:? "pictureMaxResolution"
+    <*> v .:? "jpegExportQuality" .!= 80
 
 
 data GalleryConfig = GalleryConfig
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 159a425..1c4a791 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -80,43 +80,47 @@ copyFileProcessor inputPath outputPath =
   (putStrLn $ "Copying:\t" ++ outputPath)
   >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
 
-resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor
-resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
--- TODO: parameterise export quality for jpg
-resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
-resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
-resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
-resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
-resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage'
-  where
-    saveGifImage' :: StaticImageWriter
-    saveGifImage' outputPath image =
-      saveGifImage outputPath image
-      & either (throwIO . ProcessingException outputPath) id
-
 
+type LossyExportQuality = Int
 type StaticImageReader = FilePath -> IO (Either String DynamicImage)
 type StaticImageWriter = FilePath -> DynamicImage -> IO ()
 
-resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor
-resizeStaticGeneric reader writer maxRes inputPath outputPath =
-  (putStrLn $ "Generating:\t" ++ outputPath)
-  >>  reader inputPath
-  >>= either (throwIO . ProcessingException inputPath) return
-  >>= return . (fitDynamicImage maxRes)
-  >>= ensureParentDir writer outputPath
-
-fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
-fitDynamicImage (Resolution boxWidth boxHeight) image =
-  convertRGBA8 image
-  & scaleBilinear targetWidth targetHeight
-  & ImageRGBA8
+resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
+resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
+  resizerFor pictureFormat
   where
-    picWidth = dynamicMap imageWidth image
-    picHeight = dynamicMap imageHeight image
-    resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
-    targetWidth = floor $ resizeRatio * (picWidth % 1)
-    targetHeight = floor $ resizeRatio * (picHeight % 1)
+    resizerFor :: PictureFileFormat -> FileProcessor
+    resizerFor Bmp = resizer readBitmap saveBmpImage
+    resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality)
+    resizerFor Png = resizer readPng savePngImage
+    resizerFor Tiff = resizer readTiff saveTiffImage
+    resizerFor Hdr = resizer readHDR saveRadianceImage
+    resizerFor Gif = resizer readGif saveGifImage'
+      where
+        saveGifImage' :: StaticImageWriter
+        saveGifImage' outputPath image =
+          saveGifImage outputPath image
+          & either (throwIO . ProcessingException outputPath) id
+
+    resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
+    resizer reader writer inputPath outputPath =
+      (putStrLn $ "Generating:\t" ++ outputPath)
+      >>  reader inputPath
+      >>= either (throwIO . ProcessingException inputPath) return
+      >>= return . (fitDynamicImage maxResolution)
+      >>= ensureParentDir writer outputPath
+
+    fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
+    fitDynamicImage (Resolution boxWidth boxHeight) image =
+      convertRGBA8 image
+      & scaleBilinear targetWidth targetHeight
+      & ImageRGBA8
+      where
+        picWidth = dynamicMap imageWidth image
+        picHeight = dynamicMap imageHeight image
+        resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
+        targetWidth = floor $ resizeRatio * (picWidth % 1)
+        targetHeight = floor $ resizeRatio * (picHeight % 1)
 
 
 type Cache = FileProcessor -> FileProcessor
@@ -152,8 +156,8 @@ type ItemFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ItemProcessor
 
-itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
-itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
+itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
+itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
   >> return (props relOutPath)
   where
@@ -168,7 +172,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     processorFor _ (PictureFormat Gif) =
       (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
     processorFor (Just maxRes) (PictureFormat picFormat) =
-      (resizeStaticImageUpTo picFormat maxRes, Picture)
+      (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
     processorFor _ Unknown =
       (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
@@ -179,8 +183,8 @@ type ThumbnailFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ThumbnailProcessor
 
-thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
-thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
+thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor
+thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached <$> processorFor (formatFromPath inputRes)
   & process
   where
@@ -196,6 +200,6 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
 
     processorFor :: Format -> Maybe FileProcessor
     processorFor (PictureFormat picFormat) =
-      Just $ resizeStaticImageUpTo picFormat maxRes
+      Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat
     processorFor _ =
       Nothing
-- 
cgit v1.2.3


From 2a336b297237b546f065f706838f4cefad4c3e7c Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 25 Jan 2020 13:47:27 +0100
Subject: compiler: add resource timestamp in generated index

Add a timestamp to resource paths in the gallery index to invalidate
elements in the browser's cache when necessary.

Timestamps are added to resource URLs as a dummy numeric parameter.

GitHub: closes #40
---
 compiler/src/Processors.hs | 16 +++++++++++-----
 compiler/src/Resource.hs   | 40 +++++++++++++++++++++++++++-------------
 2 files changed, 38 insertions(+), 18 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 1c4a791..2abdec5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -38,7 +38,7 @@ import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but i
 
 import Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItemProps(..), Resolution(..) )
+  , GalleryItemProps(..), Resolution(..), Resource(..) )
 
 import Files
 
@@ -150,6 +150,10 @@ withCached processor inputPath outputPath =
     skip = putStrLn $ "Skipping:\t" ++ outputPath
 
 
+resourceAt :: FilePath -> Path -> IO Resource
+resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
+
+
 type ItemFileProcessor =
      FileName        -- ^ Input base path
   -> FileName        -- ^ Output base path
@@ -159,14 +163,15 @@ type ItemFileProcessor =
 itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
 itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
-  >> return (props relOutPath)
+  >> resourceAt outPath relOutPath
+  >>= return . props
   where
     relOutPath = resClass /> inputRes
     inPath = localPath $ inputBase /> inputRes
     outPath = localPath $ outputBase /> relOutPath
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
-    processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps)
+    processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
     processorFor Nothing _ =
       (copyFileProcessor, Other)
     processorFor _ (PictureFormat Gif) =
@@ -192,11 +197,12 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
     inPath = localPath $ inputBase /> inputRes
     outPath = localPath $ outputBase /> relOutPath
 
-    process :: Maybe FileProcessor -> IO (Maybe Path)
+    process :: Maybe FileProcessor -> IO (Maybe Resource)
     process Nothing = return Nothing
     process (Just proc) =
       proc inPath outPath
-      >> return (Just relOutPath)
+      >> resourceAt outPath relOutPath
+      >>= return . Just
 
     processorFor :: Format -> Maybe FileProcessor
     processorFor (PictureFormat picFormat) =
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 56f7a3f..c0ef317 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
 
 module Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..)
+  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..)
   , buildGalleryTree, galleryCleanupResourceDir
   ) where
 
@@ -30,8 +30,10 @@ import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
 import Data.Function ((&))
 import qualified Data.Set as Set
+import Data.Text (pack)
 import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
+import Data.Time.Format (formatTime, defaultTimeLocale)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
@@ -65,10 +67,22 @@ instance ToJSON Resolution where
   toEncoding = genericToEncoding encodingOptions
 
 
+data Resource = Resource
+  { resourcePath :: Path
+  , modTime :: UTCTime
+  } deriving (Generic, Show)
+
+instance ToJSON Resource where
+  toJSON Resource{resourcePath, modTime} =
+    JSON.String $ pack (webPath resourcePath ++ "?" ++ timestamp)
+    where
+      timestamp = formatTime defaultTimeLocale "%s" modTime
+
+
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
-  | Picture { resource :: Path }
-  | Other { resource :: Path }
+  | Picture { resource :: Resource }
+  | Other { resource :: Resource }
   deriving (Generic, Show)
 
 instance ToJSON GalleryItemProps where
@@ -82,7 +96,7 @@ data GalleryItem = GalleryItem
   , description :: String
   , tags :: [Tag]
   , path :: Path
-  , thumbnail :: Maybe Path
+  , thumbnail :: Maybe Resource
   , properties :: GalleryItemProps
   } deriving (Generic, Show)
 
@@ -92,7 +106,7 @@ instance ToJSON GalleryItem where
 
 
 type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Path)
+type ThumbnailProcessor = Path -> IO (Maybe Resource)
 
 
 buildGalleryTree ::
@@ -136,7 +150,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         subItemsParents :: [String]
         subItemsParents = (maybeToList $ fileName path) ++ parentTitles
 
-    maybeThumbnail :: Maybe Path -> IO (Maybe Path)
+    maybeThumbnail :: Maybe Path -> IO (Maybe Resource)
     maybeThumbnail Nothing = return Nothing
     maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
@@ -175,18 +189,18 @@ galleryOutputDiff resources ref =
 
     compiledPaths :: [GalleryItem] -> [Path]
     compiledPaths items =
-      resourcePaths items ++ thumbnailPaths items
+      resPaths items ++ thumbnailPaths items
       & concatMap subPaths
 
-    resourcePaths :: [GalleryItem] -> [Path]
-    resourcePaths = mapMaybe (resourcePath . properties)
+    resPaths :: [GalleryItem] -> [Path]
+    resPaths = mapMaybe (resPath . properties)
 
-    resourcePath :: GalleryItemProps -> Maybe Path
-    resourcePath Directory{} = Nothing
-    resourcePath resourceProps = Just $ resource resourceProps
+    resPath :: GalleryItemProps -> Maybe Path
+    resPath Directory{} = Nothing
+    resPath resourceProps = Just (resourcePath $ resource resourceProps)
 
     thumbnailPaths :: [GalleryItem] -> [Path]
-    thumbnailPaths = mapMaybe thumbnail
+    thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail)
 
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
-- 
cgit v1.2.3


From c05cbe525ad44273cc1b9b58549af757f549dcb7 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 27 Jan 2020 14:29:47 +0100
Subject: compiler: switch to imagemagick

Use ImageMagick to resize images instead of JuicyPixels,
using the superior Lanczos resampling and cutting memory usage.

This requires ImageMagick to be installed on the host system and
the `magick` executable to be present in the PATH.

GitHub: closes #49
---
 compiler/src/Compiler.hs   |   4 +-
 compiler/src/Config.hs     |   2 -
 compiler/src/Processors.hs | 101 ++++++++++++++-------------------------------
 3 files changed, 32 insertions(+), 75 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index aca96bc..27598b7 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -130,9 +130,9 @@ compileGallery inputDirPath outputDirPath rebuildAll =
 
     itemProcessor config cache =
       itemFileProcessor
-        (pictureMaxResolution config) (jpegExportQuality config) cache
+        (pictureMaxResolution config) cache
         inputDirPath outputDirPath itemsDir
     thumbnailProcessor config cache =
       thumbnailFileProcessor
-        (thumbnailMaxResolution config) (jpegExportQuality config) cache
+        (thumbnailMaxResolution config) cache
         inputDirPath outputDirPath thumbnailsDir
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 4446c14..d670aae 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -41,7 +41,6 @@ data CompilerConfig = CompilerConfig
   , tagsFromDirectories :: Int
   , thumbnailMaxResolution :: Resolution
   , pictureMaxResolution :: Maybe Resolution
-  , jpegExportQuality :: Int
   } deriving (Generic, Show)
 
 instance FromJSON CompilerConfig where
@@ -54,7 +53,6 @@ instance FromJSON CompilerConfig where
     <*> v .:? "tagsFromDirectories" .!= 0
     <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
     <*> v .:? "pictureMaxResolution"
-    <*> v .:? "jpegExportQuality" .!= 80
 
 
 data GalleryConfig = GalleryConfig
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 2abdec5..4e7c5a7 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -24,17 +24,15 @@ module Processors
   ) where
 
 
-import Control.Exception (Exception, throwIO)
+import Control.Exception (Exception)
 import Data.Function ((&))
-import Data.Ratio ((%))
 import Data.Char (toLower)
 
 import System.Directory hiding (copyFile)
 import qualified System.Directory
 import System.FilePath
 
-import Codec.Picture
-import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
+import System.Process (callProcess)
 
 import Resource
   ( ItemProcessor, ThumbnailProcessor
@@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show
 instance Exception ProcessingException
 
 
-data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif
-
 -- TODO: handle video, music, text...
-data Format = PictureFormat PictureFileFormat | Unknown
+data Format = PictureFormat | Unknown
 
 formatFromPath :: Path -> Format
 formatFromPath =
@@ -60,14 +56,15 @@ formatFromPath =
   . fileName
   where
     fromExt :: String -> Format
-    fromExt ".bmp" = PictureFormat Bmp
-    fromExt ".jpg" = PictureFormat Jpg
-    fromExt ".jpeg" = PictureFormat Jpg
-    fromExt ".png" = PictureFormat Png
-    fromExt ".tiff" = PictureFormat Tiff
-    fromExt ".hdr" = PictureFormat Hdr
-    fromExt ".gif" = PictureFormat Gif
-    fromExt _ = Unknown
+    fromExt ext = case ext of
+      ".bmp" -> PictureFormat
+      ".jpg" -> PictureFormat
+      ".jpeg" -> PictureFormat
+      ".png" -> PictureFormat
+      ".tiff" -> PictureFormat
+      ".hdr" -> PictureFormat
+      ".gif" -> PictureFormat
+      _ -> Unknown
 
 
 type FileProcessor =
@@ -80,47 +77,16 @@ copyFileProcessor inputPath outputPath =
   (putStrLn $ "Copying:\t" ++ outputPath)
   >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
 
-
-type LossyExportQuality = Int
-type StaticImageReader = FilePath -> IO (Either String DynamicImage)
-type StaticImageWriter = FilePath -> DynamicImage -> IO ()
-
-resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
-resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
-  resizerFor pictureFormat
+resizePictureUpTo :: Resolution -> FileProcessor
+resizePictureUpTo maxResolution inputPath outputPath =
+  (putStrLn $ "Generating:\t" ++ outputPath)
+  >> ensureParentDir (flip resize) outputPath inputPath
   where
-    resizerFor :: PictureFileFormat -> FileProcessor
-    resizerFor Bmp = resizer readBitmap saveBmpImage
-    resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality)
-    resizerFor Png = resizer readPng savePngImage
-    resizerFor Tiff = resizer readTiff saveTiffImage
-    resizerFor Hdr = resizer readHDR saveRadianceImage
-    resizerFor Gif = resizer readGif saveGifImage'
-      where
-        saveGifImage' :: StaticImageWriter
-        saveGifImage' outputPath image =
-          saveGifImage outputPath image
-          & either (throwIO . ProcessingException outputPath) id
-
-    resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
-    resizer reader writer inputPath outputPath =
-      (putStrLn $ "Generating:\t" ++ outputPath)
-      >>  reader inputPath
-      >>= either (throwIO . ProcessingException inputPath) return
-      >>= return . (fitDynamicImage maxResolution)
-      >>= ensureParentDir writer outputPath
-
-    fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
-    fitDynamicImage (Resolution boxWidth boxHeight) image =
-      convertRGBA8 image
-      & scaleBilinear targetWidth targetHeight
-      & ImageRGBA8
-      where
-        picWidth = dynamicMap imageWidth image
-        picHeight = dynamicMap imageHeight image
-        resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
-        targetWidth = floor $ resizeRatio * (picWidth % 1)
-        targetHeight = floor $ resizeRatio * (picHeight % 1)
+    maxSize :: Resolution -> String
+    maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
+
+    resize :: FileName -> FileName -> IO ()
+    resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output]
 
 
 type Cache = FileProcessor -> FileProcessor
@@ -160,8 +126,8 @@ type ItemFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ItemProcessor
 
-itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
-itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
+itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
+itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
   >> resourceAt outPath relOutPath
   >>= return . props
@@ -172,14 +138,9 @@ itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase re
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
     processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
-    processorFor Nothing _ =
-      (copyFileProcessor, Other)
-    processorFor _ (PictureFormat Gif) =
-      (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
-    processorFor (Just maxRes) (PictureFormat picFormat) =
-      (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
-    processorFor _ Unknown =
-      (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
+    processorFor Nothing _ = (copyFileProcessor, Other)
+    processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture)
+    processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
 
 type ThumbnailFileProcessor =
@@ -188,8 +149,8 @@ type ThumbnailFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ThumbnailProcessor
 
-thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor
-thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes =
+thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
+thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
   cached <$> processorFor (formatFromPath inputRes)
   & process
   where
@@ -205,7 +166,5 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
       >>= return . Just
 
     processorFor :: Format -> Maybe FileProcessor
-    processorFor (PictureFormat picFormat) =
-      Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat
-    processorFor _ =
-      Nothing
+    processorFor PictureFormat = Just $ resizePictureUpTo maxRes
+    processorFor _ = Nothing
-- 
cgit v1.2.3


From c8692be41903791764de314c099ead7f078eed20 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 29 Jan 2020 22:17:13 +0100
Subject: compiler: fix picture item type without resize

GitHub: closes #52
---
 compiler/src/Processors.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 4e7c5a7..f2ade63 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -138,8 +138,8 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
     processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
-    processorFor Nothing _ = (copyFileProcessor, Other)
     processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture)
+    processorFor Nothing PictureFormat = (copyFileProcessor, Picture)
     processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
 
-- 
cgit v1.2.3


From 15c806adec22239096a910b92b49fcfb964815bd Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 30 Jan 2020 17:01:15 +0100
Subject: compiler: add flag for output dir cleanup

Making it explicit.

GitHub: closes #62
---
 compiler/src/Compiler.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 27598b7..fc40a76 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -102,8 +102,8 @@ galleryDirFilter config =
       any (matchesFile (== indexFile) ||| matchesFile (== viewerMainFile)) items
 
 
-compileGallery :: FilePath -> FilePath -> Bool -> IO ()
-compileGallery inputDirPath outputDirPath rebuildAll =
+compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO ()
+compileGallery inputDirPath outputDirPath rebuildAll cleanOutput =
   do
     fullConfig <- readConfig inputGalleryConf
     let config = compiler fullConfig
@@ -119,7 +119,11 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder (galleryName config) inputTree
 
-    galleryCleanupResourceDir resources outputDirPath
+    if cleanOutput then
+      galleryCleanupResourceDir resources outputDirPath
+    else
+      return ()
+
     writeJSON outputIndex resources
     writeJSON outputViewerConf $ viewer fullConfig
 
-- 
cgit v1.2.3


From 2157b66f3ea43137391939992cac4dc901a4ac4e Mon Sep 17 00:00:00 2001
From: Zero~Informatique
Date: Fri, 31 Jan 2020 02:15:26 +0100
Subject: compiler: output viewer config.json

Write a file at the root of the viewer directory with some info about the
gallery root path and generation date time.
---
 compiler/src/Compiler.hs | 1 +
 1 file changed, 1 insertion(+)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index fc40a76..8819ffc 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -18,6 +18,7 @@
 
 module Compiler
   ( compileGallery
+  , writeJSON
   ) where
 
 
-- 
cgit v1.2.3


From 4fde03c7654dcdad11a8c91ba2bcbb2706695e11 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 30 Jan 2020 16:03:54 +0100
Subject: compiler: properly exclude out directory

Use canonical paths to exclude the output directory if it is located
inside the input directory instead of guessing based on special files.

GitHub: closes #54
---
 compiler/src/Compiler.hs | 20 +++++++++-----------
 compiler/src/Files.hs    | 49 +++++++++++++++++++++++++++++-------------------
 2 files changed, 39 insertions(+), 30 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 8819ffc..d392f74 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -26,6 +26,7 @@ import Control.Monad (liftM2)
 import Data.List (any)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
+import System.Directory (canonicalizePath)
 
 import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
@@ -52,9 +53,6 @@ galleryConf = "gallery.yaml"
 indexFile :: String
 indexFile = "index.json"
 
-viewerMainFile :: String
-viewerMainFile = "index.html"
-
 viewerConfFile :: String
 viewerConfFile = "viewer.json"
 
@@ -72,11 +70,11 @@ writeJSON outputPath object =
     ensureParentDir JSON.encodeFile outputPath object
 
 
-galleryDirFilter :: CompilerConfig -> FSNode -> Bool
-galleryDirFilter config =
+galleryDirFilter :: CompilerConfig -> FilePath -> FSNode -> Bool
+galleryDirFilter config outputDir =
       (not . isHidden)
+  &&& (not . isOutputGallery)
   &&& (not . matchesFile (== galleryConf))
-  &&& (not . containsOutputGallery)
   &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
        (matchesFile $ anyPattern $ includedFiles config))
   &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
@@ -97,10 +95,9 @@ galleryDirFilter config =
     anyPattern :: [String] -> FileName -> Bool
     anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns)
 
-    containsOutputGallery :: FSNode -> Bool
-    containsOutputGallery File{} = False
-    containsOutputGallery Dir{items} =
-      any (matchesFile (== indexFile) ||| matchesFile (== viewerMainFile)) items
+    isOutputGallery :: FSNode -> Bool
+    isOutputGallery Dir{canonicalPath} = canonicalPath == outputDir
+    isOutputGallery File{} = False
 
 
 compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO ()
@@ -110,7 +107,8 @@ compileGallery inputDirPath outputDirPath rebuildAll cleanOutput =
     let config = compiler fullConfig
 
     inputDir <- readDirectory inputDirPath
-    let sourceFilter = galleryDirFilter config
+    canonicalOutPath <- canonicalizePath outputDirPath
+    let sourceFilter = galleryDirFilter config canonicalOutPath
     let sourceTree = filterDir sourceFilter inputDir
     inputTree <- readInputTree sourceTree
 
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 41fc5a8..8ea943f 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -29,7 +29,6 @@ module Files
 
 
 import Control.Monad (mapM)
-import Data.Bool (bool)
 import Data.List (isPrefixOf, length, subsequences)
 import Data.Function ((&))
 import Data.Text (pack)
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON
 import System.Directory
   ( doesDirectoryExist
   , doesPathExist
+  , canonicalizePath
   , getModificationTime
   , listDirectory
   , createDirectoryIfMissing
@@ -94,8 +94,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
 
 
 data FSNode =
-    File { path :: Path }
-  | Dir { path :: Path, items :: [FSNode] }
+    File
+      { path :: Path
+      , canonicalPath :: FilePath }
+  | Dir
+      { path :: Path
+      , canonicalPath :: FilePath
+      , items :: [FSNode] }
   deriving Show
 
 data AnchoredFSNode = AnchoredFSNode
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName
 
 -- | DFS with intermediate dirs first.
 flattenDir :: FSNode -> [FSNode]
-flattenDir file@(File _) = [file]
-flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
+flattenDir file@File{} = [file]
+flattenDir dir@Dir{items} = dir:(concatMap flattenDir items)
 
 -- | Filters a dir tree. The root is always returned.
 filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -124,35 +129,41 @@ filterDir cond (AnchoredFSNode anchor root) =
   AnchoredFSNode anchor (filterNode root)
   where
   filterNode :: FSNode -> FSNode
-  filterNode file@(File _) = file
-  filterNode (Dir path items) =
-    filter cond items & map filterNode & Dir path
+  filterNode file@File{} = file
+  filterNode Dir{path, canonicalPath, items} =
+    filter cond items & map filterNode & Dir path canonicalPath
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
 readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
   where
     mkNode :: Path -> IO FSNode
     mkNode path =
-      (doesDirectoryExist $ localPath (root /> path))
-      >>= bool (mkFileNode path) (mkDirNode path)
-
-    mkFileNode :: Path -> IO FSNode
-    mkFileNode path = return $ File path
-
-    mkDirNode :: Path -> IO FSNode
-    mkDirNode path =
+      do
+        let relPath = localPath (root /> path)
+        canonicalPath <- canonicalizePath relPath
+        isDir <- doesDirectoryExist relPath
+        if isDir then
+          mkDirNode path canonicalPath
+        else
+          mkFileNode path canonicalPath
+
+    mkFileNode :: Path -> FilePath -> IO FSNode
+    mkFileNode path canonicalPath = return $ File path canonicalPath
+
+    mkDirNode :: Path -> FilePath -> IO FSNode
+    mkDirNode path canonicalPath =
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
-      >>= return . Dir path
+      >>= return . Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
 copyTo target AnchoredFSNode{anchor, root} = copyNode root
   where
     copyNode :: FSNode -> IO ()
-    copyNode (File path) =
+    copyNode File{path} =
       copyFile (localPath $ anchor /> path) (localPath $ target /> path)
 
-    copyNode (Dir path items) =
+    copyNode Dir{path, items} =
       createDirectoryIfMissing True (localPath $ target /> path)
       >> mapM_ copyNode items
 
-- 
cgit v1.2.3


From b1cdddcca9b627e8ba1f2870aa5e62043f7b04b3 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 31 Jan 2020 18:15:41 +0100
Subject: compiler: auto orient processed images

Let ImageMagick re-orient images based on EXIF metadata.
Some web browsers still don't support that correctly.

GitHub: closes #67
---
 compiler/src/Processors.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index f2ade63..df7e632 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -86,7 +86,11 @@ resizePictureUpTo maxResolution inputPath outputPath =
     maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
 
     resize :: FileName -> FileName -> IO ()
-    resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output]
+    resize input output = callProcess "magick"
+      [ input
+      , "-auto-orient"
+      , "-resize", maxSize maxResolution
+      , output ]
 
 
 type Cache = FileProcessor -> FileProcessor
-- 
cgit v1.2.3


From 7dde692101a7e36e0a431aeb864cbf3a0c0e96f8 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 31 Jan 2020 19:43:24 +0100
Subject: compiler: add thumbnail size to index

---
 compiler/src/Processors.hs | 21 +++++++++++++++------
 compiler/src/Resource.hs   | 28 ++++++++++++++++++++++------
 2 files changed, 37 insertions(+), 12 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index f2ade63..9ddc6ee 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -27,16 +27,17 @@ module Processors
 import Control.Exception (Exception)
 import Data.Function ((&))
 import Data.Char (toLower)
+import Data.List (break)
 
 import System.Directory hiding (copyFile)
 import qualified System.Directory
 import System.FilePath
 
-import System.Process (callProcess)
+import System.Process (callProcess, readProcess)
 
 import Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItemProps(..), Resolution(..), Resource(..) )
+  , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) )
 
 import Files
 
@@ -119,6 +120,12 @@ withCached processor inputPath outputPath =
 resourceAt :: FilePath -> Path -> IO Resource
 resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
 
+getImageResolution :: FilePath -> IO Resolution
+getImageResolution fsPath =
+  readProcess "identify" ["-format", "%w %h", fsPath] []
+  >>= return . break (== ' ')
+  >>= return . \(w, h) -> Resolution (read w) (read h)
+
 
 type ItemFileProcessor =
      FileName        -- ^ Input base path
@@ -158,12 +165,14 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
     inPath = localPath $ inputBase /> inputRes
     outPath = localPath $ outputBase /> relOutPath
 
-    process :: Maybe FileProcessor -> IO (Maybe Resource)
+    process :: Maybe FileProcessor -> IO (Maybe Thumbnail)
     process Nothing = return Nothing
     process (Just proc) =
-      proc inPath outPath
-      >> resourceAt outPath relOutPath
-      >>= return . Just
+      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
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c0ef317..33f3cf0 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
 
 module Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..)
+  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
   , buildGalleryTree, galleryCleanupResourceDir
   ) where
 
@@ -90,13 +90,23 @@ instance ToJSON GalleryItemProps where
   toEncoding = genericToEncoding encodingOptions
 
 
+data Thumbnail = Thumbnail
+  { resource :: Resource
+  , resolution :: Resolution
+  } deriving (Generic, Show)
+
+instance ToJSON Thumbnail where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
 data GalleryItem = GalleryItem
   { title :: String
   , datetime :: ZonedTime
   , description :: String
   , tags :: [Tag]
   , path :: Path
-  , thumbnail :: Maybe Resource
+  , thumbnail :: Maybe Thumbnail
   , properties :: GalleryItemProps
   } deriving (Generic, Show)
 
@@ -106,7 +116,7 @@ instance ToJSON GalleryItem where
 
 
 type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Resource)
+type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
 
 
 buildGalleryTree ::
@@ -150,7 +160,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         subItemsParents :: [String]
         subItemsParents = (maybeToList $ fileName path) ++ parentTitles
 
-    maybeThumbnail :: Maybe Path -> IO (Maybe Resource)
+    maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
     maybeThumbnail Nothing = return Nothing
     maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
@@ -197,10 +207,16 @@ galleryOutputDiff resources ref =
 
     resPath :: GalleryItemProps -> Maybe Path
     resPath Directory{} = Nothing
-    resPath resourceProps = Just (resourcePath $ resource resourceProps)
+    resPath resourceProps =
+        Just
+      $ resourcePath
+      $ (resource :: (GalleryItemProps -> Resource)) resourceProps
 
     thumbnailPaths :: [GalleryItem] -> [Path]
-    thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail)
+    thumbnailPaths =
+        map resourcePath
+      . map (resource :: (Thumbnail -> Resource))
+      . mapMaybe thumbnail
 
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
-- 
cgit v1.2.3


From 9b947996588c02867541ee394aa84fd3839d5f47 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 1 Feb 2020 00:00:23 +0100
Subject: compiler: optimise dir diff for output cleanup

n log n by sorting instead of silly n^2

GitHub: closes #70
---
 compiler/src/Resource.hs | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c0ef317..599509e 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -24,8 +24,8 @@ module Resource
 
 
 import Control.Concurrent.ParallelIO.Global (parallel)
-import Data.List ((\\), sortBy)
-import Data.Ord (comparing)
+import Data.List (sortOn)
+import Data.List.Ordered (minusBy)
 import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
 import Data.Function ((&))
@@ -202,11 +202,26 @@ galleryOutputDiff resources ref =
     thumbnailPaths :: [GalleryItem] -> [Path]
     thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail)
 
+    (\\) :: [Path] -> [Path] -> [Path]
+    a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b)
+      where
+        orderedForm :: Path -> WebPath
+        orderedForm = webPath
+
+        minusOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
+        minusOn f l r = map snd $ minusBy comparingFst (packRef f l) (packRef f r)
+
+        packRef :: (a -> b) -> [a] -> [(b, a)]
+        packRef f = map (\x -> let y = f x in y `seq` (y, x))
+
+        comparingFst :: Ord b => (b, a) -> (b, a) -> Ordering
+        comparingFst (l, _) (r, _) = compare l r
+
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
 galleryCleanupResourceDir resourceTree outputDir =
   readDirectory outputDir
   >>= return . galleryOutputDiff resourceTree . root
-  >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs
+  >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs
   >>= return . map (localPath . (/>) outputDir)
   >>= mapM_ remove
-- 
cgit v1.2.3


From a524bc557ee154d5880153d9b8da680e0b5f3e85 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 2 Feb 2020 20:58:10 +0100
Subject: compiler: tweak default thumbnail size

For better packing.
---
 compiler/src/Config.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index d670aae..4c9aa40 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -51,7 +51,7 @@ instance FromJSON CompilerConfig where
     <*> v .:? "includedFiles" .!= ["*"]
     <*> v .:? "excludedFiles" .!= []
     <*> v .:? "tagsFromDirectories" .!= 0
-    <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
+    <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300)
     <*> v .:? "pictureMaxResolution"
 
 
-- 
cgit v1.2.3


From 5e85fe0743a2ce0d715ce81d37f02729fce01d9c Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 2 Feb 2020 22:31:15 +0100
Subject: compiler: fix resolution extraction for multilayer images

GitHub: closes #84
---
 compiler/src/Processors.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index fc719af..16837a6 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -126,9 +126,11 @@ resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource res
 
 getImageResolution :: FilePath -> IO Resolution
 getImageResolution fsPath =
-  readProcess "identify" ["-format", "%w %h", fsPath] []
+  readProcess "identify" ["-format", "%w %h", firstFrame] []
   >>= return . break (== ' ')
   >>= return . \(w, h) -> Resolution (read w) (read h)
+  where
+    firstFrame = fsPath ++ "[0]"
 
 
 type ItemFileProcessor =
-- 
cgit v1.2.3


From c7c872291c2b053afc2c27f999f33b2cfb6c23f1 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 3 Feb 2020 14:27:33 +0100
Subject: compiler: fix viewer output directory exclusion

GitHub: closes #87
---
 compiler/src/Compiler.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index d392f74..adc4a5f 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -70,10 +70,10 @@ writeJSON outputPath object =
     ensureParentDir JSON.encodeFile outputPath object
 
 
-galleryDirFilter :: CompilerConfig -> FilePath -> FSNode -> Bool
-galleryDirFilter config outputDir =
+galleryDirFilter :: CompilerConfig -> [FilePath] -> FSNode -> Bool
+galleryDirFilter config excludedCanonicalDirs =
       (not . isHidden)
-  &&& (not . isOutputGallery)
+  &&& (not . isExcludedDir)
   &&& (not . matchesFile (== galleryConf))
   &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
        (matchesFile $ anyPattern $ includedFiles config))
@@ -95,20 +95,20 @@ galleryDirFilter config outputDir =
     anyPattern :: [String] -> FileName -> Bool
     anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns)
 
-    isOutputGallery :: FSNode -> Bool
-    isOutputGallery Dir{canonicalPath} = canonicalPath == outputDir
-    isOutputGallery File{} = False
+    isExcludedDir :: FSNode -> Bool
+    isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs
+    isExcludedDir File{} = False
 
 
-compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO ()
-compileGallery inputDirPath outputDirPath rebuildAll cleanOutput =
+compileGallery :: FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO ()
+compileGallery inputDirPath outputDirPath excludedDirs rebuildAll cleanOutput =
   do
     fullConfig <- readConfig inputGalleryConf
     let config = compiler fullConfig
 
     inputDir <- readDirectory inputDirPath
-    canonicalOutPath <- canonicalizePath outputDirPath
-    let sourceFilter = galleryDirFilter config canonicalOutPath
+    excludedCanonicalDirs <- mapM canonicalizePath excludedDirs
+    let sourceFilter = galleryDirFilter config excludedCanonicalDirs
     let sourceTree = filterDir sourceFilter inputDir
     inputTree <- readInputTree sourceTree
 
-- 
cgit v1.2.3


From bb186990000dd133ecfe6741472b03af92eea233 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 3 Feb 2020 19:00:04 +0100
Subject: compiler: handle image resolution parsing error

GitHub: closes #86
---
 compiler/src/Processors.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 16837a6..6ab4eb5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -24,10 +24,11 @@ module Processors
   ) where
 
 
-import Control.Exception (Exception)
+import Control.Exception (Exception, throwIO)
 import Data.Function ((&))
 import Data.Char (toLower)
 import Data.List (break)
+import Text.Read (readMaybe)
 
 import System.Directory hiding (copyFile)
 import qualified System.Directory
@@ -126,12 +127,18 @@ resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource res
 
 getImageResolution :: FilePath -> IO Resolution
 getImageResolution fsPath =
-  readProcess "identify" ["-format", "%w %h", firstFrame] []
-  >>= return . break (== ' ')
-  >>= return . \(w, h) -> Resolution (read w) (read h)
+  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 ItemFileProcessor =
      FileName        -- ^ Input base path
-- 
cgit v1.2.3


From b757ee814c01c83b17b495c4805fcc70d7e08c89 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 3 Feb 2020 15:08:46 +0100
Subject: compiler: simplify checks

---
 compiler/src/Compiler.hs   | 8 ++------
 compiler/src/Processors.hs | 4 ++--
 2 files changed, 4 insertions(+), 8 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index adc4a5f..2a0dccc 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -22,7 +22,7 @@ module Compiler
   ) where
 
 
-import Control.Monad (liftM2)
+import Control.Monad (liftM2, when)
 import Data.List (any)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
@@ -118,11 +118,7 @@ compileGallery inputDirPath outputDirPath excludedDirs rebuildAll cleanOutput =
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder (galleryName config) inputTree
 
-    if cleanOutput then
-      galleryCleanupResourceDir resources outputDirPath
-    else
-      return ()
-
+    when cleanOutput $ galleryCleanupResourceDir resources outputDirPath
     writeJSON outputIndex resources
     writeJSON outputViewerConf $ viewer fullConfig
 
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 6ab4eb5..faa2f43 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -25,6 +25,7 @@ module Processors
 
 
 import Control.Exception (Exception, throwIO)
+import Control.Monad (when)
 import Data.Function ((&))
 import Data.Char (toLower)
 import Data.List (break)
@@ -106,7 +107,7 @@ withCached :: Cache
 withCached processor inputPath outputPath =
   do
     isDir <- doesDirectoryExist outputPath
-    if isDir then removePathForcibly outputPath else noop
+    when isDir $ removePathForcibly outputPath
 
     fileExists <- doesFileExist outputPath
     if fileExists then
@@ -117,7 +118,6 @@ withCached processor inputPath outputPath =
       update
 
   where
-    noop = return ()
     update = processor inputPath outputPath
     skip = putStrLn $ "Skipping:\t" ++ outputPath
 
-- 
cgit v1.2.3


From 7a8bad610472a0197f990dd5f28829f73fc0346e Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 13 Feb 2020 22:12:20 +0100
Subject: compiler: stabilise item order in index

By sorting directory items alphabetically.

GitHub: closes #119
---
 compiler/src/Files.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 8ea943f..8a53b84 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -29,7 +29,7 @@ module Files
 
 
 import Control.Monad (mapM)
-import Data.List (isPrefixOf, length, subsequences)
+import Data.List (isPrefixOf, length, subsequences, sortOn)
 import Data.Function ((&))
 import Data.Text (pack)
 import Data.Aeson (ToJSON)
@@ -154,6 +154,7 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
     mkDirNode path canonicalPath =
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
+      >>= return . sortOn nodeName
       >>= return . Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
-- 
cgit v1.2.3


From 934859af018802be8a2657281aa35d51f91a83a0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 16 Feb 2020 22:48:53 +0100
Subject: compiler: fix doc comment

(cherry picked from commit 4a6138c89b838c85ede2b3c341c59676580e1043)
---
 compiler/src/Files.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 8a53b84..a45e8aa 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -53,7 +53,7 @@ type FileName = String
 type LocalPath = String
 type WebPath = String
 
- -- | Reversed path component list
+-- | Reversed path component list
 data Path = Path [FileName] deriving Show
 
 instance ToJSON Path where
-- 
cgit v1.2.3


From 395a76bc4193c0c7182f87778458a68d0079e836 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 14 Feb 2020 15:39:56 +0100
Subject: compiler: metadata sidecar for whole directories

GitHub: closes #3
---
 compiler/src/Compiler.hs |  2 +-
 compiler/src/Config.hs   |  6 ++---
 compiler/src/Input.hs    |  7 +++++-
 compiler/src/Resource.hs | 61 ++++++++++++++++++++++++------------------------
 4 files changed, 39 insertions(+), 37 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 2a0dccc..bfefa63 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -116,7 +116,7 @@ compileGallery inputDirPath outputDirPath excludedDirs rebuildAll cleanOutput =
     let itemProc = itemProcessor config cache
     let thumbnailProc = thumbnailProcessor config cache
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
-    resources <- galleryBuilder (galleryName config) inputTree
+    resources <- galleryBuilder inputTree
 
     when cleanOutput $ galleryCleanupResourceDir resources outputDirPath
     writeJSON outputIndex resources
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 4c9aa40..4826f17 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -33,8 +33,7 @@ import Resource (Resolution(..))
 
 
 data CompilerConfig = CompilerConfig
-  { galleryName :: String
-  , includedDirectories :: [String]
+  { includedDirectories :: [String]
   , excludedDirectories :: [String]
   , includedFiles :: [String]
   , excludedFiles :: [String]
@@ -45,8 +44,7 @@ data CompilerConfig = CompilerConfig
 
 instance FromJSON CompilerConfig where
   parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig
-    <$> v .:? "galleryName" .!= "Gallery"
-    <*> v .:? "includedDirectories" .!= ["*"]
+    <$> v .:? "includedDirectories" .!= ["*"]
     <*> v .:? "excludedDirectories" .!= []
     <*> v .:? "includedFiles" .!= ["*"]
     <*> v .:? "excludedFiles" .!= []
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index cb837e3..e0fc8ef 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -58,6 +58,7 @@ data InputTree =
     | InputDir
       { path :: Path
       , modTime :: UTCTime
+      , sidecar :: Sidecar
       , dirThumbnailPath :: Maybe Path
       , items :: [InputTree] }
   deriving Show
@@ -79,6 +80,9 @@ emptySidecar = Sidecar
 sidecarExt :: String
 sidecarExt = "yaml"
 
+dirSidecar :: String
+dirSidecar = "directory." ++ sidecarExt
+
 readSidecarFile :: FilePath -> IO Sidecar
 readSidecarFile filepath =
   doesFileExist filepath
@@ -107,7 +111,8 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
       do
         dirItems <- mapM mkInputNode items
         modTime <- getModificationTime $ localPath (anchor /> path)
-        return $ InputDir path modTime (findThumbnail items) (catMaybes dirItems)
+        sidecar <- readSidecarFile $ localPath (anchor /> path </ dirSidecar)
+        return $ InputDir path modTime sidecar (findThumbnail items) (catMaybes dirItems)
 
     isSidecar :: FSNode -> Bool
     isSidecar Dir{} = False
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 400e18a..aadf60b 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -121,44 +121,52 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
 
 buildGalleryTree ::
      ItemProcessor -> ThumbnailProcessor
-  -> Int -> String -> InputTree -> IO GalleryItem
-buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree =
-  mkGalleryItem [] inputTree
+  -> Int -> InputTree -> IO GalleryItem
+buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree =
+  mkGalleryItem [] [] inputTree
   where
-    mkGalleryItem :: [String] -> InputTree -> IO GalleryItem
-    mkGalleryItem parentTitles InputFile{path, modTime, sidecar} =
+    mkGalleryItem :: [String] -> [Tag] -> InputTree -> IO GalleryItem
+    mkGalleryItem parentDirs inheritedTags InputFile{path, modTime, sidecar} =
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
-          { title = fromMeta title $ fromMaybe "" $ fileName path
-          , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
-          , description = fromMeta description ""
-          , tags = unique ((fromMeta tags []) ++ implicitParentTags parentTitles)
+          { title = Input.title sidecar ?? fileName path ?? ""
+          , datetime = Input.datetime sidecar ?? toZonedTime modTime
+          , description = Input.description sidecar ?? ""
+          , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags parentDirs)
           , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = properties }
 
-      where
-        fromMeta :: (Sidecar -> Maybe a) -> a -> a
-        fromMeta get fallback = fromMaybe fallback $ get sidecar
-
-    mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} =
+    mkGalleryItem parentDirs inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} =
       do
+        let itemsParents = (maybeToList $ fileName path) ++ parentDirs
+        let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
+        processedItems <- parallel $ map (mkGalleryItem itemsParents dirTags) items
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem subItemsParents) items
         return GalleryItem
-          { title = fromMaybe galleryName (fileName path)
-          , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems)
-          , description = ""
-          , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles)
+          { title = Input.title sidecar ?? fileName path ?? ""
+          , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
+                                              ?? toZonedTime modTime
+          , description = Input.description sidecar ?? ""
+          , tags = unique (aggregateTags processedItems ++ parentDirTags parentDirs)
           , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
 
-      where
-        subItemsParents :: [String]
-        subItemsParents = (maybeToList $ fileName path) ++ parentTitles
+    infixr ??
+    (??) :: Maybe a -> a -> a
+    (??) = flip fromMaybe
+
+    unique :: Ord a => [a] -> [a]
+    unique = Set.toList . Set.fromList
+
+    parentDirTags :: [String] -> [Tag]
+    parentDirTags = take tagsFromDirectories
+
+    aggregateTags :: [GalleryItem] -> [Tag]
+    aggregateTags = concatMap (\item -> tags (item::GalleryItem))
 
     maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
     maybeThumbnail Nothing = return Nothing
@@ -171,15 +179,6 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
     comparingTime :: ZonedTime -> ZonedTime -> Ordering
     comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
 
-    aggregateTags :: [GalleryItem] -> [Tag]
-    aggregateTags = concatMap (\item -> tags (item::GalleryItem))
-
-    unique :: Ord a => [a] -> [a]
-    unique = Set.toList . Set.fromList
-
-    implicitParentTags :: [String] -> [Tag]
-    implicitParentTags = take tagsFromDirectories
-
     toZonedTime :: UTCTime -> ZonedTime
     toZonedTime = utcToZonedTime utc
 
-- 
cgit v1.2.3


From 26a85722e74eae23a22350064eed204480bbd032 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 16 Feb 2020 12:15:08 +0100
Subject: compiler: unify directory special files

---
 compiler/src/Input.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index e0fc8ef..75d1ed3 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -80,8 +80,11 @@ emptySidecar = Sidecar
 sidecarExt :: String
 sidecarExt = "yaml"
 
-dirSidecar :: String
-dirSidecar = "directory." ++ sidecarExt
+dirPropFile :: String
+dirPropFile = "_directory"
+
+dirSidecar :: Path
+dirSidecar = Path [dirPropFile] <.> sidecarExt
 
 readSidecarFile :: FilePath -> IO Sidecar
 readSidecarFile filepath =
@@ -111,7 +114,7 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
       do
         dirItems <- mapM mkInputNode items
         modTime <- getModificationTime $ localPath (anchor /> path)
-        sidecar <- readSidecarFile $ localPath (anchor /> path </ dirSidecar)
+        sidecar <- readSidecarFile $ localPath (anchor /> path </> dirSidecar)
         return $ InputDir path modTime sidecar (findThumbnail items) (catMaybes dirItems)
 
     isSidecar :: FSNode -> Bool
@@ -125,7 +128,7 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
     isThumbnail File{path} =
       fileName path
       & fmap dropExtension
-      & (maybe False ("thumbnail" ==))
+      & (maybe False (dirPropFile ==))
 
     findThumbnail :: [FSNode] -> Maybe Path
     findThumbnail = (fmap Files.path) . (find isThumbnail)
-- 
cgit v1.2.3


From 68899f0c1ba4f641c376fda1e51d9694b02b9c5d Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 17 Feb 2020 18:09:20 +0100
Subject: compiler: add a prefix setting for tags generated from parent dirs

GitHub: closes #59
---
 compiler/src/Config.hs   | 26 ++++++++++++++++++++++----
 compiler/src/Resource.hs | 43 ++++++++++++++++++------------