Add ApplyTemplate and use NoToken less

This commit is contained in:
Niels G. W. Serup 2024-09-24 23:01:07 +02:00
parent 8bf1e107a0
commit f4ff6d6d98
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
5 changed files with 41 additions and 19 deletions

View File

@ -1,5 +1,6 @@
module DependencyGenerator module DependencyGenerator
( DepGenM ( DepGenM
, DepGenM'
, evalDepGenM , evalDepGenM
, inject , inject
, runFunction , runFunction
@ -8,8 +9,10 @@ module DependencyGenerator
, mapDepGenM_ , mapDepGenM_
, filterDepGenM , filterDepGenM
, joinPaths
, isImageFilename , isImageFilename
, convertedImageFilename , convertedImageFilename
, applyTemplate
, listDirectory , listDirectory
, readTemplate , readTemplate
, convertImage , convertImage
@ -33,10 +36,10 @@ newtype DepGenM' a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
type DepGenM a = DepGenM' (Token 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' top m = runState (execWriterT (unDepGenM m)) top
evalDepGenM :: DepGenM () -> [Dependency] evalDepGenM :: DepGenM' () -> [Dependency]
evalDepGenM m = fst (evalDepGenM' 0 m) evalDepGenM m = fst (evalDepGenM' 0 m)
tellDep :: Dependency -> DepGenM' () tellDep :: Dependency -> DepGenM' ()
@ -61,10 +64,9 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
getListElem :: Token [a] -> DepGenM a getListElem :: Token [a] -> DepGenM a
getListElem outer = genDependency (makeDependency outer GetListElem) getListElem outer = genDependency (makeDependency outer GetListElem)
setListElem :: Token a -> Token [a] -> DepGenM () setListElem :: Token a -> Token [a] -> DepGenM' ()
setListElem a outer = do setListElem a outer = do
tellDep (makeDependency a SetListElem outer) tellDep (makeDependency a SetListElem outer)
pure NoToken
runFunction :: Function -> Token a -> DepGenM b runFunction :: Function -> Token a -> DepGenM b
runFunction f input = genDependency (makeDependency input (Function f)) runFunction f input = genDependency (makeDependency input (Function f))
@ -82,9 +84,9 @@ mapDepGenM f input = genDependencyM $ \target -> do
put top' put top'
pure (makeDependency input (MapComp res) target) 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 = do
_ <- mapDepGenM f input _ <- mapDepGenM (\x -> f x >> pure NoToken) input
pure () pure ()
filterDepGenM :: (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a] filterDepGenM :: (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a]
@ -93,28 +95,38 @@ filterDepGenM f input = do
genDependency (makeDependency (TupleToken input conds) FilterComp) genDependency (makeDependency (TupleToken input conds) FilterComp)
joinPaths :: Token (FilePath, FilePath) -> DepGenM FilePath
joinPaths = runFunction JoinPaths
isImageFilename :: Token FilePath -> DepGenM Bool isImageFilename :: Token FilePath -> DepGenM Bool
isImageFilename = runFunction IsImageFilename isImageFilename = runFunction IsImageFilename
convertedImageFilename :: Token FilePath -> DepGenM FilePath convertedImageFilename :: Token FilePath -> DepGenM FilePath
convertedImageFilename = runFunction ConvertedImageFilename convertedImageFilename = runFunction ConvertedImageFilename
applyTemplate :: Token (Template, String) -> DepGenM String
applyTemplate = runFunction ApplyTemplate
listDirectory :: Token FilePath -> DepGenM [FilePath] listDirectory :: Token FilePath -> DepGenM [FilePath]
listDirectory = runFunctionIO ListDirectory listDirectory = runFunctionIO ListDirectory
readTemplate :: Token FilePath -> DepGenM Template readTemplate :: Token FilePath -> DepGenM Template
readTemplate = runFunctionIO ReadTemplate readTemplate = runFunctionIO ReadTemplate
convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM () convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM' ()
convertImage = runFunctionIO ConvertImage convertImage input = do
_ <- runFunctionIO ConvertImage input
pure ()
saveFile :: Token (String, FilePath) -> DepGenM () saveFile :: Token (String, FilePath) -> DepGenM' ()
saveFile = runFunctionIO SaveFile saveFile input = do
_ <- runFunctionIO SaveFile input
pure ()
makeDir :: Token FilePath -> DepGenM' () makeDir :: Token FilePath -> DepGenM' ()
makeDir input = do makeDir input = do
_ <- runFunctionIO MakeDir input _ <- runFunctionIO MakeDir input
pure () pure ()
runPandoc :: Token (FilePath, FilePath) -> DepGenM () runPandoc :: Token FilePath -> DepGenM String
runPandoc = runFunctionIO RunPandoc runPandoc = runFunctionIO RunPandoc

View File

@ -6,11 +6,17 @@ import Types (Function(..), Value(..))
evalFunction :: Function -> Value -> Value evalFunction :: Function -> Value -> Value
evalFunction f x = case (f, x) of evalFunction f x = case (f, x) of
(JoinPaths, Tuple (String _, String _)) ->
String undefined
(IsImageFilename, String _) -> (IsImageFilename, String _) ->
Bool undefined Bool undefined
(ConvertedImageFilename, String _) -> (ConvertedImageFilename, String _) ->
String undefined String undefined
(ApplyTemplate, Tuple (Template _, String _)) ->
String undefined
_ -> _ ->
error "unexpected combination of function and argument type" error "unexpected combination of function and argument type"

View File

@ -21,8 +21,8 @@ evalFunctionIO f x = case (f, x) of
(MakeDir, String _) -> (MakeDir, String _) ->
pure $ Empty pure $ Empty
(RunPandoc, Tuple (String _, String _)) -> (RunPandoc, String _) ->
pure $ Empty pure $ String undefined
_ -> _ ->
error "unexpected combination of function and argument type" error "unexpected combination of function and argument type"

View File

@ -3,7 +3,7 @@ module SiteGenerator (generateSite) where
import Types import Types
import DependencyGenerator import DependencyGenerator
handleRecipeDir :: Token Template -> Token FilePath -> DepGenM () handleRecipeDir :: Token Template -> Token FilePath -> DepGenM' ()
handleRecipeDir _template dir = do handleRecipeDir _template dir = do
dirContents <- listDirectory dir dirContents <- listDirectory dir
imageFilenames <- filterDepGenM isImageFilename dirContents imageFilenames <- filterDepGenM isImageFilename dirContents
@ -11,9 +11,8 @@ handleRecipeDir _template dir = do
flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do
settings <- inject $ ResizeToWidth 800 settings <- inject $ ResizeToWidth 800
convertImage $ TupleToken files settings convertImage $ TupleToken files settings
pure NoToken
generateSite :: DepGenM () generateSite :: DepGenM' ()
generateSite = do generateSite = do
outputDir <- inject "site" outputDir <- inject "site"
makeDir outputDir makeDir outputDir
@ -23,6 +22,9 @@ generateSite = do
dirContents <- listDirectory dir dirContents <- listDirectory dir
mapDepGenM_ (handleRecipeDir template) dirContents mapDepGenM_ (handleRecipeDir template) dirContents
aboutFilenameIn <- inject "om.md" aboutPathIn <- inject "om.md"
aboutHtmlBody <- runPandoc aboutPathIn
aboutHtml <- applyTemplate $ TupleToken template aboutHtmlBody
aboutFilenameOut <- inject "om.html" aboutFilenameOut <- inject "om.html"
runPandoc $ TupleToken aboutFilenameIn aboutFilenameOut aboutPathOut <- joinPaths $ TupleToken outputDir aboutFilenameOut
saveFile $ TupleToken aboutHtml aboutPathOut

View File

@ -4,7 +4,9 @@ module Types.Function
import Language.Haskell.TH.Syntax (Lift) import Language.Haskell.TH.Syntax (Lift)
data Function = IsImageFilename data Function = JoinPaths
| IsImageFilename
| ConvertedImageFilename | ConvertedImageFilename
| ApplyTemplate
deriving (Show, Lift) deriving (Show, Lift)