From 0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 21:04:31 +0100
Subject: compiler: refactor transform stages

---
 compiler/src/Resource.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 compiler/src/Resource.hs

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
new file mode 100644
index 0000000..04e315a
--- /dev/null
+++ b/compiler/src/Resource.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  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 Resource
+  ( ResourceTree(..)
+  , buildResourceTree
+  ) where
+
+
+import Data.Function ((&))
+import Files
+import Input
+
+
+-- | Tree representing the compiled gallery resources.
+data ResourceTree =
+    ItemResource
+      { sidecar :: Sidecar
+      , path :: Path
+      , itemThumbnailPath :: Path }
+  | DirResource
+      { items :: [ResourceTree]
+      , path :: Path
+      , dirThumbnailPath :: Maybe Path }
+  deriving Show
+
+
+  -- TODO: actually generate compilation strategies
+buildResourceTree :: InputTree -> ResourceTree
+buildResourceTree = resNode
+  where
+    resNode (InputFile path sidecar) =
+      ItemResource sidecar (itemsDir /> path) (thumbnailsDir /> path)
+
+    resNode (InputDir path thumbnailPath items) =
+      map resNode items
+      & \dirItems -> DirResource dirItems (itemsDir /> path) Nothing
+
+    itemsDir = "items"
+    thumbnailsDir = "thumbnails"
-- 
cgit v1.2.3


From 2a6467272e18af4864745b9d0267f9fa3ed382dd Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 26 Dec 2019 01:13:42 +0100
Subject: compiler: implement output dir cleanup

---
 compiler/src/Resource.hs | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 04e315a..60b783e 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -22,10 +22,13 @@
 module Resource
   ( ResourceTree(..)
   , buildResourceTree
+  , flattenResourceTree
+  , outputDiff
   ) where
 
 
 import Data.Function ((&))
+import Data.List ((\\))
 import Files
 import Input
 
@@ -34,25 +37,47 @@ import Input
 data ResourceTree =
     ItemResource
       { sidecar :: Sidecar
-      , path :: Path
+      , resPath :: Path
       , itemThumbnailPath :: Path }
   | DirResource
       { items :: [ResourceTree]
-      , path :: Path
+      , resPath :: Path
       , dirThumbnailPath :: Maybe Path }
   deriving Show
 
 
-  -- TODO: actually generate compilation strategies
+-- TODO: actually generate compilation strategies
 buildResourceTree :: InputTree -> ResourceTree
 buildResourceTree = resNode
   where
     resNode (InputFile path sidecar) =
-      ItemResource sidecar (itemsDir /> path) (thumbnailsDir /> path)
+      ItemResource
+        { sidecar = sidecar
+        , resPath = itemsDir /> path
+        , itemThumbnailPath = thumbnailsDir /> path }
 
     resNode (InputDir path thumbnailPath items) =
       map resNode items
-      & \dirItems -> DirResource dirItems (itemsDir /> path) Nothing
+      & \dirItems -> DirResource
+        { items = dirItems
+        , resPath = itemsDir /> path
+        , dirThumbnailPath = fmap ((/>) thumbnailsDir) thumbnailPath }
 
     itemsDir = "items"
     thumbnailsDir = "thumbnails"
+
+
+flattenResourceTree :: ResourceTree -> [ResourceTree]
+flattenResourceTree item@ItemResource{} = [item]
+flattenResourceTree dir@(DirResource items _ _) =
+  dir:(concatMap flattenResourceTree items)
+
+
+outputDiff :: ResourceTree -> FSNode -> [Path]
+outputDiff resources ref = (fsPaths ref) \\ (resPaths resources)
+  where
+    resPaths :: ResourceTree -> [Path]
+    resPaths = map resPath . flattenResourceTree
+
+    fsPaths :: FSNode -> [Path]
+    fsPaths = map nodePath . tail . flattenDir
-- 
cgit v1.2.3


From eb7a652b2244ffa4dd5ba2440b7879127e7c6078 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:08:19 +0100
Subject: compiler: implement resource processing

but break directory cleanup
---
 compiler/src/Resource.hs | 65 +++++++++++++++++++++++++++++++-----------------
 1 file changed, 42 insertions(+), 23 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 60b783e..dc849cd 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
-
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
@@ -18,9 +16,17 @@
 -- 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/>.
 
+{-# LANGUAGE
+    DuplicateRecordFields
+  , DeriveGeneric
+  , DeriveAnyClass
+#-}
 
 module Resource
   ( ResourceTree(..)
+  , DirProcessor
+  , ItemProcessor
+  , ThumbnailProcessor
   , buildResourceTree
   , flattenResourceTree
   , outputDiff
@@ -29,8 +35,9 @@ module Resource
 
 import Data.Function ((&))
 import Data.List ((\\))
+import Data.Maybe (mapMaybe)
 import Files
-import Input
+import Input (InputTree(..), Sidecar)
 
 
 -- | Tree representing the compiled gallery resources.
@@ -38,33 +45,46 @@ data ResourceTree =
     ItemResource
       { sidecar :: Sidecar
       , resPath :: Path
-      , itemThumbnailPath :: Path }
+      , thumbnailPath :: Maybe Path }
   | DirResource
       { items :: [ResourceTree]
       , resPath :: Path
-      , dirThumbnailPath :: Maybe Path }
+      , thumbnailPath :: Maybe Path }
   deriving Show
 
 
--- TODO: actually generate compilation strategies
-buildResourceTree :: InputTree -> ResourceTree
-buildResourceTree = resNode
+type DirProcessor = Path -> IO Path
+type ItemProcessor = Path -> IO Path
+type ThumbnailProcessor = Path -> IO (Maybe Path)
+
+-- TODO: parallelise this!
+buildResourceTree ::
+     DirProcessor -> ItemProcessor -> ThumbnailProcessor -> InputTree
+  -> IO ResourceTree
+buildResourceTree processDir processItem processThumbnail = resNode
   where
     resNode (InputFile path sidecar) =
-      ItemResource
-        { sidecar = sidecar
-        , resPath = itemsDir /> path
-        , itemThumbnailPath = thumbnailsDir /> path }
+      do
+        processedItem <- processItem path
+        processedThumbnail <- processThumbnail path
+        return ItemResource
+          { sidecar = sidecar
+          , resPath = processedItem
+          , thumbnailPath = processedThumbnail }
 
     resNode (InputDir path thumbnailPath items) =
-      map resNode items
-      & \dirItems -> DirResource
-        { items = dirItems
-        , resPath = itemsDir /> path
-        , dirThumbnailPath = fmap ((/>) thumbnailsDir) thumbnailPath }
+      do
+        processedDir <- processDir path
+        processedThumbnail <- maybeThumbnail thumbnailPath
+        dirItems <- mapM resNode items
+        return DirResource
+          { items = dirItems
+          , resPath = processedDir
+          , thumbnailPath = processedThumbnail }
 
-    itemsDir = "items"
-    thumbnailsDir = "thumbnails"
+    maybeThumbnail :: Maybe Path -> IO (Maybe Path)
+    maybeThumbnail Nothing = return Nothing
+    maybeThumbnail (Just path) = processThumbnail path
 
 
 flattenResourceTree :: ResourceTree -> [ResourceTree]
@@ -72,12 +92,11 @@ flattenResourceTree item@ItemResource{} = [item]
 flattenResourceTree dir@(DirResource items _ _) =
   dir:(concatMap flattenResourceTree items)
 
-
 outputDiff :: ResourceTree -> FSNode -> [Path]
-outputDiff resources ref = (fsPaths ref) \\ (resPaths resources)
+outputDiff resources ref = (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
   where
-    resPaths :: ResourceTree -> [Path]
-    resPaths = map resPath . flattenResourceTree
+    resPaths :: [ResourceTree] -> [Path]
+    resPaths resList = (map resPath resList) ++ (mapMaybe thumbnailPath resList)
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
-- 
cgit v1.2.3


From 015d793b25a3f0d1ff275ed42ec211dd6a532ca0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:21:44 +0100
Subject: compiler: fix old resources cleanup

---
 compiler/src/Resource.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index dc849cd..83f7438 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -34,7 +34,7 @@ module Resource
 
 
 import Data.Function ((&))
-import Data.List ((\\))
+import Data.List ((\\), subsequences)
 import Data.Maybe (mapMaybe)
 import Files
 import Input (InputTree(..), Sidecar)
@@ -93,10 +93,14 @@ flattenResourceTree dir@(DirResource items _ _) =
   dir:(concatMap flattenResourceTree items)
 
 outputDiff :: ResourceTree -> FSNode -> [Path]
-outputDiff resources ref = (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
+outputDiff resources ref =
+  (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
   where
     resPaths :: [ResourceTree] -> [Path]
-    resPaths resList = (map resPath resList) ++ (mapMaybe thumbnailPath resList)
+    resPaths resList = map resPath resList ++ thumbnailPaths resList
+
+    thumbnailPaths :: [ResourceTree] -> [Path]
+    thumbnailPaths = (concatMap subsequences) . (mapMaybe thumbnailPath)
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
-- 
cgit v1.2.3


From 6bc29b5db2c8de62e2d9f21c25fa8dcd1ec5a75b Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:32:35 +0100
Subject: compiler: extracting funcs

---
 compiler/src/Resource.hs | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 83f7438..a8be913 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -28,13 +28,13 @@ module Resource
   , ItemProcessor
   , ThumbnailProcessor
   , buildResourceTree
-  , flattenResourceTree
-  , outputDiff
+  , cleanupResourceDir
   ) where
 
 
 import Data.Function ((&))
-import Data.List ((\\), subsequences)
+import Data.List ((\\), subsequences, sortBy)
+import Data.Ord (comparing)
 import Data.Maybe (mapMaybe)
 import Files
 import Input (InputTree(..), Sidecar)
@@ -104,3 +104,11 @@ outputDiff resources ref =
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
+
+cleanupResourceDir :: ResourceTree -> FileName -> IO ()
+cleanupResourceDir resourceTree outputDir =
+  readDirectory outputDir
+  >>= return . outputDiff resourceTree . root
+  >>= return . sortBy (flip $ comparing length) -- nested files before dirs
+  >>= return . map (localPath . (/>) outputDir)
+  >>= mapM_ remove
-- 
cgit v1.2.3


From a8cdc6eba4ba496bec816dcb7f3c2c0f5114f4c8 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 15:35:42 +0100
Subject: compiler: enable parallelisation

---
 compiler/src/Resource.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index a8be913..c3ed959 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -32,6 +32,7 @@ module Resource
   ) where
 
 
+import Control.Concurrent.ParallelIO.Global (parallel)
 import Data.Function ((&))
 import Data.List ((\\), subsequences, sortBy)
 import Data.Ord (comparing)
@@ -76,7 +77,7 @@ buildResourceTree processDir processItem processThumbnail = resNode
       do
         processedDir <- processDir path
         processedThumbnail <- maybeThumbnail thumbnailPath
-        dirItems <- mapM resNode items
+        dirItems <- parallel $ map resNode items
         return DirResource
           { items = dirItems
           , resPath = processedDir
-- 
cgit v1.2.3


From c117f73ac0bd6a7230cce01c74e941ce42692204 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 15:58:12 +0100
Subject: compiler: remove obsolete TODO

---
 compiler/src/Resource.hs | 1 -
 1 file changed, 1 deletion(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c3ed959..9d60185 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -58,7 +58,6 @@ type DirProcessor = Path -> IO Path
 type ItemProcessor = Path -> IO Path
 type ThumbnailProcessor = Path -> IO (Maybe Path)
 
--- TODO: parallelise this!
 buildResourceTree ::
      DirProcessor -> ItemProcessor -> ThumbnailProcessor -> InputTree
   -> IO ResourceTree
-- 
cgit v1.2.3


From 8a75458290002c765a0fa673912c162020de2bd1 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 30 Dec 2019 01:40:55 +0100
Subject: compiler: refactor path handling

---
 compiler/src/Resource.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 9d60185..afc8203 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -100,7 +100,7 @@ outputDiff resources ref =
     resPaths resList = map resPath resList ++ thumbnailPaths resList
 
     thumbnailPaths :: [ResourceTree] -> [Path]
-    thumbnailPaths = (concatMap subsequences) . (mapMaybe thumbnailPath)
+    thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnailPath)
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
@@ -109,6 +109,6 @@ cleanupResourceDir :: ResourceTree -> FileName -> IO ()
 cleanupResourceDir resourceTree outputDir =
   readDirectory outputDir
   >>= return . outputDiff resourceTree . root
-  >>= return . sortBy (flip $ comparing length) -- nested files before dirs
+  >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs
   >>= return . map (localPath . (/>) outputDir)
   >>= mapM_ remove
-- 
cgit v1.2.3


From d0962ef2dea7e8a0c25ca8fdbc55fcbafeeb2f79 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 30 Dec 2019 23:18:49 +0100
Subject: compiler: refactor resource transformation pipeline

---
 compiler/src/Resource.hs | 185 ++++++++++++++++++++++++++++++++---------------
 1 file changed, 128 insertions(+), 57 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index afc8203..dcf9422 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -20,15 +20,13 @@
     DuplicateRecordFields
   , DeriveGeneric
   , DeriveAnyClass
+  , NamedFieldPuns
 #-}
 
 module Resource
-  ( ResourceTree(..)
-  , DirProcessor
-  , ItemProcessor
-  , ThumbnailProcessor
-  , buildResourceTree
-  , cleanupResourceDir
+  ( DirProcessor, ItemProcessor, ThumbnailProcessor
+  , GalleryItem, GalleryItemProps, Resolution(..)
+  , buildGalleryTree, galleryCleanupResourceDir
   ) where
 
 
@@ -36,79 +34,152 @@ import Control.Concurrent.ParallelIO.Global (parallel)
 import Data.Function ((&))
 import Data.List ((\\), subsequences, sortBy)
 import Data.Ord (comparing)
-import Data.Maybe (mapMaybe)
+import Data.Char (toLower)
+import Data.Maybe (mapMaybe, fromMaybe)
+import qualified Data.Set as Set
+
+import GHC.Generics (Generic)
+import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding)
+import qualified Data.Aeson as JSON
+
 import Files
-import Input (InputTree(..), Sidecar)
+import Input (InputTree(..), Sidecar(..))
+
+
+encodingOptions :: JSON.Options
+encodingOptions = JSON.defaultOptions
+  { JSON.fieldLabelModifier = map toLower
+  , JSON.constructorTagModifier = map toLower
+  , JSON.sumEncoding = JSON.defaultTaggedObject
+      { JSON.tagFieldName = "type"
+      , JSON.contentsFieldName = "contents"
+      }
+  }
+
+
+
+type Tag = String
+type FileSizeKB = Int
+
+
+data Resolution = Resolution
+  { width :: Int
+  , height :: Int
+  } deriving (Generic, Show, FromJSON)
 
+instance ToJSON Resolution where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
 
--- | Tree representing the compiled gallery resources.
-data ResourceTree =
-    ItemResource
-      { sidecar :: Sidecar
-      , resPath :: Path
-      , thumbnailPath :: Maybe Path }
-  | DirResource
-      { items :: [ResourceTree]
-      , resPath :: Path
-      , thumbnailPath :: Maybe Path }
-  deriving Show
+
+data GalleryItemProps =
+    Directory { items :: [GalleryItem] }
+  | Picture
+  | Other
+  deriving (Generic, Show)
+
+instance ToJSON GalleryItemProps where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+data GalleryItem = GalleryItem
+  { title :: String
+  , date :: String -- TODO: checked ISO8601 date
+  , description :: String
+  , tags :: [Tag]
+  , path :: Path
+  , thumbnail :: Maybe Path
+  , properties :: GalleryItemProps
+  } deriving (Generic, Show)
+
+instance ToJSON GalleryItem where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
 
 
 type DirProcessor = Path -> IO Path
 type ItemProcessor = Path -> IO Path
 type ThumbnailProcessor = Path -> IO (Maybe Path)
 
-buildResourceTree ::
-     DirProcessor -> ItemProcessor -> ThumbnailProcessor -> InputTree
-  -> IO ResourceTree
-buildResourceTree processDir processItem processThumbnail = resNode
+
+buildGalleryTree ::
+     DirProcessor -> ItemProcessor -> ThumbnailProcessor
+  -> String -> InputTree -> IO GalleryItem
+buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
+  mkGalleryItem inputTree >>= return . named galleryName
   where
-    resNode (InputFile path sidecar) =
+    named :: String -> GalleryItem -> GalleryItem
+    named name item = item { title = name }
+
+    mkGalleryItem :: InputTree -> IO GalleryItem
+    mkGalleryItem InputFile{path, sidecar} =
       do
         processedItem <- processItem path
         processedThumbnail <- processThumbnail path
-        return ItemResource
-          { sidecar = sidecar
-          , resPath = processedItem
-          , thumbnailPath = processedThumbnail }
-
-    resNode (InputDir path thumbnailPath items) =
+        return GalleryItem
+          { title = optMeta title $ fileName path
+          , date = optMeta date "" -- TODO: check and normalise dates
+          , description = optMeta description ""
+          , tags = optMeta tags []
+          , path = processedItem
+          , thumbnail = processedThumbnail
+          , properties = Other } -- TODO
+      where
+        optMeta :: (Sidecar -> Maybe a) -> a -> a
+        optMeta get fallback = fromMaybe fallback $ get sidecar
+
+    mkGalleryItem InputDir{path, dirThumbnailPath, items} =
       do
         processedDir <- processDir path
-        processedThumbnail <- maybeThumbnail thumbnailPath
-        dirItems <- parallel $ map resNode items
-        return DirResource
-          { items = dirItems
-          , resPath = processedDir
-          , thumbnailPath = processedThumbnail }
-
-    maybeThumbnail :: Maybe Path -> IO (Maybe Path)
-    maybeThumbnail Nothing = return Nothing
-    maybeThumbnail (Just path) = processThumbnail path
-
-
-flattenResourceTree :: ResourceTree -> [ResourceTree]
-flattenResourceTree item@ItemResource{} = [item]
-flattenResourceTree dir@(DirResource items _ _) =
-  dir:(concatMap flattenResourceTree items)
-
-outputDiff :: ResourceTree -> FSNode -> [Path]
-outputDiff resources ref =
-  (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
+        processedThumbnail <- maybeThumbnail dirThumbnailPath
+        processedItems <- parallel $ map mkGalleryItem items
+        return GalleryItem
+          { title = fileName path
+            -- TODO: consider using the most recent item's date? what if empty?
+          , date = ""
+            -- TODO: consider allowing metadata sidecars for directories too
+          , description = ""
+          , tags = aggregateChildTags processedItems
+          , path = processedDir
+          , thumbnail = processedThumbnail
+          , properties = Directory processedItems }
+      where
+        maybeThumbnail :: Maybe Path -> IO (Maybe Path)
+        maybeThumbnail Nothing = return Nothing
+        maybeThumbnail (Just path) = processThumbnail path
+
+        aggregateChildTags :: [GalleryItem] -> [Tag]
+        aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
+
+        unique :: Ord a => [a] -> [a]
+        unique = Set.toList . Set.fromList
+
+
+flattenGalleryTree :: GalleryItem -> [GalleryItem]
+flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) =
+  dir : concatMap flattenGalleryTree items
+flattenGalleryTree simple = [simple]
+
+
+galleryOutputDiff :: GalleryItem -> FSNode -> [Path]
+galleryOutputDiff resources ref =
+  (fsPaths ref) \\ (resPaths $ flattenGalleryTree resources)
   where
-    resPaths :: [ResourceTree] -> [Path]
-    resPaths resList = map resPath resList ++ thumbnailPaths resList
+    resPaths :: [GalleryItem] -> [Path]
+    resPaths resList = map (path::(GalleryItem->Path)) resList ++ thumbnailPaths resList
 
-    thumbnailPaths :: [ResourceTree] -> [Path]
-    thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnailPath)
+    thumbnailPaths :: [GalleryItem] -> [Path]
+    thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnail)
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
 
