aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Processors.hs
diff options
context:
space:
mode:
authorpacien2020-01-23 23:16:07 +0100
committerNotkea2020-01-26 22:06:24 +0100
commitcf91102432b1196b8f3c1fa388b3963948ad49a6 (patch)
treeeb7bfdcaca87f6233f15887cadcf92586fdec7fc /compiler/src/Processors.hs
parent987eb81cb5d98262299c7917d752c54907cbbc33 (diff)
downloadldgallery-cf91102432b1196b8f3c1fa388b3963948ad49a6.tar.gz
compiler: add jpeg export quality setting
GitHub: closes #2
Diffstat (limited to 'compiler/src/Processors.hs')
-rw-r--r--compiler/src/Processors.hs80
1 files changed, 42 insertions, 38 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 159a425..1c4a791 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -80,43 +80,47 @@ copyFileProcessor inputPath outputPath =
80 (putStrLn $ "Copying:\t" ++ outputPath) 80 (putStrLn $ "Copying:\t" ++ outputPath)
81 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath 81 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
82 82
83resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor
84resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
85-- TODO: parameterise export quality for jpg
86resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
87resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
88resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
89resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
90resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage'
91 where
92 saveGifImage' :: StaticImageWriter
93 saveGifImage' outputPath image =
94 saveGifImage outputPath image
95 & either (throwIO . ProcessingException outputPath) id
96
97 83
84type LossyExportQuality = Int
98type StaticImageReader = FilePath -> IO (Either String DynamicImage) 85type StaticImageReader = FilePath -> IO (Either String DynamicImage)
99type StaticImageWriter = FilePath -> DynamicImage -> IO () 86type StaticImageWriter = FilePath -> DynamicImage -> IO ()
100 87
101resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor 88resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
102resizeStaticGeneric reader writer maxRes inputPath outputPath = 89resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
103 (putStrLn $ "Generating:\t" ++ outputPath) 90 resizerFor pictureFormat
104 >> reader inputPath
105 >>= either (throwIO . ProcessingException inputPath) return
106 >>= return . (fitDynamicImage maxRes)
107 >>= ensureParentDir writer outputPath
108
109fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
110fitDynamicImage (Resolution boxWidth boxHeight) image =
111 convertRGBA8 image
112 & scaleBilinear targetWidth targetHeight
113 & ImageRGBA8
114 where 91 where
115 picWidth = dynamicMap imageWidth image 92 resizerFor :: PictureFileFormat -> FileProcessor
116 picHeight = dynamicMap imageHeight image 93 resizerFor Bmp = resizer readBitmap saveBmpImage
117 resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight) 94 resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality)
118 targetWidth = floor $ resizeRatio * (picWidth % 1) 95 resizerFor Png = resizer readPng savePngImage
119 targetHeight = floor $ resizeRatio * (picHeight % 1) 96 resizerFor Tiff = resizer readTiff saveTiffImage
97 resizerFor Hdr = resizer readHDR saveRadianceImage
98 resizerFor Gif = resizer readGif saveGifImage'
99 where
100 saveGifImage' :: StaticImageWriter
101 saveGifImage' outputPath image =
102 saveGifImage outputPath image
103 & either (throwIO . ProcessingException outputPath) id
104
105 resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
106 resizer reader writer inputPath outputPath =
107 (putStrLn $ "Generating:\t" ++ outputPath)
108 >> reader inputPath
109 >>= either (throwIO . ProcessingException inputPath) return
110 >>= return . (fitDynamicImage maxResolution)
111 >>= ensureParentDir writer outputPath
112
113 fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
114 fitDynamicImage (Resolution boxWidth boxHeight) image =
115 convertRGBA8 image
116 & scaleBilinear targetWidth targetHeight
117 & ImageRGBA8
118 where
119 picWidth = dynamicMap imageWidth image
120 picHeight = dynamicMap imageHeight image
121 resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
122 targetWidth = floor $ resizeRatio * (picWidth % 1)
123 targetHeight = floor $ resizeRatio * (picHeight % 1)
120 124
121 125
122type Cache = FileProcessor -> FileProcessor 126type Cache = FileProcessor -> FileProcessor
@@ -152,8 +156,8 @@ type ItemFileProcessor =
152 -> FileName -- ^ Output class (subdir) 156 -> FileName -- ^ Output class (subdir)
153 -> ItemProcessor 157 -> ItemProcessor
154 158
155itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor 159itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
156itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = 160itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
157 cached processor inPath outPath 161 cached processor inPath outPath
158 >> return (props relOutPath) 162 >> return (props relOutPath)
159 where 163 where
@@ -168,7 +172,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
168 processorFor _ (PictureFormat Gif) = 172 processorFor _ (PictureFormat Gif) =
169 (copyFileProcessor, Picture) -- TODO: handle animated gif resizing 173 (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
170 processorFor (Just maxRes) (PictureFormat picFormat) = 174 processorFor (Just maxRes) (PictureFormat picFormat) =
171 (resizeStaticImageUpTo picFormat maxRes, Picture) 175 (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
172 processorFor _ Unknown = 176 processorFor _ Unknown =
173 (copyFileProcessor, Other) -- TODO: handle video reencoding and others? 177 (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
174 178
@@ -179,8 +183,8 @@ type ThumbnailFileProcessor =
179 -> FileName -- ^ Output class (subdir) 183 -> FileName -- ^ Output class (subdir)
180 -> ThumbnailProcessor 184 -> ThumbnailProcessor
181 185
182thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor 186thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor
183thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = 187thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes =
184 cached <$> processorFor (formatFromPath inputRes) 188 cached <$> processorFor (formatFromPath inputRes)
185 & process 189 & process
186 where 190 where
@@ -196,6 +200,6 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
196 200
197 processorFor :: Format -> Maybe FileProcessor 201 processorFor :: Format -> Maybe FileProcessor
198 processorFor (PictureFormat picFormat) = 202 processorFor (PictureFormat picFormat) =
199 Just $ resizeStaticImageUpTo picFormat maxRes 203 Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat
200 processorFor _ = 204 processorFor _ =
201 Nothing 205 Nothing