diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/src/Resource.hs | 46 |
1 files changed, 20 insertions, 26 deletions
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 :: | |||
99 | ItemProcessor -> ThumbnailProcessor | 99 | ItemProcessor -> ThumbnailProcessor |
100 | -> Int -> String -> InputTree -> IO GalleryItem | 100 | -> Int -> String -> InputTree -> IO GalleryItem |
101 | buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree = | 101 | buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree = |
102 | mkGalleryItem (Just galleryName) (Path []) inputTree | 102 | mkGalleryItem [galleryName] inputTree |
103 | where | 103 | where |
104 | mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem | 104 | mkGalleryItem :: [String] -> InputTree -> IO GalleryItem |
105 | mkGalleryItem _ parents InputFile{path, modTime, sidecar} = | 105 | mkGalleryItem parentTitles InputFile{path, modTime, sidecar} = |
106 | do | 106 | do |
107 | properties <- processItem path | 107 | properties <- processItem path |
108 | processedThumbnail <- processThumbnail path | 108 | processedThumbnail <- processThumbnail path |
109 | return GalleryItem | 109 | return GalleryItem |
110 | { title = itemTitle | 110 | { title = optMeta title $ fromMaybe "" $ fileName path |
111 | , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar) | 111 | , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar) |
112 | , description = optMeta description "" | 112 | , description = optMeta description "" |
113 | , tags = (optMeta tags []) ++ implicitParentTags parents | 113 | , tags = unique ((optMeta tags []) ++ implicitParentTags parentTitles) |
114 | , path = parents </ itemTitle | 114 | , path = path |
115 | , thumbnail = processedThumbnail | 115 | , thumbnail = processedThumbnail |
116 | , properties = properties } | 116 | , properties = properties } |
117 | where | 117 | where |
118 | itemTitle :: String | ||
119 | itemTitle = optMeta title $ fromMaybe "" $ fileName path | ||
120 | |||
121 | optMeta :: (Sidecar -> Maybe a) -> a -> a | 118 | optMeta :: (Sidecar -> Maybe a) -> a -> a |
122 | optMeta get fallback = fromMaybe fallback $ get sidecar | 119 | optMeta get fallback = fromMaybe fallback $ get sidecar |
123 | 120 | ||
124 | mkGalleryItem rootTitle parents InputDir{path, modTime, dirThumbnailPath, items} = | 121 | mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} = |
125 | do | 122 | do |
126 | processedThumbnail <- maybeThumbnail dirThumbnailPath | 123 | processedThumbnail <- maybeThumbnail dirThumbnailPath |
127 | processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items | 124 | processedItems <- parallel $ map (mkGalleryItem $ itemTitle:parentTitles) items |
128 | return GalleryItem | 125 | return GalleryItem |
129 | { title = itemTitle | 126 | { title = itemTitle |
130 | , datetime = fromMaybe (toZonedTime modTime) (mostRecentChildModTime processedItems) | 127 | , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems) |
131 | , description = "" | 128 | , description = "" |
132 | , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents | 129 | , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles) |
133 | , path = itemPath | 130 | , path = path |
134 | , thumbnail = processedThumbnail | 131 | , thumbnail = processedThumbnail |
135 | , properties = Directory processedItems } | 132 | , properties = Directory processedItems } |
136 | where | 133 | where |
137 | itemTitle :: String | 134 | itemTitle :: String |
138 | itemTitle = flip fromMaybe rootTitle (fromMaybe "" $ fileName path) | 135 | itemTitle = fromMaybe (head parentTitles) (fileName path) |
139 | |||
140 | itemPath :: Path | ||
141 | itemPath = parents </ itemTitle | ||
142 | 136 | ||
143 | maybeThumbnail :: Maybe Path -> IO (Maybe Path) | 137 | maybeThumbnail :: Maybe Path -> IO (Maybe Path) |
144 | maybeThumbnail Nothing = return Nothing | 138 | maybeThumbnail Nothing = return Nothing |
145 | maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath | 139 | maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath |
146 | 140 | ||
147 | mostRecentChildModTime :: [GalleryItem] -> Maybe ZonedTime | 141 | mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime |
148 | mostRecentChildModTime = | 142 | mostRecentModTime = |
149 | maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime)) | 143 | maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime)) |
150 | 144 | ||
151 | comparingTime :: ZonedTime -> ZonedTime -> Ordering | 145 | comparingTime :: ZonedTime -> ZonedTime -> Ordering |
152 | comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r) | 146 | comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r) |
153 | 147 | ||
154 | aggregateChildTags :: [GalleryItem] -> [Tag] | 148 | aggregateTags :: [GalleryItem] -> [Tag] |
155 | aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) | 149 | aggregateTags = concatMap (\item -> tags (item::GalleryItem)) |
156 | 150 | ||
157 | unique :: Ord a => [a] -> [a] | 151 | unique :: Ord a => [a] -> [a] |
158 | unique = Set.toList . Set.fromList | 152 | unique = Set.toList . Set.fromList |
159 | 153 | ||
160 | implicitParentTags :: Path -> [Tag] | 154 | implicitParentTags :: [String] -> [Tag] |
161 | implicitParentTags (Path elements) = take tagsFromDirectories elements | 155 | implicitParentTags = take tagsFromDirectories |
162 | 156 | ||
163 | toZonedTime :: UTCTime -> ZonedTime | 157 | toZonedTime :: UTCTime -> ZonedTime |
164 | toZonedTime = utcToZonedTime utc | 158 | toZonedTime = utcToZonedTime utc |