-cleanupResourceDir :: ResourceTree -> FileName -> IO ()
-cleanupResourceDir resourceTree outputDir =
+
+galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
+galleryCleanupResourceDir resourceTree outputDir =
   readDirectory outputDir
-  >>= return . outputDiff resourceTree . root
+  >>= return . galleryOutputDiff resourceTree . root
   >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs
   >>= return . map (localPath . (/>) outputDir)
   >>= mapM_ remove
-- 
cgit v1.2.3


From 9d2b6cf4641cfff08ad556d3a7b24d4d63464eb5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 00:16:29 +0100
Subject: compiler: populate the properties field in the index

GitHub: closes #8
---
 compiler/src/Resource.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index dcf9422..bffa569 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -25,7 +25,7 @@
 
 module Resource
   ( DirProcessor, ItemProcessor, ThumbnailProcessor
-  , GalleryItem, GalleryItemProps, Resolution(..)
+  , GalleryItem(..), GalleryItemProps(..), Resolution(..)
   , buildGalleryTree, galleryCleanupResourceDir
   ) where
 
@@ -99,7 +99,7 @@ instance ToJSON GalleryItem where
 
 
 type DirProcessor = Path -> IO Path
-type ItemProcessor = Path -> IO Path
+type ItemProcessor = Path -> IO (Path, GalleryItemProps)
 type ThumbnailProcessor = Path -> IO (Maybe Path)
 
 
