Implement functions

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

byg/default.nix

@@ -6,4 +6,5 @@ pkgs.haskell.lib.overrideCabal
       "--ghc-option=-Werror"
       "--ghc-option=-O2"
     ];
+    doHaddock = false;
   })

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;

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";
+  '';
 }

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
+hasImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool
-isImageExtension a = runFunction IsImageExtension =<< toToken a
+hasImageExtension a = runFunction HasImageExtension =<< toToken a
 
 applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text
 applyTemplate a b = do

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

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 _)) ->
+  (AppendStrings, Tuple (String s0, String s1)) ->
-    String undefined
+    String (s0 ++ s1)
 
-  (ConcatStrings, List _) ->
+  (ConcatStrings, List vs) ->
-    String undefined
+    String $ concatMap fromValue vs
 
-  (AppendTexts, Tuple (Text _, Text _)) ->
+  (AppendTexts, Tuple (Text t0, Text t1)) ->
-    Text undefined
+    Text $ T.append t0 t1
 
-  (ConcatTexts, List _) ->
+  (ConcatTexts, List vs) ->
-    Text undefined
+    Text $ T.concat $ map fromValue vs
 
-  (JoinPaths, Tuple (String _, String _)) ->
+  (JoinPaths, Tuple (String s0, String s1)) ->
-    String undefined
+    String (s0 ++ "/" ++ s1)
 
-  (FileComponents, String _) ->
+  (FileComponents, String s) ->
-    Tuple (String undefined, String undefined)
+    let (base, ext) = fileComponents s
+    in Tuple (String base, String ext)
 
-  (IsImageExtension, String _) ->
+  (HasImageExtension, String s) ->
-    Bool undefined
+    let (_, ext) = fileComponents s
+    in Bool $ isImageExtension ext
 
-  (ApplyTemplate, Tuple (Template _, Text _)) ->
+  (ApplyTemplate, Tuple (Template (TemplateParts beforeContent afterContent), Text t)) ->
-    Text undefined
+    Text $ T.concat [beforeContent, t, afterContent]
 
-  (ToText, String _) ->
+  (ToText, String s) ->
-    Text undefined
+    Text $ T.pack s
 
   _ ->
     error "unexpected combination of function and argument type"

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 _) ->
+  (ListDirectory, String s) ->
-    pure $ List undefined
+    (List . map toValue) <$> listDirectory s
 
-  (ReadTemplate, String _) ->
+  (ReadTemplate, String s) -> do
-    pure $ Template undefined
+    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 _)) ->
+  (ConvertImage, Tuple (Tuple (String source, String target),
-    pure $ Empty
+                        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 _)) ->
+  (SaveFile, Tuple (Text t, String s)) -> do
-    pure $ Empty
+    T.writeFile s t
+    pure Empty
 
-  (CopyFile, Tuple (String _, String _)) ->
+  (CopyFile, Tuple (String source, String target)) -> do
-    pure $ Empty
+    copyFile source target
+    pure Empty
 
-  (MakeDir, String _) ->
+  (MakeDir, String s) -> do
-    pure $ Empty
+    createDirectory s
+    pure Empty
 
-  (RunPandoc, String _) ->
+  (RunPandoc, String s) -> do
-    pure $ Text undefined
+    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"

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

byg/src/Types/Dependency.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GADTs #-}
 module Types.Dependency
   ( Action(..)
   , UToken(..)

byg/src/Types/Function.hs

@@ -10,7 +10,7 @@ data Function = AppendStrings
               | ConcatTexts
               | JoinPaths
               | FileComponents
-              | IsImageExtension
+              | HasImageExtension
               | ApplyTemplate
               | ToText
   deriving (Show, Lift)

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
+data Template = TemplateParts Text Text
-                  | KeyValue Text
-  deriving (Show, Lift)
-
-data Template = TemplateParts [TemplatePart]
   deriving (Show, Lift)