diff options
-rw-r--r-- | compiler/src/Processors.hs | 16 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 40 |
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 | ||
39 | import Resource | 39 | import Resource |
40 | ( ItemProcessor, ThumbnailProcessor | 40 | ( ItemProcessor, ThumbnailProcessor |
41 | , GalleryItemProps(..), Resolution(..) ) | 41 | , GalleryItemProps(..), Resolution(..), Resource(..) ) |
42 | 42 | ||
43 | import Files | 43 | import 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 | ||
153 | resourceAt :: FilePath -> Path -> IO Resource | ||
154 | resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath | ||
155 | |||
156 | |||
153 | type ItemFileProcessor = | 157 | type 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 = | |||
159 | itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor | 163 | itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor |
160 | itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = | 164 | itemFileProcessor 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 | ||
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 () |