diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Resource.hs | 32 |
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) | |||
30 | import Data.Maybe (mapMaybe, fromMaybe) | 30 | import Data.Maybe (mapMaybe, fromMaybe) |
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.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) | ||
34 | import Data.Time.Format.ISO8601 (iso8601ParseM) | ||
35 | import System.Directory (getModificationTime) | ||
36 | import Safe.Foldable (maximumByMay) | ||
33 | 37 | ||
34 | import GHC.Generics (Generic) | 38 | import GHC.Generics (Generic) |
35 | import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding) | 39 | import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding) |
@@ -75,7 +79,7 @@ instance ToJSON GalleryItemProps where | |||
75 | 79 | ||
76 | data GalleryItem = GalleryItem | 80 | data 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 | ||
156 | flattenGalleryTree :: GalleryItem -> [GalleryItem] | 176 | flattenGalleryTree :: GalleryItem -> [GalleryItem] |
157 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = | 177 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = |