From f4ff6d6d9856651211e422fd81ae09cfb6ca0ab1 Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Tue, 24 Sep 2024 23:01:07 +0200 Subject: [PATCH] Add ApplyTemplate and use NoToken less --- byg/src/DependencyGenerator.hs | 34 +++++++++++++++++++++----------- byg/src/Evaluation/Function.hs | 6 ++++++ byg/src/Evaluation/FunctionIO.hs | 4 ++-- byg/src/SiteGenerator.hs | 12 ++++++----- byg/src/Types/Function.hs | 4 +++- 5 files changed, 41 insertions(+), 19 deletions(-) diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 7c9ef6e..9c80d89 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -1,5 +1,6 @@ module DependencyGenerator ( DepGenM + , DepGenM' , evalDepGenM , inject , runFunction @@ -8,8 +9,10 @@ module DependencyGenerator , mapDepGenM_ , filterDepGenM + , joinPaths , isImageFilename , convertedImageFilename + , applyTemplate , listDirectory , readTemplate , convertImage @@ -33,10 +36,10 @@ newtype DepGenM' a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } type DepGenM a = DepGenM' (Token a) -evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int) +evalDepGenM' :: Int -> DepGenM' () -> ([Dependency], Int) evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top -evalDepGenM :: DepGenM () -> [Dependency] +evalDepGenM :: DepGenM' () -> [Dependency] evalDepGenM m = fst (evalDepGenM' 0 m) tellDep :: Dependency -> DepGenM' () @@ -61,10 +64,9 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x))) getListElem :: Token [a] -> DepGenM a getListElem outer = genDependency (makeDependency outer GetListElem) -setListElem :: Token a -> Token [a] -> DepGenM () +setListElem :: Token a -> Token [a] -> DepGenM' () setListElem a outer = do tellDep (makeDependency a SetListElem outer) - pure NoToken runFunction :: Function -> Token a -> DepGenM b runFunction f input = genDependency (makeDependency input (Function f)) @@ -82,9 +84,9 @@ mapDepGenM f input = genDependencyM $ \target -> do put top' pure (makeDependency input (MapComp res) target) -mapDepGenM_ :: (Token a -> DepGenM ()) -> Token [a] -> DepGenM' () +mapDepGenM_ :: (Token a -> DepGenM' ()) -> Token [a] -> DepGenM' () mapDepGenM_ f input = do - _ <- mapDepGenM f input + _ <- mapDepGenM (\x -> f x >> pure NoToken) input pure () filterDepGenM :: (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a] @@ -93,28 +95,38 @@ filterDepGenM f input = do genDependency (makeDependency (TupleToken input conds) FilterComp) +joinPaths :: Token (FilePath, FilePath) -> DepGenM FilePath +joinPaths = runFunction JoinPaths + isImageFilename :: Token FilePath -> DepGenM Bool isImageFilename = runFunction IsImageFilename convertedImageFilename :: Token FilePath -> DepGenM FilePath convertedImageFilename = runFunction ConvertedImageFilename +applyTemplate :: Token (Template, String) -> DepGenM String +applyTemplate = runFunction ApplyTemplate + listDirectory :: Token FilePath -> DepGenM [FilePath] listDirectory = runFunctionIO ListDirectory readTemplate :: Token FilePath -> DepGenM Template readTemplate = runFunctionIO ReadTemplate -convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM () -convertImage = runFunctionIO ConvertImage +convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM' () +convertImage input = do + _ <- runFunctionIO ConvertImage input + pure () -saveFile :: Token (String, FilePath) -> DepGenM () -saveFile = runFunctionIO SaveFile +saveFile :: Token (String, FilePath) -> DepGenM' () +saveFile input = do + _ <- runFunctionIO SaveFile input + pure () makeDir :: Token FilePath -> DepGenM' () makeDir input = do _ <- runFunctionIO MakeDir input pure () -runPandoc :: Token (FilePath, FilePath) -> DepGenM () +runPandoc :: Token FilePath -> DepGenM String runPandoc = runFunctionIO RunPandoc diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs index d7a6ba7..efe27d4 100644 --- a/byg/src/Evaluation/Function.hs +++ b/byg/src/Evaluation/Function.hs @@ -6,11 +6,17 @@ import Types (Function(..), Value(..)) evalFunction :: Function -> Value -> Value evalFunction f x = case (f, x) of + (JoinPaths, Tuple (String _, String _)) -> + String undefined + (IsImageFilename, String _) -> Bool undefined (ConvertedImageFilename, String _) -> String undefined + (ApplyTemplate, Tuple (Template _, String _)) -> + String undefined + _ -> error "unexpected combination of function and argument type" diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index 2391cb7..05f3e31 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -21,8 +21,8 @@ evalFunctionIO f x = case (f, x) of (MakeDir, String _) -> pure $ Empty - (RunPandoc, Tuple (String _, String _)) -> - pure $ Empty + (RunPandoc, String _) -> + pure $ String undefined _ -> error "unexpected combination of function and argument type" diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index d4bf9ce..afb5035 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -3,7 +3,7 @@ module SiteGenerator (generateSite) where import Types import DependencyGenerator -handleRecipeDir :: Token Template -> Token FilePath -> DepGenM () +handleRecipeDir :: Token Template -> Token FilePath -> DepGenM' () handleRecipeDir _template dir = do dirContents <- listDirectory dir imageFilenames <- filterDepGenM isImageFilename dirContents @@ -11,9 +11,8 @@ handleRecipeDir _template dir = do flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do settings <- inject $ ResizeToWidth 800 convertImage $ TupleToken files settings - pure NoToken -generateSite :: DepGenM () +generateSite :: DepGenM' () generateSite = do outputDir <- inject "site" makeDir outputDir @@ -23,6 +22,9 @@ generateSite = do dirContents <- listDirectory dir mapDepGenM_ (handleRecipeDir template) dirContents - aboutFilenameIn <- inject "om.md" + aboutPathIn <- inject "om.md" + aboutHtmlBody <- runPandoc aboutPathIn + aboutHtml <- applyTemplate $ TupleToken template aboutHtmlBody aboutFilenameOut <- inject "om.html" - runPandoc $ TupleToken aboutFilenameIn aboutFilenameOut + aboutPathOut <- joinPaths $ TupleToken outputDir aboutFilenameOut + saveFile $ TupleToken aboutHtml aboutPathOut diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs index 3b195f8..b7f3de4 100644 --- a/byg/src/Types/Function.hs +++ b/byg/src/Types/Function.hs @@ -4,7 +4,9 @@ module Types.Function import Language.Haskell.TH.Syntax (Lift) -data Function = IsImageFilename +data Function = JoinPaths + | IsImageFilename | ConvertedImageFilename + | ApplyTemplate deriving (Show, Lift)