@@ -115,16 +115,16 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
     mkGalleryItem :: InputTree -> IO GalleryItem
     mkGalleryItem InputFile{path, sidecar} =
       do
-        processedItem <- processItem path
+        (processedItemPath, properties) <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
           { title = optMeta title $ fileName path
           , date = optMeta date "" -- TODO: check and normalise dates
           , description = optMeta description ""
           , tags = optMeta tags []
-          , path = processedItem
+          , path = processedItemPath
           , thumbnail = processedThumbnail
-          , properties = Other } -- TODO
+          , properties = properties } -- TODO
       where
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
-- 
cgit v1.2.3


From 7ef9f09c0f3be1cd5e1f38c9abc845abc9ed3639 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 01:39:23 +0100
Subject: compiler: add option to add implicit directory tags

GitHub: closes #7
---
 compiler/src/Resource.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index bffa569..bbabf18 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -105,15 +105,15 @@ type ThumbnailProcessor = Path -> IO (Maybe Path)
 
 buildGalleryTree ::
      DirProcessor -> ItemProcessor -> ThumbnailProcessor
-  -> String -> InputTree -> IO GalleryItem
-buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
-  mkGalleryItem inputTree >>= return . named galleryName
+  -> Bool -> String -> InputTree -> IO GalleryItem
+buildGalleryTree processDir processItem processThumbnail addDirTag galleryName inputTree =
+  mkGalleryItem Nothing inputTree >>= return . named galleryName
   where
     named :: String -> GalleryItem -> GalleryItem
     named name item = item { title = name }
 
-    mkGalleryItem :: InputTree -> IO GalleryItem
-    mkGalleryItem InputFile{path, sidecar} =
+    mkGalleryItem :: Maybe String -> InputTree -> IO GalleryItem
+    mkGalleryItem parent InputFile{path, sidecar} =
       do
         (processedItemPath, properties) <- processItem path
         processedThumbnail <- processThumbnail path
@@ -121,7 +121,7 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
           { title = optMeta title $ fileName path
           , date = optMeta date "" -- TODO: check and normalise dates
           , description = optMeta description ""
-          , tags = optMeta tags []
+          , tags = (optMeta tags []) ++ implicitParentTag parent
           , path = processedItemPath
           , thumbnail = processedThumbnail
           , properties = properties } -- TODO
@@ -129,18 +129,18 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem InputDir{path, dirThumbnailPath, items} =
+    mkGalleryItem parent InputDir{path, dirThumbnailPath, items} =
       do
         processedDir <- processDir path
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map mkGalleryItem items
+        processedItems <- parallel $ map (mkGalleryItem $ maybeFileName path) items
         return GalleryItem
           { title = fileName path
             -- TODO: consider using the most recent item's date? what if empty?
           , date = ""
             -- TODO: consider allowing metadata sidecars for directories too
           , description = ""
-          , tags = aggregateChildTags processedItems
+          , tags = (aggregateChildTags processedItems) ++ implicitParentTag parent
           , path = processedDir
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
@@ -155,6 +155,10 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
         unique :: Ord a => [a] -> [a]
         unique = Set.toList . Set.fromList
 
+    implicitParentTag :: Maybe String -> [Tag]
+    implicitParentTag Nothing = []
+    implicitParentTag (Just parent) = if addDirTag then [parent] else []
+
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]
 flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) =
-- 
cgit v1.2.3


From abdf82bbfde843a87bd00746f52dafdd28f3f60b Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 15:31:38 +0100
Subject: compiler: make absent file names more explicit

---
 compiler/src/Resource.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index bbabf18..b52522c 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019  Pacien TRAN-GIRARD
