diff options
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r-- | compiler/src/Resource.hs | 22 |
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 | ||
106 | buildGalleryTree :: | 106 | buildGalleryTree :: |
107 | DirProcessor -> ItemProcessor -> ThumbnailProcessor | 107 | DirProcessor -> ItemProcessor -> ThumbnailProcessor |
108 | -> String -> InputTree -> IO GalleryItem | 108 | -> Bool -> String -> InputTree -> IO GalleryItem |
109 | buildGalleryTree processDir processItem processThumbnail galleryName inputTree = | 109 | buildGalleryTree 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 | ||
159 | flattenGalleryTree :: GalleryItem -> [GalleryItem] | 163 | flattenGalleryTree :: GalleryItem -> [GalleryItem] |
160 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = | 164 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = |