aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Compiler.hs16
-rw-r--r--compiler/src/Config.hs2
-rw-r--r--compiler/src/Processors.hs80
3 files changed, 54 insertions, 44 deletions
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 =
114 inputTree <- readInputTree sourceTree 114 inputTree <- readInputTree sourceTree
115 115
116 let cache = if rebuildAll then skipCached else withCached 116 let cache = if rebuildAll then skipCached else withCached
117 let itemProc = itemProcessor (pictureMaxResolution config) cache 117 let itemProc = itemProcessor config cache
118 let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache 118 let thumbnailProc = thumbnailProcessor config cache
119 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) 119 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
120 resources <- galleryBuilder (galleryName config) inputTree 120 resources <- galleryBuilder (galleryName config) inputTree
121 121
@@ -128,7 +128,11 @@ compileGallery inputDirPath outputDirPath rebuildAll =
128 outputIndex = outputDirPath </> indexFile 128 outputIndex = outputDirPath </> indexFile
129 outputViewerConf = outputDirPath </> viewerConfFile 129 outputViewerConf = outputDirPath </> viewerConfFile
130 130
131 itemProcessor maxRes cache = 131 itemProcessor config cache =
132 itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir 132 itemFileProcessor
133 thumbnailProcessor thumbRes cache = 133 (pictureMaxResolution config) (jpegExportQuality config) cache
134 thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir 134 inputDirPath outputDirPath itemsDir
135 thumbnailProcessor config cache =
136 thumbnailFileProcessor
137 (thumbnailMaxResolution config) (jpegExportQuality config) cache
138 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
41 , tagsFromDirectories :: Int 41 , tagsFromDirectories :: Int
42 , thumbnailMaxResolution :: Resolution 42 , thumbnailMaxResolution :: Resolution
43 , pictureMaxResolution :: Maybe Resolution 43 , pictureMaxResolution :: Maybe Resolution
44 , jpegExportQuality :: Int
44 } deriving (Generic, Show) 45 } deriving (Generic, Show)
45 46
46instance FromJSON CompilerConfig where 47instance FromJSON CompilerConfig where
@@ -53,6 +54,7 @@ instance FromJSON CompilerConfig where
53 <*> v .:? "tagsFromDirectories" .!= 0 54 <*> v .:? "tagsFromDirectories" .!= 0
54 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400) 55 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
55 <*> v .:? "pictureMaxResolution" 56 <*> v .:? "pictureMaxResolution"
57 <*> v .:? "jpegExportQuality" .!= 80
56 58
57 59
58data GalleryConfig = GalleryConfig 60data 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 =
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