+-- 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
@@ -118,7 +118,7 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i
         (processedItemPath, properties) <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
-          { title = optMeta title $ fileName path
+          { title = optMeta title $ fromMaybe "" $ fileName path
           , date = optMeta date "" -- TODO: check and normalise dates
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTag parent
@@ -133,9 +133,9 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i
       do
         processedDir <- processDir path
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem $ maybeFileName path) items
+        processedItems <- parallel $ map (mkGalleryItem $ fileName path) items
         return GalleryItem
-          { title = fileName path
+          { title = fromMaybe "" $ fileName path
             -- TODO: consider using the most recent item's date? what if empty?
           , date = ""
             -- TODO: consider allowing metadata sidecars for directories too
@@ -177,7 +177,7 @@ galleryOutputDiff resources ref =
     thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnail)
 
     fsPaths :: FSNode -> [Path]
-    fsPaths = map nodePath . tail . flattenDir
+    fsPaths = map Files.path . tail . flattenDir
 
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
-- 
cgit v1.2.3


From 9dd271504160b624284dbc438cdc867b6ca0d0e7 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 16:24:02 +0100
Subject: compiler: enable warnings and fix them

GitHub: fixes #9
---
 compiler/src/Resource.hs | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index b52522c..c09b77a 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -31,8 +31,7 @@ module Resource
 
 
 import Control.Concurrent.ParallelIO.Global (parallel)
-import Data.Function ((&))
-import Data.List ((\\), subsequences, sortBy)
+import Data.List ((\\), sortBy)
 import Data.Ord (comparing)
 import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe)
@@ -57,10 +56,7 @@ encodingOptions = JSON.defaultOptions
   }
 
 
-
 type Tag = String
