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/Processors.hs | 80 ++++++++++++++++++++++++---------------------- 1 file changed, 42 insertions(+), 38 deletions(-) (limited to 'compiler/src/Processors.hs') 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 From 2a336b297237b546f065f706838f4cefad4c3e7c Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 25 Jan 2020 13:47:27 +0100 Subject: compiler: add resource timestamp in generated index Add a timestamp to resource paths in the gallery index to invalidate elements in the browser's cache when necessary. Timestamps are added to resource URLs as a dummy numeric parameter. GitHub: closes #40 --- compiler/src/Processors.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 1c4a791..2abdec5 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -38,7 +38,7 @@ import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but i import Resource ( ItemProcessor, ThumbnailProcessor - , GalleryItemProps(..), Resolution(..) ) + , GalleryItemProps(..), Resolution(..), Resource(..) ) import Files @@ -150,6 +150,10 @@ withCached processor inputPath outputPath = skip = putStrLn $ "Skipping:\t" ++ outputPath +resourceAt :: FilePath -> Path -> IO Resource +resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath + + type ItemFileProcessor = FileName -- ^ Input base path -> FileName -- ^ Output base path @@ -159,14 +163,15 @@ type ItemFileProcessor = itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = cached processor inPath outPath - >> return (props relOutPath) + >> resourceAt outPath relOutPath + >>= return . props where relOutPath = resClass /> inputRes inPath = localPath $ inputBase /> inputRes outPath = localPath $ outputBase /> relOutPath (processor, props) = processorFor maxResolution $ formatFromPath inputRes - processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps) + processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) processorFor Nothing _ = (copyFileProcessor, Other) processorFor _ (PictureFormat Gif) = @@ -192,11 +197,12 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC inPath = localPath $ inputBase /> inputRes outPath = localPath $ outputBase /> relOutPath - process :: Maybe FileProcessor -> IO (Maybe Path) + process :: Maybe FileProcessor -> IO (Maybe Resource) process Nothing = return Nothing process (Just proc) = proc inPath outPath - >> return (Just relOutPath) + >> resourceAt outPath relOutPath + >>= return . Just processorFor :: Format -> Maybe FileProcessor processorFor (PictureFormat picFormat) = -- cgit v1.2.3 From c05cbe525ad44273cc1b9b58549af757f549dcb7 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 27 Jan 2020 14:29:47 +0100 Subject: compiler: switch to imagemagick Use ImageMagick to resize images instead of JuicyPixels, using the superior Lanczos resampling and cutting memory usage. This requires ImageMagick to be installed on the host system and the `magick` executable to be present in the PATH. GitHub: closes #49 --- compiler/src/Processors.hs | 101 ++++++++++++++------------------------------- 1 file changed, 30 insertions(+), 71 deletions(-) (limited to 'compiler/src/Processors.hs') 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 ) where -import Control.Exception (Exception, throwIO) +import Control.Exception (Exception) import Data.Function ((&)) -import Data.Ratio ((%)) import Data.Char (toLower) import System.Directory hiding (copyFile) import qualified System.Directory import System.FilePath -import Codec.Picture -import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) +import System.Process (callProcess) import Resource ( ItemProcessor, ThumbnailProcessor @@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show instance Exception ProcessingException -data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif - -- TODO: handle video, music, text... -data Format = PictureFormat PictureFileFormat | Unknown +data Format = PictureFormat | Unknown formatFromPath :: Path -> Format formatFromPath = @@ -60,14 +56,15 @@ formatFromPath = . fileName where fromExt :: String -> Format - fromExt ".bmp" = PictureFormat Bmp - fromExt ".jpg" = PictureFormat Jpg - fromExt ".jpeg" = PictureFormat Jpg - fromExt ".png" = PictureFormat Png - fromExt ".tiff" = PictureFormat Tiff - fromExt ".hdr" = PictureFormat Hdr - fromExt ".gif" = PictureFormat Gif - fromExt _ = Unknown + fromExt ext = case ext of + ".bmp" -> PictureFormat + ".jpg" -> PictureFormat + ".jpeg" -> PictureFormat + ".png" -> PictureFormat + ".tiff" -> PictureFormat + ".hdr" -> PictureFormat + ".gif" -> PictureFormat + _ -> Unknown type FileProcessor = @@ -80,47 +77,16 @@ copyFileProcessor inputPath outputPath = (putStrLn $ "Copying:\t" ++ outputPath) >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath - -type LossyExportQuality = Int -type StaticImageReader = FilePath -> IO (Either String DynamicImage) -type StaticImageWriter = FilePath -> DynamicImage -> IO () - -resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor -resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat = - resizerFor pictureFormat +resizePictureUpTo :: Resolution -> FileProcessor +resizePictureUpTo maxResolution inputPath outputPath = + (putStrLn $ "Generating:\t" ++ outputPath) + >> ensureParentDir (flip resize) outputPath inputPath where - 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) + maxSize :: Resolution -> String + maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" + + resize :: FileName -> FileName -> IO () + resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] type Cache = FileProcessor -> FileProcessor @@ -160,8 +126,8 @@ type ItemFileProcessor = -> FileName -- ^ Output class (subdir) -> ItemProcessor -itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor -itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = +itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor +itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = cached processor inPath outPath >> resourceAt outPath relOutPath >>= return . props @@ -172,14 +138,9 @@ itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase re (processor, props) = processorFor maxResolution $ formatFromPath inputRes processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) - processorFor Nothing _ = - (copyFileProcessor, Other) - processorFor _ (PictureFormat Gif) = - (copyFileProcessor, Picture) -- TODO: handle animated gif resizing - processorFor (Just maxRes) (PictureFormat picFormat) = - (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture) - processorFor _ Unknown = - (copyFileProcessor, Other) -- TODO: handle video reencoding and others? + processorFor Nothing _ = (copyFileProcessor, Other) + processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture) + processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? type ThumbnailFileProcessor = @@ -188,8 +149,8 @@ type ThumbnailFileProcessor = -> FileName -- ^ Output class (subdir) -> ThumbnailProcessor -thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor -thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes = +thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor +thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = cached <$> processorFor (formatFromPath inputRes) & process where @@ -205,7 +166,5 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC >>= return . Just processorFor :: Format -> Maybe FileProcessor - processorFor (PictureFormat picFormat) = - Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat - processorFor _ = - Nothing + processorFor PictureFormat = Just $ resizePictureUpTo maxRes + processorFor _ = Nothing -- cgit v1.2.3 From c8692be41903791764de314c099ead7f078eed20 Mon Sep 17 00:00:00 2001 From: pacien Date: Wed, 29 Jan 2020 22:17:13 +0100 Subject: compiler: fix picture item type without resize GitHub: closes #52 --- compiler/src/Processors.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 4e7c5a7..f2ade63 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -138,8 +138,8 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = (processor, props) = processorFor maxResolution $ formatFromPath inputRes processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) - processorFor Nothing _ = (copyFileProcessor, Other) processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture) + processorFor Nothing PictureFormat = (copyFileProcessor, Picture) processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? -- cgit v1.2.3 From b1cdddcca9b627e8ba1f2870aa5e62043f7b04b3 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 31 Jan 2020 18:15:41 +0100 Subject: compiler: auto orient processed images Let ImageMagick re-orient images based on EXIF metadata. Some web browsers still don't support that correctly. GitHub: closes #67 --- compiler/src/Processors.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index f2ade63..df7e632 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -86,7 +86,11 @@ resizePictureUpTo maxResolution inputPath outputPath = maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" resize :: FileName -> FileName -> IO () - resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] + resize input output = callProcess "magick" + [ input + , "-auto-orient" + , "-resize", maxSize maxResolution + , output ] type Cache = FileProcessor -> FileProcessor -- cgit v1.2.3 From 7dde692101a7e36e0a431aeb864cbf3a0c0e96f8 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 31 Jan 2020 19:43:24 +0100 Subject: compiler: add thumbnail size to index --- compiler/src/Processors.hs | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index f2ade63..9ddc6ee 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -27,16 +27,17 @@ module Processors import Control.Exception (Exception) import Data.Function ((&)) import Data.Char (toLower) +import Data.List (break) import System.Directory hiding (copyFile) import qualified System.Directory import System.FilePath -import System.Process (callProcess) +import System.Process (callProcess, readProcess) import Resource ( ItemProcessor, ThumbnailProcessor - , GalleryItemProps(..), Resolution(..), Resource(..) ) + , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) ) import Files @@ -119,6 +120,12 @@ withCached processor inputPath outputPath = resourceAt :: FilePath -> Path -> IO Resource resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath +getImageResolution :: FilePath -> IO Resolution +getImageResolution fsPath = + readProcess "identify" ["-format", "%w %h", fsPath] [] + >>= return . break (== ' ') + >>= return . \(w, h) -> Resolution (read w) (read h) + type ItemFileProcessor = FileName -- ^ Input base path @@ -158,12 +165,14 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = inPath = localPath $ inputBase /> inputRes outPath = localPath $ outputBase /> relOutPath - process :: Maybe FileProcessor -> IO (Maybe Resource) + process :: Maybe FileProcessor -> IO (Maybe Thumbnail) process Nothing = return Nothing process (Just proc) = - proc inPath outPath - >> resourceAt outPath relOutPath - >>= return . Just + do + proc inPath outPath + resource <- resourceAt outPath relOutPath + resolution <- getImageResolution outPath + return $ Just $ Thumbnail resource resolution processorFor :: Format -> Maybe FileProcessor processorFor PictureFormat = Just $ resizePictureUpTo maxRes -- cgit v1.2.3 From 5e85fe0743a2ce0d715ce81d37f02729fce01d9c Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 2 Feb 2020 22:31:15 +0100 Subject: compiler: fix resolution extraction for multilayer images GitHub: closes #84 --- compiler/src/Processors.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index fc719af..16837a6 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -126,9 +126,11 @@ resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource res getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = - readProcess "identify" ["-format", "%w %h", fsPath] [] + readProcess "identify" ["-format", "%w %h", firstFrame] [] >>= return . break (== ' ') >>= return . \(w, h) -> Resolution (read w) (read h) + where + firstFrame = fsPath ++ "[0]" type ItemFileProcessor = -- cgit v1.2.3 From bb186990000dd133ecfe6741472b03af92eea233 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 3 Feb 2020 19:00:04 +0100 Subject: compiler: handle image resolution parsing error GitHub: closes #86 --- compiler/src/Processors.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 16837a6..6ab4eb5 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -24,10 +24,11 @@ module Processors ) where -import Control.Exception (Exception) +import Control.Exception (Exception, throwIO) import Data.Function ((&)) import Data.Char (toLower) import Data.List (break) +import Text.Read (readMaybe) import System.Directory hiding (copyFile) import qualified System.Directory @@ -126,12 +127,18 @@ resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource res getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = - readProcess "identify" ["-format", "%w %h", firstFrame] [] - >>= return . break (== ' ') - >>= return . \(w, h) -> Resolution (read w) (read h) + readProcess "magick" ["identify", "-format", "%w %h", firstFrame] [] + >>= parseResolution . break (== ' ') where + firstFrame :: FilePath firstFrame = fsPath ++ "[0]" + parseResolution :: (String, String) -> IO Resolution + parseResolution (widthString, heightString) = + case (readMaybe widthString, readMaybe heightString) of + (Just w, Just h) -> return $ Resolution w h + _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." + type ItemFileProcessor = FileName -- ^ Input base path -- cgit v1.2.3 From b757ee814c01c83b17b495c4805fcc70d7e08c89 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 3 Feb 2020 15:08:46 +0100 Subject: compiler: simplify checks --- compiler/src/Processors.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 6ab4eb5..faa2f43 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -25,6 +25,7 @@ module Processors import Control.Exception (Exception, throwIO) +import Control.Monad (when) import Data.Function ((&)) import Data.Char (toLower) import Data.List (break) @@ -106,7 +107,7 @@ withCached :: Cache withCached processor inputPath outputPath = do isDir <- doesDirectoryExist outputPath - if isDir then removePathForcibly outputPath else noop + when isDir $ removePathForcibly outputPath fileExists <- doesFileExist outputPath if fileExists then @@ -117,7 +118,6 @@ withCached processor inputPath outputPath = update where - noop = return () update = processor inputPath outputPath skip = putStrLn $ "Skipping:\t" ++ outputPath -- cgit v1.2.3 From b04c5a58f449db6f8de0e837ffed1e087238787d Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 25 Apr 2020 21:34:00 +0200 Subject: compiler: bump stackage lts to 15.9 --- compiler/src/Processors.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index faa2f43..b1b688a 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -28,7 +28,6 @@ import Control.Exception (Exception, throwIO) import Control.Monad (when) import Data.Function ((&)) import Data.Char (toLower) -import Data.List (break) import Text.Read (readMaybe) import System.Directory hiding (copyFile) -- cgit v1.2.3 From 579df471dee7b6fe0be8a9ad8e2fa2362c9bf6cd Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 28 Apr 2020 00:14:31 +0200 Subject: compiler: add picture size to index This is needed for the picture viewer fancy loading phase. --- compiler/src/Processors.hs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index b1b688a..02db325 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -138,6 +138,17 @@ getImageResolution fsPath = (Just w, Just h) -> return $ Resolution w h _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." +getPictureProps :: ItemDescriber +getPictureProps fsPath resource = + getImageResolution fsPath + >>= return . Picture resource + + +type ItemDescriber = + FilePath + -> Resource + -> IO GalleryItemProps + type ItemFileProcessor = FileName -- ^ Input base path @@ -147,19 +158,20 @@ type ItemFileProcessor = itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = - cached processor inPath outPath - >> resourceAt outPath relOutPath - >>= return . props + cached processor inPath outPath + >> resourceAt outPath relOutPath + >>= descriptor outPath where relOutPath = resClass /> inputRes inPath = localPath $ inputBase /> inputRes outPath = localPath $ outputBase /> relOutPath - (processor, props) = processorFor maxResolution $ formatFromPath inputRes + (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution - processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) - processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture) - processorFor Nothing PictureFormat = (copyFileProcessor, Picture) - processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? + processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) + processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) + processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) + -- TODO: handle video reencoding and others? + processorFor Unknown _ = (copyFileProcessor, const $ return . Other) type ThumbnailFileProcessor = -- cgit v1.2.3