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 "