From 9c912d2457369c5a8df9e5206d9108fd94ef5bec Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Sat, 5 Oct 2024 23:37:54 +0200 Subject: [PATCH] Split ConvertImage into three steps --- byg/src/DependencyGenerator.hs | 15 ++++++++++++--- byg/src/Evaluation/Function.hs | 15 +++++++++++---- byg/src/Evaluation/FunctionIO.hs | 22 +++++++++------------- byg/src/SiteGenerator.hs | 3 ++- byg/src/Types/Function.hs | 1 + byg/src/Types/FunctionIO.hs | 3 ++- byg/src/Types/Value.hs | 15 +++++++++++++++ byg/src/Types/Values.hs | 13 ++++++++++++- 8 files changed, 64 insertions(+), 23 deletions(-) diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 75c95af..4950cd2 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -33,10 +33,13 @@ module DependencyGenerator , makeTemplate , applyTemplate , toText + , convertImage + , listDirectory , isDirectory , readTextFile - , convertImage + , openImage + , saveImage , saveTextFile , copyFile , copyFile' @@ -236,6 +239,9 @@ applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b toText :: TokenableTo String a => a -> DepGenM' Text toText a = runFunction ToText =<< toToken a +convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM' Image +convertImage a b = runFunction ConvertImage =<< toTupleToken a b + listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath] listDirectory a = runFunctionIO ListDirectory =<< toToken a @@ -245,8 +251,11 @@ isDirectory a = runFunctionIO IsDirectory =<< toToken a readTextFile :: TokenableTo FilePath a => a -> DepGenM' Text readTextFile a = runFunctionIO ReadTextFile =<< toToken a -convertImage :: (TokenableTo FilePath a, TokenableTo FilePath b, TokenableTo ImageConversionSettings c) => a -> b -> c -> DepGenM () -convertImage a b c = runFunctionIO' ConvertImage =<< toTupleToken (toTupleToken a b) c +openImage :: TokenableTo FilePath a => a -> DepGenM' Image +openImage a = runFunctionIO OpenImage =<< toToken a + +saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM () +saveImage a b = runFunctionIO' SaveImage =<< toTupleToken a b saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () saveTextFile a b = runFunctionIO' SaveTextFile =<< toTupleToken a b diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs index cc9d0b7..d56ed22 100644 --- a/byg/src/Evaluation/Function.hs +++ b/byg/src/Evaluation/Function.hs @@ -5,8 +5,11 @@ module Evaluation.Function import Prelude hiding (String, FilePath) import qualified Prelude -import Types (Function(..), Value(..), String(..), Template(..), fromValue) +import Types.Values +import Types (Function(..), Value(..), fromValue, makeString, makeImage) +import qualified Codec.Picture as CP +import qualified Codec.Picture.STBIR as CPS import Data.Char (toLower) import qualified Data.Text as T @@ -17,9 +20,6 @@ fileComponents s = _ : firstRev' -> (reverse firstRev', reverse lastRev) [] -> (reverse lastRev, "") -makeString :: Prelude.String -> Value -makeString = String . StringWrapper - unStringWrapper :: Value -> Prelude.String unStringWrapper = \case String (StringWrapper s) -> s @@ -63,5 +63,12 @@ evalFunction f x = case (f, x) of (ToText, String (StringWrapper s)) -> Text $ T.pack s + (ConvertImage, Tuple (Image (ImageWrapper image), + ImageConversionSettings (ResizeToWidth widthResized))) -> + let sizeFactor :: Double + sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized + heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor) + in makeImage $ CPS.resize CPS.defaultOptions widthResized heightResized image + _ -> error "unexpected combination of function and argument type" diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index 26895ca..1b8e416 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -5,14 +5,13 @@ module Evaluation.FunctionIO import Prelude hiding (String, FilePath) import Types.Values -import Types (FunctionIO(..), Value(..), toValue) +import Types (FunctionIO(..), Value(..), toValue, makeImage) import qualified Data.Text.Lazy as TL import qualified Data.Text.IO as T import qualified Text.Pandoc as P import qualified Text.Blaze.Html.Renderer.Text as B import qualified Codec.Picture as CP -import qualified Codec.Picture.STBIR as CPS import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile) evalFunctionIO :: FunctionIO -> Value -> IO Value @@ -26,17 +25,14 @@ evalFunctionIO f x = case (f, x) of (ReadTextFile, String (StringWrapper s)) -> Text <$> T.readFile s - (ConvertImage, Tuple (Tuple (String (StringWrapper source), String (StringWrapper target)), - ImageConversionSettings (ResizeToWidth widthResized))) -> do - imageOrig <- CP.readImage source - let imageOrig' = case imageOrig of - Left s -> error ("unexpected error: " ++ s) - Right image -> CP.convertRGB8 image - sizeFactor :: Double - sizeFactor = fromIntegral (CP.imageWidth imageOrig') / fromIntegral widthResized - heightResized = round (fromIntegral (CP.imageHeight imageOrig') / sizeFactor) - imageResized = CPS.resize CPS.defaultOptions widthResized heightResized imageOrig' - CP.saveJpgImage 90 target $ CP.ImageRGB8 imageResized + (OpenImage, String (StringWrapper s)) -> do + imageOrig <- CP.readImage s + case imageOrig of + Left e -> error ("unexpected error: " ++ e) + Right image -> pure $ makeImage $ CP.convertRGB8 image + + (SaveImage, Tuple (Image (ImageWrapper image), String (StringWrapper s))) -> do + CP.saveJpgImage 90 s $ CP.ImageRGB8 image pure Empty (SaveTextFile, Tuple (Text t, String (StringWrapper s))) -> do diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 626ff26..e780a33 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -18,7 +18,8 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do path `copyTo` outputDir (base, ext) <- untupleDepGenM $ fileComponents name thumbnailName <- concatStrings [ pure base, inject "-thumbnail.", pure ext ] - convertImage path (joinPaths recipeDirOut thumbnailName) (inject (ResizeToWidth 800)) + imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800)) + saveImage imageResized (joinPaths recipeDirOut thumbnailName) concatTexts [ inject "

Value +makeString = String . StringWrapper + +makeImage :: CP.Image CP.PixelRGB8 -> Value +makeImage = Image . ImageWrapper + class Valuable a where toValue :: a -> Value fromValue :: Value -> a diff --git a/byg/src/Types/Values.hs b/byg/src/Types/Values.hs index c3d72b6..91eb148 100644 --- a/byg/src/Types/Values.hs +++ b/byg/src/Types/Values.hs @@ -1,6 +1,7 @@ module Types.Values ( String(..) , FilePath + , Image(..) , ImageConversionSettings(..) , Template(..) ) where @@ -10,7 +11,8 @@ import qualified Prelude import Data.String (IsString(..)) import Data.Text (Text) -import Language.Haskell.TH.Syntax (Lift) +import qualified Codec.Picture as CP +import Language.Haskell.TH.Syntax (Lift(..)) newtype String = StringWrapper Prelude.String deriving (Eq, Show, Lift) @@ -20,6 +22,15 @@ type FilePath = String instance IsString String where fromString = StringWrapper +newtype Image = ImageWrapper (CP.Image CP.PixelRGB8) + deriving (Eq) + +instance Show Image where + show = const "Image" + +instance Lift Image where + liftTyped _ = error "cannot lift images" + data ImageConversionSettings = ResizeToWidth Int deriving (Eq, Show, Lift)