diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/package.yaml | 3 | ||||
-rw-r--r-- | compiler/src/Compiler.hs | 4 | ||||
-rw-r--r-- | compiler/src/Config.hs | 2 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 101 |
4 files changed, 33 insertions, 77 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml index 043985d..9b96d17 100644 --- a/compiler/package.yaml +++ b/compiler/package.yaml | |||
@@ -23,12 +23,11 @@ dependencies: | |||
23 | - aeson | 23 | - aeson |
24 | - yaml | 24 | - yaml |
25 | - cmdargs | 25 | - cmdargs |
26 | - JuicyPixels | ||
27 | - JuicyPixels-extra | ||
28 | - parallel-io | 26 | - parallel-io |
29 | - Glob | 27 | - Glob |
30 | - safe | 28 | - safe |
31 | - time | 29 | - time |
30 | - process | ||
32 | 31 | ||
33 | default-extensions: | 32 | default-extensions: |
34 | - DuplicateRecordFields | 33 | - DuplicateRecordFields |
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index aca96bc..27598b7 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -130,9 +130,9 @@ compileGallery inputDirPath outputDirPath rebuildAll = | |||
130 | 130 | ||
131 | itemProcessor config cache = | 131 | itemProcessor config cache = |
132 | itemFileProcessor | 132 | itemFileProcessor |
133 | (pictureMaxResolution config) (jpegExportQuality config) cache | 133 | (pictureMaxResolution config) cache |
134 | inputDirPath outputDirPath itemsDir | 134 | inputDirPath outputDirPath itemsDir |
135 | thumbnailProcessor config cache = | 135 | thumbnailProcessor config cache = |
136 | thumbnailFileProcessor | 136 | thumbnailFileProcessor |
137 | (thumbnailMaxResolution config) (jpegExportQuality config) cache | 137 | (thumbnailMaxResolution config) cache |
138 | inputDirPath outputDirPath thumbnailsDir | 138 | inputDirPath outputDirPath thumbnailsDir |
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 4446c14..d670aae 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs | |||
@@ -41,7 +41,6 @@ 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 | ||
45 | } deriving (Generic, Show) | 44 | } deriving (Generic, Show) |
46 | 45 | ||
47 | instance FromJSON CompilerConfig where | 46 | instance FromJSON CompilerConfig where |
@@ -54,7 +53,6 @@ instance FromJSON CompilerConfig where | |||
54 | <*> v .:? "tagsFromDirectories" .!= 0 | 53 | <*> v .:? "tagsFromDirectories" .!= 0 |
55 | <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400) | 54 | <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400) |
56 | <*> v .:? "pictureMaxResolution" | 55 | <*> v .:? "pictureMaxResolution" |
57 | <*> v .:? "jpegExportQuality" .!= 80 | ||
58 | 56 | ||
59 | 57 | ||
60 | data GalleryConfig = GalleryConfig | 58 | data GalleryConfig = GalleryConfig |
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 2abdec5..4e7c5a7 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -24,17 +24,15 @@ module Processors | |||
24 | ) where | 24 | ) where |
25 | 25 | ||
26 | 26 | ||
27 | import Control.Exception (Exception, throwIO) | 27 | import Control.Exception (Exception) |
28 | import Data.Function ((&)) | 28 | import Data.Function ((&)) |
29 | import Data.Ratio ((%)) | ||
30 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
31 | 30 | ||
32 | import System.Directory hiding (copyFile) | 31 | import System.Directory hiding (copyFile) |
33 | import qualified System.Directory | 32 | import qualified System.Directory |
34 | import System.FilePath | 33 | import System.FilePath |
35 | 34 | ||
36 | import Codec.Picture | 35 | import System.Process (callProcess) |
37 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) | ||
38 | 36 | ||
39 | import Resource | 37 | import Resource |
40 | ( ItemProcessor, ThumbnailProcessor | 38 | ( ItemProcessor, ThumbnailProcessor |
@@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show | |||
47 | instance Exception ProcessingException | 45 | instance Exception ProcessingException |
48 | 46 | ||
49 | 47 | ||
50 | data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif | ||
51 | |||
52 | -- TODO: handle video, music, text... | 48 | -- TODO: handle video, music, text... |
53 | data Format = PictureFormat PictureFileFormat | Unknown | 49 | data Format = PictureFormat | Unknown |
54 | 50 | ||
55 | formatFromPath :: Path -> Format | 51 | formatFromPath :: Path -> Format |
56 | formatFromPath = | 52 | formatFromPath = |
@@ -60,14 +56,15 @@ formatFromPath = | |||
60 | . fileName | 56 | . fileName |
61 | where | 57 | where |
62 | fromExt :: String -> Format | 58 | fromExt :: String -> Format |
63 | fromExt ".bmp" = PictureFormat Bmp | 59 | fromExt ext = case ext of |
64 | fromExt ".jpg" = PictureFormat Jpg | 60 | ".bmp" -> PictureFormat |
65 | fromExt ".jpeg" = PictureFormat Jpg | 61 | ".jpg" -> PictureFormat |
66 | fromExt ".png" = PictureFormat Png | 62 | ".jpeg" -> PictureFormat |
67 | fromExt ".tiff" = PictureFormat Tiff | 63 | ".png" -> PictureFormat |
68 | fromExt ".hdr" = PictureFormat Hdr | 64 | ".tiff" -> PictureFormat |
69 | fromExt ".gif" = PictureFormat Gif | 65 | ".hdr" -> PictureFormat |
70 | fromExt _ = Unknown | 66 | ".gif" -> PictureFormat |
67 | _ -> Unknown | ||
71 | 68 | ||
72 | 69 | ||
73 | type FileProcessor = | 70 | type FileProcessor = |
@@ -80,47 +77,16 @@ copyFileProcessor inputPath outputPath = | |||
80 | (putStrLn $ "Copying:\t" ++ outputPath) | 77 | (putStrLn $ "Copying:\t" ++ outputPath) |
81 | >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath | 78 | >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath |
82 | 79 | ||
83 | 80 | resizePictureUpTo :: Resolution -> FileProcessor | |
84 | type LossyExportQuality = Int | 81 | resizePictureUpTo maxResolution inputPath outputPath = |
85 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) | 82 | (putStrLn $ "Generating:\t" ++ outputPath) |
86 | type StaticImageWriter = FilePath -> DynamicImage -> IO () | 83 | >> ensureParentDir (flip resize) outputPath inputPath |
87 | |||
88 | resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor | ||
89 | resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat = | ||
90 | resizerFor pictureFormat | ||
91 | where | 84 | where |
92 | resizerFor :: PictureFileFormat -> FileProcessor | 85 | maxSize :: Resolution -> String |
93 | resizerFor Bmp = resizer readBitmap saveBmpImage | 86 | maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" |
94 | resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality) | 87 | |
95 | resizerFor Png = resizer readPng savePngImage | 88 | resize :: FileName -> FileName -> IO () |
96 | resizerFor Tiff = resizer readTiff saveTiffImage | 89 | resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] |
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) | ||
124 | 90 | ||
125 | 91 | ||
126 | type Cache = FileProcessor -> FileProcessor | 92 | type Cache = FileProcessor -> FileProcessor |
@@ -160,8 +126,8 @@ type ItemFileProcessor = | |||
160 | -> FileName -- ^ Output class (subdir) | 126 | -> FileName -- ^ Output class (subdir) |
161 | -> ItemProcessor | 127 | -> ItemProcessor |
162 | 128 | ||
163 | itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor | 129 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
164 | itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = | 130 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = |
165 | cached processor inPath outPath | 131 | cached processor inPath outPath |
166 | >> resourceAt outPath relOutPath | 132 | >> resourceAt outPath relOutPath |
167 | >>= return . props | 133 | >>= return . props |
@@ -172,14 +138,9 @@ itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase re | |||
172 | (processor, props) = processorFor maxResolution $ formatFromPath inputRes | 138 | (processor, props) = processorFor maxResolution $ formatFromPath inputRes |
173 | 139 | ||
174 | processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) | 140 | processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) |
175 | processorFor Nothing _ = | 141 | processorFor Nothing _ = (copyFileProcessor, Other) |
176 | (copyFileProcessor, Other) | 142 | processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture) |
177 | processorFor _ (PictureFormat Gif) = | 143 | processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? |
178 | (copyFileProcessor, Picture) -- TODO: handle animated gif resizing | ||
179 | processorFor (Just maxRes) (PictureFormat picFormat) = | ||
180 | (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture) | ||
181 | processorFor _ Unknown = | ||
182 | (copyFileProcessor, Other) -- TODO: handle video reencoding and others? | ||
183 | 144 | ||
184 | 145 | ||
185 | type ThumbnailFileProcessor = | 146 | type ThumbnailFileProcessor = |
@@ -188,8 +149,8 @@ type ThumbnailFileProcessor = | |||
188 | -> FileName -- ^ Output class (subdir) | 149 | -> FileName -- ^ Output class (subdir) |
189 | -> ThumbnailProcessor | 150 | -> ThumbnailProcessor |
190 | 151 | ||
191 | thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor | 152 | thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor |
192 | thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes = | 153 | thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = |
193 | cached <$> processorFor (formatFromPath inputRes) | 154 | cached <$> processorFor (formatFromPath inputRes) |
194 | & process | 155 | & process |
195 | where | 156 | where |
@@ -205,7 +166,5 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC | |||
205 | >>= return . Just | 166 | >>= return . Just |
206 | 167 | ||
207 | processorFor :: Format -> Maybe FileProcessor | 168 | processorFor :: Format -> Maybe FileProcessor |
208 | processorFor (PictureFormat picFormat) = | 169 | processorFor PictureFormat = Just $ resizePictureUpTo maxRes |
209 | Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat | 170 | processorFor _ = Nothing |