diff options
-rw-r--r-- | compiler/src/Compiler.hs | 5 | ||||
-rw-r--r-- | compiler/src/Files.hs | 2 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 84 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 80 | ||||
-rw-r--r-- | design-notes.md | 6 |
5 files changed, 93 insertions, 84 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index b9f52e5..d0ec003 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -43,7 +43,7 @@ import Files | |||
43 | , ensureParentDir | 43 | , ensureParentDir |
44 | , isOutdated ) | 44 | , isOutdated ) |
45 | import Processors | 45 | import Processors |
46 | ( dirFileProcessor, itemFileProcessor, thumbnailFileProcessor | 46 | ( itemFileProcessor, thumbnailFileProcessor |
47 | , skipCached, withCached ) | 47 | , skipCached, withCached ) |
48 | 48 | ||
49 | 49 | ||
@@ -111,7 +111,7 @@ compileGallery inputDirPath outputDirPath rebuildAll = | |||
111 | 111 | ||
112 | let itemProc = itemProcessor (pictureMaxResolution config) cache | 112 | let itemProc = itemProcessor (pictureMaxResolution config) cache |
113 | let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache | 113 | let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache |
114 | let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc (implicitDirectoryTag config) | 114 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (implicitDirectoryTag config) |
115 | resources <- galleryBuilder (galleryName config) inputTree | 115 | resources <- galleryBuilder (galleryName config) inputTree |
116 | 116 | ||
117 | galleryCleanupResourceDir resources outputDirPath | 117 | galleryCleanupResourceDir resources outputDirPath |
@@ -123,7 +123,6 @@ compileGallery inputDirPath outputDirPath rebuildAll = | |||
123 | outputIndex = outputDirPath </> indexFile | 123 | outputIndex = outputDirPath </> indexFile |
124 | outputViewerConf = outputDirPath </> viewerConfFile | 124 | outputViewerConf = outputDirPath </> viewerConfFile |
125 | 125 | ||
126 | dirProcessor = dirFileProcessor inputDirPath outputDirPath itemsDir | ||
127 | itemProcessor maxRes cache = | 126 | itemProcessor maxRes cache = |
128 | itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir | 127 | itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir |
129 | thumbnailProcessor thumbRes cache = | 128 | thumbnailProcessor thumbRes cache = |
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 51e97e6..41fc5a8 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -17,7 +17,7 @@ | |||
17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
18 | 18 | ||
19 | module Files | 19 | module Files |
20 | ( FileName, LocalPath, WebPath, Path | 20 | ( FileName, LocalPath, WebPath, Path(..) |
21 | , (</>), (</), (/>), (<.>) | 21 | , (</>), (</), (/>), (<.>) |
22 | , fileName, subPaths, pathLength | 22 | , fileName, subPaths, pathLength |
23 | , localPath, webPath | 23 | , localPath, webPath |
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index e10dc21..159a425 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -18,14 +18,13 @@ | |||
18 | 18 | ||
19 | module Processors | 19 | module Processors |
20 | ( Resolution(..) | 20 | ( Resolution(..) |
21 | , DirFileProcessor, dirFileProcessor | ||
22 | , ItemFileProcessor, itemFileProcessor | 21 | , ItemFileProcessor, itemFileProcessor |
23 | , ThumbnailFileProcessor, thumbnailFileProcessor | 22 | , ThumbnailFileProcessor, thumbnailFileProcessor |
24 | , skipCached, withCached | 23 | , skipCached, withCached |
25 | ) where | 24 | ) where |
26 | 25 | ||
27 | 26 | ||
28 | import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO) | 27 | import Control.Exception (Exception, throwIO) |
29 | import Data.Function ((&)) | 28 | import Data.Function ((&)) |
30 | import Data.Ratio ((%)) | 29 | import Data.Ratio ((%)) |
31 | import Data.Char (toLower) | 30 | import Data.Char (toLower) |
@@ -38,7 +37,7 @@ import Codec.Picture | |||
38 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) | 37 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) |
39 | 38 | ||
40 | import Resource | 39 | import Resource |
41 | ( DirProcessor, ItemProcessor, ThumbnailProcessor | 40 | ( ItemProcessor, ThumbnailProcessor |
42 | , GalleryItemProps(..), Resolution(..) ) | 41 | , GalleryItemProps(..), Resolution(..) ) |
43 | 42 | ||
44 | import Files | 43 | import Files |
@@ -47,22 +46,27 @@ import Files | |||
47 | data ProcessingException = ProcessingException FilePath String deriving Show | 46 | data ProcessingException = ProcessingException FilePath String deriving Show |
48 | instance Exception ProcessingException | 47 | instance Exception ProcessingException |
49 | 48 | ||
50 | data Format = | 49 | |
51 | Bmp | Jpg | Png | Tiff | Hdr -- static images | 50 | data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif |
52 | | Gif -- TODO: might be animated | 51 | |
53 | | Unknown | 52 | -- TODO: handle video, music, text... |
53 | data Format = PictureFormat PictureFileFormat | Unknown | ||
54 | 54 | ||
55 | formatFromPath :: Path -> Format | 55 | formatFromPath :: Path -> Format |
56 | formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName | 56 | formatFromPath = |
57 | maybe Unknown fromExt | ||
58 | . fmap (map toLower) | ||
59 | . fmap takeExtension | ||
60 | . fileName | ||
57 | where | 61 | where |
58 | fromExt :: String -> Format | 62 | fromExt :: String -> Format |
59 | fromExt ".bmp" = Bmp | 63 | fromExt ".bmp" = PictureFormat Bmp |
60 | fromExt ".jpg" = Jpg | 64 | fromExt ".jpg" = PictureFormat Jpg |
61 | fromExt ".jpeg" = Jpg | 65 | fromExt ".jpeg" = PictureFormat Jpg |
62 | fromExt ".png" = Png | 66 | fromExt ".png" = PictureFormat Png |
63 | fromExt ".tiff" = Tiff | 67 | fromExt ".tiff" = PictureFormat Tiff |
64 | fromExt ".hdr" = Hdr | 68 | fromExt ".hdr" = PictureFormat Hdr |
65 | fromExt ".gif" = Gif | 69 | fromExt ".gif" = PictureFormat Gif |
66 | fromExt _ = Unknown | 70 | fromExt _ = Unknown |
67 | 71 | ||
68 | 72 | ||
@@ -76,7 +80,7 @@ copyFileProcessor inputPath outputPath = | |||
76 | (putStrLn $ "Copying:\t" ++ outputPath) | 80 | (putStrLn $ "Copying:\t" ++ outputPath) |
77 | >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath | 81 | >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath |
78 | 82 | ||
79 | resizeStaticImageUpTo :: Format -> Resolution -> FileProcessor | 83 | resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor |
80 | resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage | 84 | resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage |
81 | -- TODO: parameterise export quality for jpg | 85 | -- TODO: parameterise export quality for jpg |
82 | resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80) | 86 | resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80) |
@@ -89,7 +93,6 @@ resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage' | |||
89 | saveGifImage' outputPath image = | 93 | saveGifImage' outputPath image = |
90 | saveGifImage outputPath image | 94 | saveGifImage outputPath image |
91 | & either (throwIO . ProcessingException outputPath) id | 95 | & either (throwIO . ProcessingException outputPath) id |
92 | resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format" | ||
93 | 96 | ||
94 | 97 | ||
95 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) | 98 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) |
@@ -143,16 +146,6 @@ withCached processor inputPath outputPath = | |||
143 | skip = putStrLn $ "Skipping:\t" ++ outputPath | 146 | skip = putStrLn $ "Skipping:\t" ++ outputPath |
144 | 147 | ||
145 | 148 | ||
146 | type DirFileProcessor = | ||
147 | FileName -- ^ Input base path | ||
148 | -> FileName -- ^ Output base path | ||
149 | -> FileName -- ^ Output class (subdir) | ||
150 | -> DirProcessor | ||
151 | |||
152 | dirFileProcessor :: DirFileProcessor | ||
153 | dirFileProcessor _ _ = (.) return . (/>) | ||
154 | |||
155 | |||
156 | type ItemFileProcessor = | 149 | type ItemFileProcessor = |
157 | FileName -- ^ Input base path | 150 | FileName -- ^ Input base path |
158 | -> FileName -- ^ Output base path | 151 | -> FileName -- ^ Output base path |
@@ -162,22 +155,22 @@ type ItemFileProcessor = | |||
162 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor | 155 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
163 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = | 156 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = |
164 | cached processor inPath outPath | 157 | cached processor inPath outPath |
165 | >> return (relOutPath, props) | 158 | >> return (props relOutPath) |
166 | where | 159 | where |
167 | relOutPath = resClass /> inputRes | 160 | relOutPath = resClass /> inputRes |
168 | inPath = localPath $ inputBase /> inputRes | 161 | inPath = localPath $ inputBase /> inputRes |
169 | outPath = localPath $ outputBase /> relOutPath | 162 | outPath = localPath $ outputBase /> relOutPath |
170 | (processor, props) = formatProcessor maxResolution $ formatFromPath inputRes | 163 | (processor, props) = processorFor maxResolution $ formatFromPath inputRes |
171 | 164 | ||
172 | formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps) | 165 | processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps) |
173 | formatProcessor Nothing _ = (copyFileProcessor, Other) | 166 | processorFor Nothing _ = |
174 | formatProcessor (Just maxRes) Bmp = (resizeStaticImageUpTo Bmp maxRes, Picture) | 167 | (copyFileProcessor, Other) |
175 | formatProcessor (Just maxRes) Jpg = (resizeStaticImageUpTo Jpg maxRes, Picture) | 168 | processorFor _ (PictureFormat Gif) = |
176 | formatProcessor (Just maxRes) Png = (resizeStaticImageUpTo Png maxRes, Picture) | 169 | (copyFileProcessor, Picture) -- TODO: handle animated gif resizing |
177 | formatProcessor (Just maxRes) Tiff = (resizeStaticImageUpTo Tiff maxRes, Picture) | 170 | processorFor (Just maxRes) (PictureFormat picFormat) = |
178 | formatProcessor (Just maxRes) Hdr = (resizeStaticImageUpTo Hdr maxRes, Picture) | 171 | (resizeStaticImageUpTo picFormat maxRes, Picture) |
179 | formatProcessor _ Gif = (copyFileProcessor, Other) -- TODO: handle animated gif resizing | 172 | processorFor _ Unknown = |
180 | formatProcessor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? | 173 | (copyFileProcessor, Other) -- TODO: handle video reencoding and others? |
181 | 174 | ||
182 | 175 | ||
183 | type ThumbnailFileProcessor = | 176 | type ThumbnailFileProcessor = |
@@ -188,7 +181,7 @@ type ThumbnailFileProcessor = | |||
188 | 181 | ||
189 | thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor | 182 | thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor |
190 | thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = | 183 | thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = |
191 | cached <$> processor (formatFromPath inputRes) | 184 | cached <$> processorFor (formatFromPath inputRes) |
192 | & process | 185 | & process |
193 | where | 186 | where |
194 | relOutPath = resClass /> inputRes | 187 | relOutPath = resClass /> inputRes |
@@ -201,11 +194,8 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = | |||
201 | proc inPath outPath | 194 | proc inPath outPath |
202 | >> return (Just relOutPath) | 195 | >> return (Just relOutPath) |
203 | 196 | ||
204 | processor :: Format -> Maybe FileProcessor | 197 | processorFor :: Format -> Maybe FileProcessor |
205 | processor Bmp = Just $ resizeStaticImageUpTo Bmp maxRes | 198 | processorFor (PictureFormat picFormat) = |
206 | processor Jpg = Just $ resizeStaticImageUpTo Jpg maxRes | 199 | Just $ resizeStaticImageUpTo picFormat maxRes |
207 | processor Png = Just $ resizeStaticImageUpTo Png maxRes |