Swap DepGenM and DepGenM'

This commit is contained in:
Niels G. W. Serup 2024-09-24 23:09:35 +02:00
parent f4ff6d6d98
commit daacf2e6fa
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 27 additions and 27 deletions

View File

@ -31,21 +31,21 @@ import Types.Dependency (Action(..), Dependency, makeDependency)
import Control.Monad.State (MonadState, State, runState, put, get) import Control.Monad.State (MonadState, State, runState, put, get)
import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell) import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell)
newtype DepGenM' a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency]) deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
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 ()
tellDep dep = tell [dep] tellDep dep = tell [dep]
genDependencyM :: (Token a -> DepGenM' Dependency) -> DepGenM a genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a
genDependencyM f = do genDependencyM f = do
top <- get top <- get
let top' = top + 1 let top' = top + 1
@ -55,26 +55,26 @@ genDependencyM f = do
tellDep result tellDep result
pure target pure target
genDependency :: (Token a -> Dependency) -> DepGenM a genDependency :: (Token a -> Dependency) -> DepGenM' a
genDependency f = genDependencyM (pure . f) genDependency f = genDependencyM (pure . f)
inject :: Valuable a => a -> DepGenM a inject :: Valuable a => a -> DepGenM' a
inject x = genDependency (makeDependency NoToken (Inject (toValue x))) 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)
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))
runFunctionIO :: FunctionIO -> Token a -> DepGenM b runFunctionIO :: FunctionIO -> Token a -> DepGenM' b
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f)) runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
mapDepGenM :: (Token a -> DepGenM b) -> Token [a] -> DepGenM [b] mapDepGenM :: (Token a -> DepGenM' b) -> Token [a] -> DepGenM' [b]
mapDepGenM f input = genDependencyM $ \target -> do mapDepGenM f input = genDependencyM $ \target -> do
top <- get top <- get
let (res, top') = evalDepGenM' top $ do let (res, top') = evalDepGenM' top $ do
@ -84,49 +84,49 @@ 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 (\x -> f x >> pure NoToken) 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]
filterDepGenM f input = do filterDepGenM f input = do
conds <- mapDepGenM f input conds <- mapDepGenM f input
genDependency (makeDependency (TupleToken input conds) FilterComp) genDependency (makeDependency (TupleToken input conds) FilterComp)
joinPaths :: Token (FilePath, FilePath) -> DepGenM FilePath joinPaths :: Token (FilePath, FilePath) -> DepGenM' FilePath
joinPaths = runFunction JoinPaths 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 :: Token (Template, String) -> DepGenM' String
applyTemplate = runFunction ApplyTemplate 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 input = do convertImage input = do
_ <- runFunctionIO ConvertImage input _ <- runFunctionIO ConvertImage input
pure () pure ()
saveFile :: Token (String, FilePath) -> DepGenM' () saveFile :: Token (String, FilePath) -> DepGenM ()
saveFile input = do saveFile input = do
_ <- runFunctionIO SaveFile input _ <- runFunctionIO SaveFile input
pure () 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 -> DepGenM String runPandoc :: Token FilePath -> DepGenM' String
runPandoc = runFunctionIO RunPandoc runPandoc = runFunctionIO RunPandoc

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
@ -12,7 +12,7 @@ handleRecipeDir _template dir = do
settings <- inject $ ResizeToWidth 800 settings <- inject $ ResizeToWidth 800
convertImage $ TupleToken files settings convertImage $ TupleToken files settings
generateSite :: DepGenM' () generateSite :: DepGenM ()
generateSite = do generateSite = do
outputDir <- inject "site" outputDir <- inject "site"
makeDir outputDir makeDir outputDir