-type FileSizeKB = Int
-
 
 data Resolution = Resolution
   { width :: Int
@@ -147,7 +143,7 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i
       where
         maybeThumbnail :: Maybe Path -> IO (Maybe Path)
         maybeThumbnail Nothing = return Nothing
-        maybeThumbnail (Just path) = processThumbnail path
+        maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
         aggregateChildTags :: [GalleryItem] -> [Tag]
         aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
-- 
cgit v1.2.3


From ee222b40569b9f40c482dd9df518f6445c1c304d Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 16:42:09 +0100
Subject: compiler: enable language extensions on whole project

---
 compiler/src/Resource.hs | 7 -------
 1 file changed, 7 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c09b77a..19bd32c 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -16,13 +16,6 @@
 -- 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/>.
 
-{-# LANGUAGE
-    DuplicateRecordFields
-  , DeriveGeneric
-  , DeriveAnyClass
-  , NamedFieldPuns
-#-}
-
 module Resource
   ( DirProcessor, ItemProcessor, ThumbnailProcessor
   , GalleryItem(..), GalleryItemProps(..), Resolution(..)
-- 
cgit v1.2.3


From ab2f076c5bf546f8aca9910b2b61a1b5a67361bc Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 18:39:47 +0100
Subject: compiler: distinguish item and resource paths

GitHub: closes #13
---
 compiler/src/Resource.hs | 80 +++++++++++++++++++++++++++++-------------------
 1 file changed, 49 insertions(+), 31 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 19bd32c..2019418 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -17,7 +17,7 @@
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Resource
-  ( DirProcessor, ItemProcessor, ThumbnailProcessor
+  ( ItemProcessor, ThumbnailProcessor
   , GalleryItem(..), GalleryItemProps(..), Resolution(..)
   , buildGalleryTree, galleryCleanupResourceDir
   ) where
@@ -27,7 +27,8 @@ import Control.Concurrent.ParallelIO.Global (parallel)
 import Data.List ((\\), sortBy)
 import Data.Ord (comparing)
 import Data.Char (toLower)
-import Data.Maybe (mapMaybe, fromMaybe)
+import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
+import Data.Function ((&))
 import qualified Data.Set as Set
 
 import GHC.Generics (Generic)
@@ -63,8 +64,8 @@ instance ToJSON Resolution where
 
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
-  | Picture
-  | Other
+  | Picture { resource :: Path }
+  | Other { resource :: Path }
   deriving (Generic, Show)
 
 instance ToJSON GalleryItemProps where
@@ -87,53 +88,60 @@ instance ToJSON GalleryItem where
   toEncoding = genericToEncoding encodingOptions
 
 
-type DirProcessor = Path -> IO Path
-type ItemProcessor = Path -> IO (Path, GalleryItemProps)
+type ItemProcessor = Path -> IO GalleryItemProps
 type ThumbnailProcessor = Path -> IO (Maybe Path)
 
 
 buildGalleryTree ::
-     DirProcessor -> ItemProcessor -> ThumbnailProcessor
+     ItemProcessor -> ThumbnailProcessor
   -> Bool -> String -> InputTree -> IO GalleryItem
-buildGalleryTree processDir processItem processThumbnail addDirTag galleryName inputTree =
-  mkGalleryItem Nothing inputTree >>= return . named galleryName
+buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
+  mkGalleryItem (Path []) inputTree >>= return . named galleryName
   where
     named :: String -> GalleryItem -> GalleryItem
     named name item = item { title = name }
 
-    mkGalleryItem :: Maybe String -> InputTree -> IO GalleryItem
-    mkGalleryItem parent InputFile{path, sidecar} =
+    mkGalleryItem :: Path -> InputTree -> IO GalleryItem
+    mkGalleryItem parents InputFile{path, sidecar} =
       do
-        (processedItemPath, properties) <- processItem path
+        properties <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
-          { title = optMeta title $ fromMaybe "" $ fileName path
+          { title = itemTitle
           , date = optMeta date "" -- TODO: check and normalise dates
           , description = optMeta description ""
-          , tags = (optMeta tags []) ++ implicitParentTag parent
-          , path = processedItemPath
+          , tags = (optMeta tags []) ++ implicitParentTag parents
+          , path = parents </ itemTitle
           , thumbnail = processedThumbnail
           , properties = properties } -- TODO
       where
+        itemTitle :: String
+        itemTitle = optMeta title $ fromMaybe "" $ fileName path
+
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem parent InputDir{path, dirThumbnailPath, items} =
+    mkGalleryItem parents InputDir{path, dirThumbnailPath, items} =
       do
-        processedDir <- processDir path
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem $ fileName path) items
+        processedItems <- parallel $ map (mkGalleryItem itemPath) items
         return GalleryItem
-          { title = fromMaybe "" $ fileName path
+          { title = itemTitle
             -- TODO: consider using the most recent item's date? what if empty?
           , date = ""
             -- TODO: consider allowing metadata sidecars for directories too
           , description = ""
-          , tags = (aggregateChildTags processedItems) ++ implicitParentTag parent
-          , path = processedDir
+          , tags = (aggregateChildTags processedItems) ++ implicitParentTag parents
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
       where
+        itemTitle :: String
+        itemTitle = fromMaybe "" $ fileName path
+
+        itemPath :: Path
+        itemPath = parents </ itemTitle
+
         maybeThumbnail :: Maybe Path -> IO (Maybe Path)
         maybeThumbnail Nothing = return Nothing
         maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
@@ -144,9 +152,10 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i
         unique :: Ord a => [a] -> [a]
         unique = Set.toList . Set.fromList
 
-    implicitParentTag :: Maybe String -> [Tag]
-    implicitParentTag Nothing = []
-    implicitParentTag (Just parent) = if addDirTag then [parent] else []
+    implicitParentTag :: Path -> [Tag]
+    implicitParentTag parents
+      | addDirTag = maybeToList $ fileName parents
+      | otherwise = []
 
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]
@@ -157,16 +166,25 @@ flattenGalleryTree simple = [simple]
 
 galleryOutputDiff :: GalleryItem -> FSNode -> [Path]
 galleryOutputDiff resources ref =
-  (fsPaths ref) \\ (resPaths $ flattenGalleryTree resources)
+  (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources)
   where
-    resPaths :: [GalleryItem] -> [Path]
-    resPaths resList = map (path::(GalleryItem->Path)) resList ++ thumbnailPaths resList
+    filesystemPaths :: FSNode -> [Path]
+    filesystemPaths = map Files.path . tail . flattenDir
 
-    thumbnailPaths :: [GalleryItem] -> [Path]
-    thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnail)
+    compiledPaths :: [GalleryItem] -> [Path]
+    compiledPaths items =
+      resourcePaths items ++ thumbnailPaths items
+      & concatMap subPaths
 
-    fsPaths :: FSNode -> [Path]
-    fsPaths = map Files.path . tail . flattenDir
+    resourcePaths :: [GalleryItem] -> [Path]
+    resourcePaths = mapMaybe (resourcePath . properties)
+
+    resourcePath :: GalleryItemProps -> Maybe Path
+    resourcePath Directory{} = Nothing
+    resourcePath resourceProps = Just $ resource resourceProps
+
+    thumbnailPaths :: [GalleryItem] -> [Path]
+    thumbnailPaths = mapMaybe thumbnail
 
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
-- 
cgit v1.2.3


From 2ad60869c2e8d0846672ccb18b2de99c9cf33671 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 19:24:50 +0100
Subject: compiler: add option to add tags from n parent directories

GitHub: closes #15
---
 compiler/src/Resource.hs | 31 +++++++++++++------------------
 1 file changed, 13 insertions(+), 18 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 2019418..261191b 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -27,7 +27,7 @@ import Control.Concurrent.ParallelIO.Global (parallel)
 import Data.List ((\\), sortBy)
 import Data.Ord (comparing)
 import Data.Char (toLower)
-import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
+import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import qualified Data.Set as Set
 
@@ -94,15 +94,12 @@ type ThumbnailProcessor = Path -> IO (Maybe Path)
 
 buildGalleryTree ::
      ItemProcessor -> ThumbnailProcessor
-  -> Bool -> String -> InputTree -> IO GalleryItem
-buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
-  mkGalleryItem (Path []) inputTree >>= return . named galleryName
+  -> Int -> String -> InputTree -> IO GalleryItem
+buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree =
+  mkGalleryItem (Just galleryName) (Path []) inputTree
   where
-    named :: String -> GalleryItem -> GalleryItem
-    named name item = item { title = name }
-
-    mkGalleryItem :: Path -> InputTree -> IO GalleryItem
-    mkGalleryItem parents InputFile{path, sidecar} =
+    mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
+    mkGalleryItem _ parents InputFile{path, sidecar} =
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
@@ -110,7 +107,7 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
           { title = itemTitle
           , date = optMeta date "" -- TODO: check and normalise dates
           , description = optMeta description ""
-          , tags = (optMeta tags []) ++ implicitParentTag parents
+          , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
           , thumbnail = processedThumbnail
           , properties = properties } -- TODO
@@ -121,23 +118,23 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem parents InputDir{path, dirThumbnailPath, items} =
+    mkGalleryItem rootTitle parents InputDir{path, dirThumbnailPath, items} =
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem itemPath) items
+        processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
         return GalleryItem
           { title = itemTitle
             -- TODO: consider using the most recent item's date? what if empty?
           , date = ""
             -- TODO: consider allowing metadata sidecars for directories too
           , description = ""
-          , tags = (aggregateChildTags processedItems) ++ implicitParentTag parents
+          , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
           , path = itemPath
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
       where
         itemTitle :: String
-        itemTitle = fromMaybe "" $ fileName path
+        itemTitle = flip fromMaybe rootTitle (fromMaybe "" $ fileName path)
 
         itemPath :: Path
         itemPath = parents </ itemTitle
@@ -152,10 +149,8 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
         unique :: Ord a => [a] -> [a]
         unique = Set.toList . Set.fromList
 
-    implicitParentTag :: Path -> [Tag]
-    implicitParentTag parents
-      | addDirTag = maybeToList $ fileName parents
-      | otherwise = []
+    implicitParentTags :: Path -> [Tag]
+    implicitParentTags (Path elements) = take tagsFromDirectories elements
 
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]
-- 
cgit v1.2.3


From c8dea48bb4a0ec137bafba3bec79352eae2f48c0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 6 Jan 2020 00:01:53 +0100
Subject: compiler: default item date to filesystem last mod date

GitHub: closes #14
---
 compiler/src/Resource.hs | 32 ++++++++++++++++++++++++++------
 1 file changed, 26 insertions(+), 6 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 261191b..207239f 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -30,6 +30,10 @@ import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import qualified Data.Set as Set
+import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
+import Data.Time.Format.ISO8601 (iso8601ParseM)
+import System.Directory (getModificationTime)
+import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
 import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding)
@@ -75,7 +79,7 @@ instance ToJSON GalleryItemProps where
 
 data GalleryItem = GalleryItem
   { title :: String
-  , date :: String -- TODO: checked ISO8601 date
+  , date :: ZonedTime
   , description :: String
   , tags :: [Tag]
   , path :: Path
@@ -103,18 +107,22 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
+        fileModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , date = optMeta date "" -- TODO: check and normalise dates
+          , date = fromMaybe fileModTime itemDate
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
           , thumbnail = processedThumbnail
-          , properties = properties } -- TODO
+          , properties = properties }
       where
         itemTitle :: String
         itemTitle = optMeta title $ fromMaybe "" $ fileName path
 
+        itemDate :: Maybe ZonedTime
+        itemDate = Input.date sidecar >>= iso8601ParseM
+
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
@@ -122,11 +130,10 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
         processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
+        dirModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-            -- TODO: consider using the most recent item's date? what if empty?
-          , date = ""
-            -- TODO: consider allowing metadata sidecars for directories too
+          , date = fromMaybe dirModTime $ mostRecentChildModTime processedItems
           , description = ""
           , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
           , path = itemPath
@@ -143,6 +150,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         maybeThumbnail Nothing = return Nothing
         maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
+        mostRecentChildModTime :: [GalleryItem] -> Maybe ZonedTime
+        mostRecentChildModTime =
+          maximumByMay comparingDates . map (date::(GalleryItem -> ZonedTime))
+
+        comparingDates :: ZonedTime -> ZonedTime -> Ordering
+        comparingDates l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
+
         aggregateChildTags :: [GalleryItem] -> [Tag]
         aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
 
@@ -152,6 +166,12 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
     implicitParentTags :: Path -> [Tag]
     implicitParentTags (Path elements) = take tagsFromDirectories elements
 
+    lastModTime :: Path -> IO ZonedTime
+    lastModTime path =
+      localPath path
+      &   getModificationTime
+      >>= return . utcToZonedTime utc
+
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]
 flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) =
