diff --git a/byg/byg.cabal b/byg/byg.cabal index 7f8fa93..06bc348 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -11,7 +11,10 @@ extra-doc-files: README.md common common ghc-options: -Wall - default-language: GHC2024 + default-language: GHC2021 + default-extensions: + OverloadedStrings + LambdaCase library import: common @@ -30,18 +33,22 @@ library DependencyRunner SiteGenerator build-depends: - base + base >=4.14 && <4.20 , mtl , containers - , bytestring , text - , template-haskell + , directory + , blaze-html + , pandoc + , JuicyPixels + , JuicyPixels-stbir + , template-haskell >=2.16 && <2.22 executable byg import: common main-is: src/Main.hs build-depends: - base + base >=4.14 && <4.20 , text , template-haskell , byg diff --git a/byg/default.nix b/byg/default.nix index 86e58f0..9f5650a 100644 --- a/byg/default.nix +++ b/byg/default.nix @@ -6,4 +6,5 @@ pkgs.haskell.lib.overrideCabal "--ghc-option=-Werror" "--ghc-option=-O2" ]; + doHaddock = false; }) diff --git a/byg/nix/common.nix b/byg/nix/common.nix index e9492f6..320f0c6 100644 --- a/byg/nix/common.nix +++ b/byg/nix/common.nix @@ -1,7 +1,7 @@ let sources = import ./sources.nix; pkgs = import sources.nixpkgs {}; - haskell = pkgs.haskell.packages.ghc910; + haskell = pkgs.haskell.packages.ghc98; in { pkgs = pkgs; diff --git a/byg/shell.nix b/byg/shell.nix index 1b72266..84d1e20 100644 --- a/byg/shell.nix +++ b/byg/shell.nix @@ -3,5 +3,10 @@ pkgs.mkShell { buildInputs = [ haskell.ghc pkgs.cabal-install + pkgs.zlib.dev ]; + + shellHook = '' + export LD_LIBRARY_PATH="${pkgs.zlib}/lib"; + ''; } diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index cb402d5..15cbb1f 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} {-# LANGUAGE FunctionalDependencies #-} module DependencyGenerator ( DepGenM @@ -23,7 +24,7 @@ module DependencyGenerator , concatTexts , joinPaths , fileComponents - , isImageExtension + , hasImageExtension , applyTemplate , toText , listDirectory @@ -198,8 +199,8 @@ joinPaths a b = do fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String) fileComponents a = runFunction FileComponents =<< toToken a -isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool -isImageExtension a = runFunction IsImageExtension =<< toToken a +hasImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool +hasImageExtension a = runFunction HasImageExtension =<< toToken a applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text applyTemplate a b = do diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index d46cade..649d8ce 100644 --- a/byg/src/DependencyRunner.hs +++ b/byg/src/DependencyRunner.hs @@ -4,7 +4,7 @@ module DependencyRunner , runDepRunMIO ) where -import Types (Value(..), Valuable(..)) +import Types (Value(..), fromValue) import Types.Dependency import Evaluation.Function import Evaluation.FunctionIO diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs index 1885833..cd3e0d7 100644 --- a/byg/src/Evaluation/Function.hs +++ b/byg/src/Evaluation/Function.hs @@ -2,36 +2,51 @@ module Evaluation.Function ( evalFunction ) where -import Types (Function(..), Value(..)) +import Types (Function(..), Value(..), Template(..), fromValue) + +import Data.Char (toLower) +import qualified Data.Text as T + +fileComponents :: String -> (String, String) +fileComponents s = + let (lastRev, firstRev) = span (/= '.') $ reverse s + in case firstRev of + _ : firstRev' -> (reverse firstRev', reverse lastRev) + [] -> (reverse lastRev, "") + +isImageExtension :: String -> Bool +isImageExtension = (`elem` ["jpg"]) . map toLower evalFunction :: Function -> Value -> Value evalFunction f x = case (f, x) of - (AppendStrings, Tuple (String _, String _)) -> - String undefined + (AppendStrings, Tuple (String s0, String s1)) -> + String (s0 ++ s1) - (ConcatStrings, List _) -> - String undefined + (ConcatStrings, List vs) -> + String $ concatMap fromValue vs - (AppendTexts, Tuple (Text _, Text _)) -> - Text undefined + (AppendTexts, Tuple (Text t0, Text t1)) -> + Text $ T.append t0 t1 - (ConcatTexts, List _) -> - Text undefined + (ConcatTexts, List vs) -> + Text $ T.concat $ map fromValue vs - (JoinPaths, Tuple (String _, String _)) -> - String undefined + (JoinPaths, Tuple (String s0, String s1)) -> + String (s0 ++ "/" ++ s1) - (FileComponents, String _) -> - Tuple (String undefined, String undefined) + (FileComponents, String s) -> + let (base, ext) = fileComponents s + in Tuple (String base, String ext) - (IsImageExtension, String _) -> - Bool undefined + (HasImageExtension, String s) -> + let (_, ext) = fileComponents s + in Bool $ isImageExtension ext - (ApplyTemplate, Tuple (Template _, Text _)) -> - Text undefined + (ApplyTemplate, Tuple (Template (TemplateParts beforeContent afterContent), Text t)) -> + Text $ T.concat [beforeContent, t, afterContent] - (ToText, String _) -> - Text undefined + (ToText, String s) -> + Text $ T.pack s _ -> error "unexpected combination of function and argument type" diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index 63a6a27..1f863e5 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -2,30 +2,59 @@ module Evaluation.FunctionIO ( evalFunctionIO ) where -import Types (FunctionIO(..), Value(..)) +import Types.Values +import Types (FunctionIO(..), Value(..), toValue) + +import qualified Data.Text as T +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, createDirectory, copyFile) evalFunctionIO :: FunctionIO -> Value -> IO Value evalFunctionIO f x = case (f, x) of - (ListDirectory, String _) -> - pure $ List undefined + (ListDirectory, String s) -> + (List . map toValue) <$> listDirectory s - (ReadTemplate, String _) -> - pure $ Template undefined + (ReadTemplate, String s) -> do + t <- T.readFile s + let c = "CONTENT" + (beforeContent, after) = T.breakOn c t + afterContent = T.drop (T.length c) after + pure $ Template $ TemplateParts beforeContent afterContent - (ConvertImage, Tuple (Tuple (String _, String _), ImageConversionSettings _)) -> - pure $ Empty + (ConvertImage, Tuple (Tuple (String source, String 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 + pure Empty - (SaveFile, Tuple (Text _, String _)) -> - pure $ Empty + (SaveFile, Tuple (Text t, String s)) -> do + T.writeFile s t + pure Empty - (CopyFile, Tuple (String _, String _)) -> - pure $ Empty + (CopyFile, Tuple (String source, String target)) -> do + copyFile source target + pure Empty - (MakeDir, String _) -> - pure $ Empty + (MakeDir, String s) -> do + createDirectory s + pure Empty - (RunPandoc, String _) -> - pure $ Text undefined + (RunPandoc, String s) -> do + contents <- T.readFile s + html <- P.runIOorExplode (P.writeHtml5 P.def =<< P.readMarkdown P.def contents) + pure $ Text $ TL.toStrict $ B.renderHtml html _ -> error "unexpected combination of function and argument type" diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index b248661..834fa20 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module SiteGenerator (generateSite) where import Types @@ -30,7 +29,7 @@ handleRecipeDir outputDir template indexName dir = do recipeDirOut <- joinPaths outputDir dir makeDir recipeDirOut dirContents <- listDirectory dir - areImageFilenames <- mapDepGenM isImageExtension + areImageFilenames <- mapDepGenM hasImageExtension $ unzipSndDepGenM $ mapDepGenM fileComponents dirContents imageFilenames <- filterDepGenM areImageFilenames dirContents imagePaths <- mapDepGenM (joinPaths dir) imageFilenames diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index d7c527f..112485c 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GADTs #-} module Types.Dependency ( Action(..) , UToken(..) diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs index c72e3a4..984f052 100644 --- a/byg/src/Types/Function.hs +++ b/byg/src/Types/Function.hs @@ -10,7 +10,7 @@ data Function = AppendStrings | ConcatTexts | JoinPaths | FileComponents - | IsImageExtension + | HasImageExtension | ApplyTemplate | ToText deriving (Show, Lift) diff --git a/byg/src/Types/Values.hs b/byg/src/Types/Values.hs index e388a77..6504794 100644 --- a/byg/src/Types/Values.hs +++ b/byg/src/Types/Values.hs @@ -1,6 +1,5 @@ module Types.Values ( ImageConversionSettings(..) - , TemplatePart(..) , Template(..) ) where @@ -10,9 +9,5 @@ import Language.Haskell.TH.Syntax (Lift) data ImageConversionSettings = ResizeToWidth Int deriving (Show, Lift) -data TemplatePart = Literal Text - | KeyValue Text - deriving (Show, Lift) - -data Template = TemplateParts [TemplatePart] +data Template = TemplateParts Text Text deriving (Show, Lift)