diff options
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r-- | compiler/src/Resource.hs | 40 |
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 | ||
19 | module Resource | 19 | module 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) | |||
30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) | 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.Text (pack) | ||
33 | import Data.Time.Clock (UTCTime) | 34 | import Data.Time.Clock (UTCTime) |
34 | import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) | 35 | import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) |
36 | import Data.Time.Format (formatTime, defaultTimeLocale) | ||
35 | import Safe.Foldable (maximumByMay) | 37 | import Safe.Foldable (maximumByMay) |
36 | 38 | ||
37 | import GHC.Generics (Generic) | 39 | import GHC.Generics (Generic) |
@@ -65,10 +67,22 @@ instance ToJSON Resolution where | |||
65 | toEncoding = genericToEncoding encodingOptions | 67 | toEncoding = genericToEncoding encodingOptions |
66 | 68 | ||
67 | 69 | ||
70 | data Resource = Resource | ||
71 | { resourcePath :: Path | ||
72 | , modTime :: UTCTime | ||
73 | } deriving (Generic, Show) | ||
74 | |||
75 | instance 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 | |||
68 | data GalleryItemProps = | 82 | data 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 | ||
74 | instance ToJSON GalleryItemProps where | 88 | instance 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 | ||
94 | type ItemProcessor = Path -> IO GalleryItemProps | 108 | type ItemProcessor = Path -> IO GalleryItemProps |
95 | type ThumbnailProcessor = Path -> IO (Maybe Path) | 109 | type ThumbnailProcessor = Path -> IO (Maybe Resource) |
96 | 110 | ||
97 | 111 | ||
98 | buildGalleryTree :: | 112 | buildGalleryTree :: |
@@ -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 | ||
192 | galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () | 206 | galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () |