aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs32
1 files changed, 26 insertions, 6 deletions
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 261191b..207239f 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -30,6 +30,10 @@ import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe) 30import Data.Maybe (mapMaybe, fromMaybe)
31import Data.Function ((&)) 31import Data.Function ((&))
32import qualified Data.Set as Set 32import qualified Data.Set as Set
33import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
34import Data.Time.Format.ISO8601 (iso8601ParseM)
35import System.Directory (getModificationTime)
36import Safe.Foldable (maximumByMay)
33 37
34import GHC.Generics (Generic) 38import GHC.Generics (Generic)
35import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding) 39import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding)
@@ -75,7 +79,7 @@ instance ToJSON GalleryItemProps where
75 79
76data GalleryItem = GalleryItem 80data GalleryItem = GalleryItem
77 { title :: String 81 { title :: String
78 , date :: String -- TODO: checked ISO8601 date 82 , date :: ZonedTime
79 , description :: String 83 , description :: String
80 , tags :: [Tag] 84 , tags :: [Tag]
81 , path :: Path 85 , path :: Path
@@ -103,18 +107,22 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
103 do 107 do
104 properties <- processItem path 108 properties <- processItem path
105 processedThumbnail <- processThumbnail path 109 processedThumbnail <- processThumbnail path
110 fileModTime <- lastModTime path
106 return GalleryItem 111 return GalleryItem
107 { title = itemTitle 112 { title = itemTitle
108 , date = optMeta date "" -- TODO: check and normalise dates 113 , date = fromMaybe fileModTime itemDate
109 , description = optMeta description "" 114 , description = optMeta description ""
110 , tags = (optMeta tags []) ++ implicitParentTags parents 115 , tags = (optMeta tags []) ++ implicitParentTags parents
111 , path = parents </ itemTitle 116 , path = parents </ itemTitle
112 , thumbnail = processedThumbnail 117 , thumbnail = processedThumbnail
113 , properties = properties } -- TODO 118 , properties = properties }
114 where 119 where
115 itemTitle :: String 120 itemTitle :: String
116 itemTitle = optMeta title $ fromMaybe "" $ fileName path 121 itemTitle = optMeta title $ fromMaybe "" $ fileName path
117 122
123 itemDate :: Maybe ZonedTime
124 itemDate = Input.date sidecar >>= iso8601ParseM
125
118 optMeta :: (Sidecar -> Maybe a) -> a -> a 126 optMeta :: (Sidecar -> Maybe a) -> a -> a
119 optMeta get fallback = fromMaybe fallback $ get sidecar 127 optMeta get fallback = fromMaybe fallback $ get sidecar
120 128
@@ -122,11 +130,10 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
122 do 130 do
123 processedThumbnail <- maybeThumbnail dirThumbnailPath 131 processedThumbnail <- maybeThumbnail dirThumbnailPath
124 processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items 132 processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
133 dirModTime <- lastModTime path
125 return GalleryItem 134 return GalleryItem
126 { title = itemTitle 135 { title = itemTitle
127 -- TODO: consider using the most recent item's date? what if empty? 136 , date = fromMaybe dirModTime $ mostRecentChildModTime processedItems
128 , date = ""
129 -- TODO: consider allowing metadata sidecars for directories too
130 , description = "" 137 , description = ""
131 , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents 138 , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
132 , path = itemPath 139 , path = itemPath
@@ -143,6 +150,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
143 maybeThumbnail Nothing = return Nothing 150 maybeThumbnail Nothing = return Nothing
144 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath 151 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
145 152
153 mostRecentChildModTime :: [GalleryItem] -> Maybe ZonedTime
154 mostRecentChildModTime =
155 maximumByMay comparingDates . map (date::(GalleryItem -> ZonedTime))
156
157 comparingDates :: ZonedTime -> ZonedTime -> Ordering
158 comparingDates l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
159
146 aggregateChildTags :: [GalleryItem] -> [Tag] 160 aggregateChildTags :: [GalleryItem] -> [Tag]
147 aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) 161 aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
148 162
@@ -152,6 +166,12 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
152 implicitParentTags :: Path -> [Tag] 166 implicitParentTags :: Path -> [Tag]
153 implicitParentTags (Path elements) = take tagsFromDirectories elements 167 implicitParentTags (Path elements) = take tagsFromDirectories elements
154 168
169 lastModTime :: Path -> IO ZonedTime
170 lastModTime path =
171 localPath path
172 & getModificationTime
173 >>= return . utcToZonedTime utc
174
155 175
156flattenGalleryTree :: GalleryItem -> [GalleryItem] 176flattenGalleryTree :: GalleryItem -> [GalleryItem]
157flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = 177flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) =