-- 
cgit v1.2.3


From 03d39102ba55cda7cbe80fcdeb9b250caaa70bd0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 6 Jan 2020 10:28:27 +0100
Subject: compiler: properly reject invalid dates in sidecar files

GitHub: closes #31
---
 compiler/src/Resource.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 207239f..53d61ac 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -31,7 +31,6 @@ import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import qualified Data.Set as Set
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import Data.Time.Format.ISO8601 (iso8601ParseM)
 import System.Directory (getModificationTime)
 import Safe.Foldable (maximumByMay)
 
@@ -110,7 +109,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         fileModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , date = fromMaybe fileModTime itemDate
+          , date = fromMaybe fileModTime $ Input.date sidecar
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
@@ -120,9 +119,6 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         itemTitle :: String
         itemTitle = optMeta title $ fromMaybe "" $ fileName path
 
-        itemDate :: Maybe ZonedTime
-        itemDate = Input.date sidecar >>= iso8601ParseM
-
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-- 
cgit v1.2.3


From f1ffff03ad6bf86c32c3af90393bd53ca21ad4db Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 6 Jan 2020 11:05:18 +0100
Subject: compiler: rename date field to more explicit datetime

---
 compiler/src/Resource.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 53d61ac..29906b7 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -78,7 +78,7 @@ instance ToJSON GalleryItemProps where
 
 data GalleryItem = GalleryItem
   { title :: String
-  , date :: ZonedTime
+  , datetime :: ZonedTime
   , description :: String
   , tags :: [Tag]
   , path :: Path
@@ -109,7 +109,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         fileModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , date = fromMaybe fileModTime $ Input.date sidecar
+          , datetime = fromMaybe fileModTime $ Input.datetime sidecar
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
@@ -129,7 +129,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         dirModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , date = fromMaybe dirModTime $ mostRecentChildModTime processedItems
+          , datetime = fromMaybe dirModTime $ mostRecentChildModTime processedItems
           , description = ""
           , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
           , path = itemPath
@@ -148,10 +148,10 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
 
         mostRecentChildModTime :: [GalleryItem] -> Maybe ZonedTime
         mostRecentChildModTime =
-          maximumByMay comparingDates . map (date::(GalleryItem -> ZonedTime))
+          maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime))
 
-        comparingDates :: ZonedTime -> ZonedTime -> Ordering
-        comparingDates l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
+        comparingTime :: ZonedTime -> ZonedTime -> Ordering
+        comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
 
         aggregateChildTags :: [GalleryItem] -> [Tag]
         aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
-- 
cgit v1.2.3


From f5f6ad66b0a5014e9b0da6d5437c27296edab9f0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 6 Jan 2020 20:53:37 +0100
Subject: compiler: fix file mod time reading from other directory

---
 compiler/src/Resource.hs | 19 +++++++------------
 1 file changed, 7 insertions(+), 12 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 29906b7..79fe354 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -30,8 +30,8 @@ import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import qualified Data.Set as Set
+import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import System.Directory (getModificationTime)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
@@ -102,14 +102,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
   mkGalleryItem (Just galleryName) (Path []) inputTree
   where
     mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
-    mkGalleryItem _ parents InputFile{path, sidecar} =
+    mkGalleryItem _ parents InputFile{path, modTime, sidecar} =
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
-        fileModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , datetime = fromMaybe fileModTime $ Input.datetime sidecar
+          , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
@@ -122,14 +121,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem rootTitle parents InputDir{path, dirThumbnailPath, items} =
+    mkGalleryItem rootTitle parents InputDir{path, modTime, dirThumbnailPath, items} =
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
         processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
-        dirModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , datetime = fromMaybe dirModTime $ mostRecentChildModTime processedItems
+          , datetime = fromMaybe (toZonedTime modTime) (mostRecentChildModTime processedItems)
           , description = ""
           , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
           , path = itemPath
@@ -162,11 +160,8 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
     implicitParentTags :: Path -> [Tag]
     implicitParentTags (Path elements) = take tagsFromDirectories elements
 
-    lastModTime :: Path -> IO ZonedTime
-    lastModTime path =
-      localPath path
-      &   getModificationTime
-      >>= return . utcToZonedTime utc
+    toZonedTime :: UTCTime -> ZonedTime
+    toZonedTime = utcToZonedTime utc
 
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]
-- 
cgit v1.2.3


