aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/src/Resource.hs44
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)
27import Data.List ((\\), sortBy) 27import Data.List ((\\), sortBy)
28import Data.Ord (comparing) 28import Data.Ord (comparing)
29import Data.Char (toLower) 29import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe) 30import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
31import Data.Function ((&)) 31import Data.Function ((&))
32import qualified Data.Set as Set 32import qualified Data.Set as Set
33import Data.Time.Clock (UTCTime) 33import 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
101buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree = 101buildGalleryTree 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