aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs22
1 files changed, 13 insertions, 9 deletions
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)
105 105
106buildGalleryTree :: 106buildGalleryTree ::
107 DirProcessor -> ItemProcessor -> ThumbnailProcessor 107 DirProcessor -> ItemProcessor -> ThumbnailProcessor
108 -> String -> InputTree -> IO GalleryItem 108 -> Bool -> String -> InputTree -> IO GalleryItem
109buildGalleryTree processDir processItem processThumbnail galleryName inputTree = 109buildGalleryTree processDir processItem processThumbnail addDirTag galleryName inputTree =
110 mkGalleryItem inputTree >>= return . named galleryName 110 mkGalleryItem Nothing inputTree >>= return . named galleryName
111 where 111 where
112 named :: String -> GalleryItem -> GalleryItem 112 named :: String -> GalleryItem -> GalleryItem
113 named name item = item { title = name } 113 named name item = item { title = name }
114 114
115 mkGalleryItem :: InputTree -> IO GalleryItem 115 mkGalleryItem :: Maybe String -> InputTree -> IO GalleryItem
116 mkGalleryItem InputFile{path, sidecar} = 116 mkGalleryItem parent InputFile{path, sidecar} =
117 do 117 do
118 (processedItemPath, properties) <- processItem path 118 (processedItemPath, properties) <- processItem path
119 processedThumbnail <- processThumbnail path 119 processedThumbnail <- processThumbnail path
@@ -121,7 +121,7 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
121 { title = optMeta title $ fileName path 121 { title = optMeta title $ fileName path
122 , date = optMeta date "" -- TODO: check and normalise dates 122 , date = optMeta date "" -- TODO: check and normalise dates
123 , description = optMeta description "" 123 , description = optMeta description ""
124 , tags = optMeta tags [] 124 , tags = (optMeta tags []) ++ implicitParentTag parent
125 , path = processedItemPath 125 , path = processedItemPath
126 , thumbnail = processedThumbnail 126 , thumbnail = processedThumbnail
127 , properties = properties } -- TODO 127 , properties = properties } -- TODO
@@ -129,18 +129,18 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
129 optMeta :: (Sidecar -> Maybe a) -> a -> a 129 optMeta :: (Sidecar -> Maybe a) -> a -> a
130 optMeta get fallback = fromMaybe fallback $ get sidecar 130 optMeta get fallback = fromMaybe fallback $ get sidecar
131 131
132 mkGalleryItem InputDir{path, dirThumbnailPath, items} = 132 mkGalleryItem parent InputDir{path, dirThumbnailPath, items} =
133 do 133 do
134 processedDir <- processDir path 134 processedDir <- processDir path
135 processedThumbnail <- maybeThumbnail dirThumbnailPath 135 processedThumbnail <- maybeThumbnail dirThumbnailPath
136 processedItems <- parallel $ map mkGalleryItem items 136 processedItems <- parallel $ map (mkGalleryItem $ maybeFileName path) items
137 return GalleryItem 137 return GalleryItem
138 { title = fileName path 138 { title = fileName path
139 -- TODO: consider using the most recent item's date? what if empty? 139 -- TODO: consider using the most recent item's date? what if empty?
140 , date = "" 140 , date = ""
141 -- TODO: consider allowing metadata sidecars for directories too 141 -- TODO: consider allowing metadata sidecars for directories too
142 , description = "" 142 , description = ""
143 , tags = aggregateChildTags processedItems 143 , tags = (aggregateChildTags processedItems) ++ implicitParentTag parent
144 , path = processedDir 144 , path = processedDir
145 , thumbnail = processedThumbnail 145 , thumbnail = processedThumbnail
146 , properties = Directory processedItems } 146 , properties = Directory processedItems }
@@ -155,6 +155,10 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
155 unique :: Ord a => [a] -> [a] 155 unique :: Ord a => [a] -> [a]
156 unique = Set.toList . Set.fromList 156 unique = Set.toList . Set.fromList
157 157
158 implicitParentTag :: Maybe String -> [Tag]
159 implicitParentTag Nothing = []
160 implicitParentTag (Just parent) = if addDirTag then [parent] else []
161
158 162
159flattenGalleryTree :: GalleryItem -> [GalleryItem] 163flattenGalleryTree :: GalleryItem -> [GalleryItem]
160flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = 164flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) =