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