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.hs40
1 files changed, 27 insertions, 13 deletions
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 56f7a3f..c0ef317 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
18 18
19module Resource 19module Resource
20 ( ItemProcessor, ThumbnailProcessor 20 ( ItemProcessor, ThumbnailProcessor
21 , GalleryItem(..), GalleryItemProps(..), Resolution(..) 21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..)
22 , buildGalleryTree, galleryCleanupResourceDir 22 , buildGalleryTree, galleryCleanupResourceDir
23 ) where 23 ) where
24 24
@@ -30,8 +30,10 @@ import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe, maybeToList) 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.Text (pack)
33import Data.Time.Clock (UTCTime) 34import Data.Time.Clock (UTCTime)
34import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) 35import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
36import Data.Time.Format (formatTime, defaultTimeLocale)
35import Safe.Foldable (maximumByMay) 37import Safe.Foldable (maximumByMay)
36 38
37import GHC.Generics (Generic) 39import GHC.Generics (Generic)
@@ -65,10 +67,22 @@ instance ToJSON Resolution where
65 toEncoding = genericToEncoding encodingOptions 67 toEncoding = genericToEncoding encodingOptions
66 68
67 69
70data Resource = Resource
71 { resourcePath :: Path
72 , modTime :: UTCTime
73 } deriving (Generic, Show)
74
75instance ToJSON Resource where
76 toJSON Resource{resourcePath, modTime} =
77 JSON.String $ pack (webPath resourcePath ++ "?" ++ timestamp)
78 where
79 timestamp = formatTime defaultTimeLocale "%s" modTime
80
81
68data GalleryItemProps = 82data GalleryItemProps =
69 Directory { items :: [GalleryItem] } 83 Directory { items :: [GalleryItem] }
70 | Picture { resource :: Path } 84 | Picture { resource :: Resource }
71 | Other { resource :: Path } 85 | Other { resource :: Resource }
72 deriving (Generic, Show) 86 deriving (Generic, Show)
73 87
74instance ToJSON GalleryItemProps where 88instance ToJSON GalleryItemProps where
@@ -82,7 +96,7 @@ data GalleryItem = GalleryItem
82 , description :: String 96 , description :: String
83 , tags :: [Tag] 97 , tags :: [Tag]
84 , path :: Path 98 , path :: Path
85 , thumbnail :: Maybe Path 99 , thumbnail :: Maybe Resource
86 , properties :: GalleryItemProps 100 , properties :: GalleryItemProps
87 } deriving (Generic, Show) 101 } deriving (Generic, Show)
88 102
@@ -92,7 +106,7 @@ instance ToJSON GalleryItem where
92 106
93 107
94type ItemProcessor = Path -> IO GalleryItemProps 108type ItemProcessor = Path -> IO GalleryItemProps
95type ThumbnailProcessor = Path -> IO (Maybe Path) 109type ThumbnailProcessor = Path -> IO (Maybe Resource)
96 110
97 111
98buildGalleryTree :: 112buildGalleryTree ::
@@ -136,7 +150,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
136 subItemsParents :: [String] 150 subItemsParents :: [String]
137 subItemsParents = (maybeToList $ fileName path) ++ parentTitles 151 subItemsParents = (maybeToList $ fileName path) ++ parentTitles
138 152
139 maybeThumbnail :: Maybe Path -> IO (Maybe Path) 153 maybeThumbnail :: Maybe Path -> IO (Maybe Resource)
140 maybeThumbnail Nothing = return Nothing 154 maybeThumbnail Nothing = return Nothing
141 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath 155 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
142 156
@@ -175,18 +189,18 @@ galleryOutputDiff resources ref =
175 189
176 compiledPaths :: [GalleryItem] -> [Path] 190 compiledPaths :: [GalleryItem] -> [Path]
177 compiledPaths items = 191 compiledPaths items =
178 resourcePaths items ++ thumbnailPaths items 192 resPaths items ++ thumbnailPaths items
179 & concatMap subPaths 193 & concatMap subPaths
180 194
181 resourcePaths :: [GalleryItem] -> [Path] 195 resPaths :: [GalleryItem] -> [Path]
182 resourcePaths = mapMaybe (resourcePath . properties) 196 resPaths = mapMaybe (resPath . properties)
183 197
184 resourcePath :: GalleryItemProps -> Maybe Path 198 resPath :: GalleryItemProps -> Maybe Path
185 resourcePath Directory{} = Nothing 199 resPath Directory{} = Nothing
186 resourcePath resourceProps = Just $ resource resourceProps 200 resPath resourceProps = Just (resourcePath $ resource resourceProps)
187 201
188 thumbnailPaths :: [GalleryItem] -> [Path] 202 thumbnailPaths :: [GalleryItem] -> [Path]
189 thumbnailPaths = mapMaybe thumbnail 203 thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail)
190 204
191 205
192galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () 206galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()