diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/src/Resource.hs | 44 |
1 files changed, 23 insertions, 21 deletions
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index e8ca889..56f7a3f 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs | |||
@@ -27,7 +27,7 @@ import Control.Concurrent.ParallelIO.Global (parallel) | |||
27 | import Data.List ((\\), sortBy) | 27 | import Data.List ((\\), sortBy) |
28 | import Data.Ord (comparing) | 28 | import Data.Ord (comparing) |
29 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
30 | import Data.Maybe (mapMaybe, fromMaybe) | 30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) |
31 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
32 | import qualified Data.Set as Set | 32 | import qualified Data.Set as Set |
33 | import Data.Time.Clock (UTCTime) | 33 | import Data.Time.Clock (UTCTime) |
@@ -99,7 +99,7 @@ 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 [galleryName] inputTree | 102 | mkGalleryItem [] inputTree |
103 | where | 103 | where |
104 | mkGalleryItem :: [String] -> InputTree -> IO GalleryItem | 104 | mkGalleryItem :: [String] -> InputTree -> IO GalleryItem |
105 | mkGalleryItem parentTitles InputFile{path, modTime, sidecar} = | 105 | mkGalleryItem parentTitles InputFile{path, modTime, sidecar} = |
@@ -107,46 +107,48 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in | |||
107 | properties <- processItem path | 107 | properties <- processItem path |
108 | processedThumbnail <- processThumbnail path | 108 | processedThumbnail <- processThumbnail path |
109 | return GalleryItem | 109 | return GalleryItem |
110 | { title = optMeta title $ fromMaybe "" $ fileName path | 110 | { title = fromMeta 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 = fromMeta description "" |
113 | , tags = unique ((optMeta tags []) ++ implicitParentTags parentTitles) | 113 | , tags = unique ((fromMeta tags []) ++ implicitParentTags parentTitles) |
114 | , path = "/" /> path | 114 | , path = "/" /> path |
115 | , thumbnail = processedThumbnail | 115 | , thumbnail = processedThumbnail |
116 | , properties = properties } | 116 | , properties = properties } |
117 | |||
117 | where | 118 | where |
118 | optMeta :: (Sidecar -> Maybe a) -> a -> a | 119 | fromMeta :: (Sidecar -> Maybe a) -> a -> a |
119 | optMeta get fallback = fromMaybe fallback $ get sidecar | 120 | fromMeta get fallback = fromMaybe fallback $ get sidecar |
120 | 121 | ||
121 | mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} = | 122 | mkGalleryItem parentTitles InputDir{path, modTime, dirThumbnailPath, items} = |
122 | do | 123 | do |
123 | processedThumbnail <- maybeThumbnail dirThumbnailPath | 124 | processedThumbnail <- maybeThumbnail dirThumbnailPath |
124 | processedItems <- parallel $ map (mkGalleryItem $ itemTitle:parentTitles) items | 125 | processedItems <- parallel $ map (mkGalleryItem subItemsParents) items |
125 | return GalleryItem | 126 | return GalleryItem |
126 | { title = itemTitle | 127 | { title = fromMaybe galleryName (fileName path) |
127 | , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems) | 128 | , datetime = fromMaybe (toZonedTime modTime) (mostRecentModTime processedItems) |
128 | , description = "" | 129 | , description = "" |
129 | , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles) | 130 | , tags = unique (aggregateTags processedItems ++ implicitParentTags parentTitles) |
130 | , path = "/" /> path | 131 | , path = "/" /> path |
131 | , thumbnail = processedThumbnail | 132 | , thumbnail = processedThumbnail |
132 | , properties = Directory processedItems } | 133 | , properties = Directory processedItems } |
134 | |||
133 | where | 135 | where |
134 | itemTitle :: String | 136 | subItemsParents :: [String] |
135 | itemTitle = fromMaybe (head parentTitles) (fileName path) | 137 | subItemsParents = (maybeToList $ fileName path) ++ parentTitles |
136 | 138 | ||
137 | maybeThumbnail :: Maybe Path -> IO (Maybe Path) | 139 | maybeThumbnail :: Maybe Path -> IO (Maybe Path) |
138 | maybeThumbnail Nothing = return Nothing | 140 | maybeThumbnail Nothing = return Nothing |
139 | maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath | 141 | maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath |
140 | 142 | ||
141 | mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime | 143 | mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime |
142 | mostRecentModTime = | 144 | mostRecentModTime = |
143 | maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime)) | 145 | maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime)) |
144 | 146 | ||
145 | comparingTime :: ZonedTime -> ZonedTime -> Ordering | 147 | comparingTime :: ZonedTime -> ZonedTime -> Ordering |
146 | comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r) | 148 | comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r) |
147 | 149 | ||
148 | aggregateTags :: [GalleryItem] -> [Tag] | 150 | aggregateTags :: [GalleryItem] -> [Tag] |
149 | aggregateTags = concatMap (\item -> tags (item::GalleryItem)) | 151 | aggregateTags = concatMap (\item -> tags (item::GalleryItem)) |
150 | 152 | ||
151 | unique :: Ord a => [a] -> [a] | 153 | unique :: Ord a => [a] -> [a] |
152 | unique = Set.toList . Set.fromList | 154 | unique = Set.toList . Set.fromList |