aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Resource.hs46
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
101buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree = 101buildGalleryTree 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