compiler: add jpeg export quality setting

GitHub: closes #2

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 =
   (putStrLn $ "Copying:\t" ++ outputPath)
   >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
 
-resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor
-resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
--- TODO: parameterise export quality for jpg
-resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
-resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
-resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
-resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
-resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage'
-  where
-    saveGifImage' :: StaticImageWriter
-    saveGifImage' outputPath image =
-      saveGifImage outputPath image
-      & either (throwIO . ProcessingException outputPath) id
-
 
+type LossyExportQuality = Int
 type StaticImageReader = FilePath -> IO (Either String DynamicImage)
 type StaticImageWriter = FilePath -> DynamicImage -> IO ()
 
-resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor
-resizeStaticGeneric reader writer maxRes inputPath outputPath =
-  (putStrLn $ "Generating:\t" ++ outputPath)
-  >>  reader inputPath
-  >>= either (throwIO . ProcessingException inputPath) return
-  >>= return . (fitDynamicImage maxRes)
-  >>= ensureParentDir writer outputPath
-
-fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
-fitDynamicImage (Resolution boxWidth boxHeight) image =
-  convertRGBA8 image
-  & scaleBilinear targetWidth targetHeight
-  & ImageRGBA8
+resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
+resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
+  resizerFor pictureFormat
   where
-    picWidth = dynamicMap imageWidth image
-    picHeight = dynamicMap imageHeight image
-    resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
-    targetWidth = floor $ resizeRatio * (picWidth % 1)
-    targetHeight = floor $ resizeRatio * (picHeight % 1)
+    resizerFor :: PictureFileFormat -> FileProcessor
+    resizerFor Bmp = resizer readBitmap saveBmpImage
+    resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality)
+    resizerFor Png = resizer readPng savePngImage
+    resizerFor Tiff = resizer readTiff saveTiffImage
+    resizerFor Hdr = resizer readHDR saveRadianceImage
+    resizerFor Gif = resizer readGif saveGifImage'
+      where
+        saveGifImage' :: StaticImageWriter
+        saveGifImage' outputPath image =
+          saveGifImage outputPath image
+          & either (throwIO . ProcessingException outputPath) id
+
+    resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
+    resizer reader writer inputPath outputPath =
+      (putStrLn $ "Generating:\t" ++ outputPath)
+      >>  reader inputPath
+      >>= either (throwIO . ProcessingException inputPath) return
+      >>= return . (fitDynamicImage maxResolution)
+      >>= ensureParentDir writer outputPath
+
+    fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
+    fitDynamicImage (Resolution boxWidth boxHeight) image =
+      convertRGBA8 image
+      & scaleBilinear targetWidth targetHeight
+      & ImageRGBA8
+      where
+        picWidth = dynamicMap imageWidth image
+        picHeight = dynamicMap imageHeight image
+        resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
+        targetWidth = floor $ resizeRatio * (picWidth % 1)
+        targetHeight = floor $ resizeRatio * (picHeight % 1)
 
 
 type Cache = FileProcessor -> FileProcessor
@@ -152,8 +156,8 @@ type ItemFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ItemProcessor
 
-itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
-itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
+itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
+itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
   >> return (props relOutPath)
   where
@@ -168,7 +172,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     processorFor _ (PictureFormat Gif) =
       (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
     processorFor (Just maxRes) (PictureFormat picFormat) =
-      (resizeStaticImageUpTo picFormat maxRes, Picture)
+      (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
     processorFor _ Unknown =
       (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
@@ -179,8 +183,8 @@ type ThumbnailFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ThumbnailProcessor
 
-thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
-thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
+thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor
+thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached <$> processorFor (formatFromPath inputRes)
   & process
   where
@@ -196,6 +200,6 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
 
     processorFor :: Format -> Maybe FileProcessor
     processorFor (PictureFormat picFormat) =
-      Just $ resizeStaticImageUpTo picFormat maxRes
+      Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat
     processorFor _ =
       Nothing