From cf91102432b1196b8f3c1fa388b3963948ad49a6 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 23 Jan 2020 23:16:07 +0100
Subject: compiler: add jpeg export quality setting

GitHub: closes #2
---
 compiler/src/Compiler.hs   | 16 ++++++----
 compiler/src/Config.hs     |  2 ++
 compiler/src/Processors.hs | 80 ++++++++++++++++++++++++----------------------
 3 files changed, 54 insertions(+), 44 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 13e9232..aca96bc 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -114,8 +114,8 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     inputTree <- readInputTree sourceTree
 
     let cache = if rebuildAll then skipCached else withCached
-    let itemProc = itemProcessor (pictureMaxResolution config) cache
-    let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
+    let itemProc = itemProcessor config cache
+    let thumbnailProc = thumbnailProcessor config cache
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder (galleryName config) inputTree
 
@@ -128,7 +128,11 @@ compileGallery inputDirPath outputDirPath rebuildAll =
     outputIndex = outputDirPath </> indexFile
     outputViewerConf = outputDirPath </> viewerConfFile
 
-    itemProcessor maxRes cache =
-      itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
-    thumbnailProcessor thumbRes cache =
-      thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir
+    itemProcessor config cache =
+      itemFileProcessor
+        (pictureMaxResolution config) (jpegExportQuality config) cache
+        inputDirPath outputDirPath itemsDir
+    thumbnailProcessor config cache =
+      thumbnailFileProcessor
+        (thumbnailMaxResolution config) (jpegExportQuality config) cache
+        inputDirPath outputDirPath thumbnailsDir
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index d670aae..4446c14 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -41,6 +41,7 @@ data CompilerConfig = CompilerConfig
   , tagsFromDirectories :: Int
   , thumbnailMaxResolution :: Resolution
   , pictureMaxResolution :: Maybe Resolution
+  , jpegExportQuality :: Int
   } deriving (Generic, Show)
 
 instance FromJSON CompilerConfig where
@@ -53,6 +54,7 @@ instance FromJSON CompilerConfig where
     <*> v .:? "tagsFromDirectories" .!= 0
     <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
     <*> v .:? "pictureMaxResolution"
+    <*> v .:? "jpegExportQuality" .!= 80
 
 
 data GalleryConfig = GalleryConfig
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
-- 
cgit v1.2.3