aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Processors.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Processors.hs')
-rw-r--r--compiler/src/Processors.hs84
1 files changed, 37 insertions, 47 deletions
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
19module Processors 19module 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
28import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO) 27import Control.Exception (Exception, throwIO)
29import Data.Function ((&)) 28import Data.Function ((&))
30import Data.Ratio ((%)) 29import Data.Ratio ((%))
31import Data.Char (toLower) 30import Data.Char (toLower)
@@ -38,7 +37,7 @@ import Codec.Picture
38import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) 37import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
39 38
40import Resource 39import Resource
41 ( DirProcessor, ItemProcessor, ThumbnailProcessor 40 ( ItemProcessor, ThumbnailProcessor
42 , GalleryItemProps(..), Resolution(..) ) 41 , GalleryItemProps(..), Resolution(..) )
43 42
44import Files 43import Files
@@ -47,22 +46,27 @@ import Files
47data ProcessingException = ProcessingException FilePath String deriving Show 46data ProcessingException = ProcessingException FilePath String deriving Show
48instance Exception ProcessingException 47instance Exception ProcessingException
49 48
50data Format = 49
51 Bmp | Jpg | Png | Tiff | Hdr -- static images 50data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif
52 | Gif -- TODO: might be animated 51
53 | Unknown 52-- TODO: handle video, music, text...
53data Format = PictureFormat PictureFileFormat | Unknown
54 54
55formatFromPath :: Path -> Format 55formatFromPath :: Path -> Format
56formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName 56formatFromPath =
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
79resizeStaticImageUpTo :: Format -> Resolution -> FileProcessor 83resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor
80resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage 84resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
81-- TODO: parameterise export quality for jpg 85-- TODO: parameterise export quality for jpg
82resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80) 86resizeStaticImageUpTo 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
92resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format"
93 96
94 97
95type StaticImageReader = FilePath -> IO (Either String DynamicImage) 98type 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
146type DirFileProcessor =
147 FileName -- ^ Input base path
148 -> FileName -- ^ Output base path
149 -> FileName -- ^ Output class (subdir)
150 -> DirProcessor
151
152dirFileProcessor :: DirFileProcessor
153dirFileProcessor _ _ = (.) return . (/>)
154
155
156type ItemFileProcessor = 149type 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 =
162itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor 155itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
163itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = 156itemFileProcessor 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
183type ThumbnailFileProcessor = 176type ThumbnailFileProcessor =
@@ -188,7 +181,7 @@ type ThumbnailFileProcessor =
188 181
189thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor 182thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
190thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = 183thumbnailFileProcessor 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 200 processorFor _ =
208 processor Tiff = Just $ resizeStaticImageUpTo Tiff maxRes 201 Nothing
209 processor Hdr = Just $ resizeStaticImageUpTo Hdr maxRes
210 processor Gif = Just $ resizeStaticImageUpTo Gif maxRes -- static thumbnail from first frame
211 processor _ = Nothing