From e3a5a52114880bdabf62cb205ec01374a93a28bd Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 7 Jan 2020 08:36:16 +0100
Subject: compiler: change item path semantic

---
 compiler/src/Resource.hs | 46 ++++++++++++++++++++--------------------------
 1 file changed, 20 insertions(+), 26 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 79fe354..0a4977a 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -99,66 +99,60 @@ buildGalleryTree ::
      ItemProcessor -> ThumbnailProcessor
   -> Int -> String -> InputTree -> IO GalleryItem
 buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree =
-  mkGalleryItem (Just galleryName) (Path []) inputTree
+  mkGalleryItem [galleryName] inputTree
   where
-    mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
-    mkGalleryItem _ parents InputFile{path, modTime, sidecar} =
+    mkGalleryItem :: [String] -> InputTree -> IO GalleryItem
+    mkGalleryItem parentTitles InputFile{path, modTime, sidecar} =
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
-          { title = itemTitle
+          { title = optMeta title $ fromMaybe "" $ fileName path
           , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
           , description = optMeta description ""
-          , tags = (optMeta tags []) ++ implicitParentTags parents
-          , path = parents </ itemTitle
+          , tags = unique ((optMeta tags []) ++ implicitParentTags parentTitles)
+          , path = path
           , thumbnail = processedThumbnail
           , properties = properties }
       where
-        itemTitle :: String
-        itemTitle = optMeta title $ fromMaybe "" $ fileName path
-
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem rootTitle parents InputDir{path, modTime, dirThumbnailPath, items} =
+    mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} =
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
+        processedItems <- parallel $ map (mkGalleryItem $ itemTitle:parentTitles) items
         return GalleryItem
           { title = itemTitle
-          , datetime = fromMaybe (toZonedTime modTime) (mostRecentChildModTime processedItems)
+          , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems)
           , description = ""
-          , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
-          , path = itemPath
+          , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles)
+          , path = path
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
       where
         itemTitle :: String
-        itemTitle = flip fromMaybe rootTitle (fromMaybe "" $ fileName path)
-
-        itemPath :: Path
-        itemPath = parents </ itemTitle
+        itemTitle = fromMaybe (head parentTitles) (fileName path)
 
         maybeThumbnail :: Maybe Path -> IO (Maybe Path)
         maybeThumbnail Nothing = return Nothing
         maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
-        mostRecentChildModTime :: [GalleryItem] -> Maybe ZonedTime
-        mostRecentChildModTime =
+        mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime
+        mostRecentModTime =
           maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime))
 
         comparingTime :: ZonedTime -> ZonedTime -> Ordering
         comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
 
-        aggregateChildTags :: [GalleryItem] -> [Tag]
-        aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
+        aggregateTags :: [GalleryItem] -> [Tag]
+        aggregateTags = concatMap (\item -> tags (item::GalleryItem))
 
-        unique :: Ord a => [a] -> [a]
-        unique = Set.toList . Set.fromList
+    unique :: Ord a => [a] -> [a]
+    unique = Set.toList . Set.fromList
 
-    implicitParentTags :: Path -> [Tag]
-    implicitParentTags (Path elements) = take tagsFromDirectories elements
+    implicitParentTags :: [String] -> [Tag]
+    implicitParentTags = take tagsFromDirectories
 
     toZonedTime :: UTCTime -> ZonedTime
     toZonedTime = utcToZonedTime utc
-- 
cgit v1.2.3


From 8c8aede70760b7b0de4bfbe4aceaf90f640e03d6 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 8 Jan 2020 08:35:36 +0100
Subject: compiler: canonicalise item/dir paths

---
 compiler/src/Resource.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 0a4977a..e8ca889 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -111,7 +111,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
           , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
           , description = optMeta description ""
           , tags = unique ((optMeta tags []) ++ implicitParentTags parentTitles)
-          , path = path
+          , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = properties }
       where
@@ -127,7 +127,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
           , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems)
           , description = ""
           , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles)
-          , path = path
+          , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
       where
-- 
cgit v1.2.3


From c1e334b883e28381851fca077ff36aee0387b1db Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 8 Jan 2020 09:03:59 +0100
Subject: compiler: exclude gallery name from implicit directory tags

---
 compiler/src/Resource.hs | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index e8ca889..56f7a3f 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -27,7 +27,7 @@ import Control.Concurrent.ParallelIO.Global (parallel)
 import Data.List ((\\), sortBy)
 import Data.Ord (comparing)
 import Data.Char (toLower)
-import Data.Maybe (mapMaybe, fromMaybe)
+import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
 import Data.Function ((&))
 import qualified Data.Set as Set
 import Data.Time.Clock (UTCTime)
@@ -99,7 +99,7 @@ buildGalleryTree ::
      ItemProcessor -> ThumbnailProcessor
   -> Int -> String -> InputTree -> IO GalleryItem
 buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree =
-  mkGalleryItem [galleryName] inputTree
+  mkGalleryItem [] inputTree
   where
     mkGalleryItem :: [String] -> InputTree -> IO GalleryItem
     mkGalleryItem parentTitles InputFile{path, modTime, sidecar} =
@@ -107,46 +107,48 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         properties <- processItem path
         processedThumbnail <- processThumbnail path
         return GalleryItem
-          { title = optMeta title $ fromMaybe "" $ fileName path
+          { title = fromMeta title $ fromMaybe "" $ fileName path
           , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
-          , description = optMeta description ""
-          , tags = unique ((optMeta tags []) ++ implicitParentTags parentTitles)
+          , description = fromMeta description ""
+          , tags = unique ((fromMeta tags []) ++ implicitParentTags parentTitles)
           , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = properties }
+
       where
-        optMeta :: (Sidecar -> Maybe a) -> a -> a
-        optMeta get fallback = fromMaybe fallback $ get sidecar
+        fromMeta :: (Sidecar -> Maybe a) -> a -> a
+        fromMeta get fallback = fromMaybe fallback $ get sidecar
 
     mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} =
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
-        processedItems <- parallel $ map (mkGalleryItem $ itemTitle:parentTitles) items
+        processedItems <- parallel $ map (mkGalleryItem subItemsParents) items
         return GalleryItem
-          { title = itemTitle
+          { title = fromMaybe galleryName (fileName path)
           , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems)
           , description = ""
           , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles)
           , path = "/" /> path
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
+
       where
-