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
( 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

View File

@ -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"

View File

@ -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"

View File

@ -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

View File

@ -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)