aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Processors.hs16
-rw-r--r--compiler/src/Resource.hs40
2 files changed, 38 insertions, 18 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 1c4a791..2abdec5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -38,7 +38,7 @@ import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but i
38 38
39import Resource 39import Resource
40 ( ItemProcessor, ThumbnailProcessor 40 ( ItemProcessor, ThumbnailProcessor
41 , GalleryItemProps(..), Resolution(..) ) 41 , GalleryItemProps(..), Resolution(..), Resource(..) )
42 42
43import Files 43import Files
44 44
@@ -150,6 +150,10 @@ withCached processor inputPath outputPath =
150 skip = putStrLn $ "Skipping:\t" ++ outputPath 150 skip = putStrLn $ "Skipping:\t" ++ outputPath
151 151
152 152
153resourceAt :: FilePath -> Path -> IO Resource
154resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
155
156
153type ItemFileProcessor = 157type ItemFileProcessor =
154 FileName -- ^ Input base path 158 FileName -- ^ Input base path
155 -> FileName -- ^ Output base path 159 -> FileName -- ^ Output base path
@@ -159,14 +163,15 @@ type ItemFileProcessor =
159itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor 163itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
160itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = 164itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
161 cached processor inPath outPath 165 cached processor inPath outPath
162 >> return (props relOutPath) 166 >> resourceAt outPath relOutPath
167 >>= return . props
163 where 168 where
164 relOutPath = resClass /> inputRes 169 relOutPath = resClass /> inputRes
165 inPath = localPath $ inputBase /> inputRes 170 inPath = localPath $ inputBase /> inputRes
166 outPath = localPath $ outputBase /> relOutPath 171 outPath = localPath $ outputBase /> relOutPath
167 (processor, props) = processorFor maxResolution $ formatFromPath inputRes 172 (processor, props) = processorFor maxResolution $ formatFromPath inputRes
168 173
169 processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps) 174 processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
170 processorFor Nothing _ = 175 processorFor Nothing _ =
171 (copyFileProcessor, Other) 176 (copyFileProcessor, Other)
172 processorFor _ (PictureFormat Gif) = 177 processorFor _ (PictureFormat Gif) =
@@ -192,11 +197,12 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
192 inPath = localPath $ inputBase /> inputRes 197 inPath = localPath $ inputBase /> inputRes
193 outPath = localPath $ outputBase /> relOutPath 198 outPath = localPath $ outputBase /> relOutPath
194 199
195 process :: Maybe FileProcessor -> IO (Maybe Path) 200 process :: Maybe FileProcessor -> IO (Maybe Resource)
196 process Nothing = return Nothing 201 process Nothing = return Nothing
197 process (Just proc) = 202 process (Just proc) =
198 proc inPath outPath 203 proc inPath outPath
199 >> return (Just relOutPath) 204 >> resourceAt outPath relOutPath
205 >>= return . Just
200 206
201 processorFor :: Format -> Maybe FileProcessor 207 processorFor :: Format -> Maybe FileProcessor
202 processorFor (PictureFormat picFormat) = 208 processorFor (PictureFormat picFormat) =
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 ()