133 lines
3.8 KiB
Haskell
133 lines
3.8 KiB
Haskell
module DependencyGenerator
|
|
( DepGenM
|
|
, DepGenM'
|
|
, evalDepGenM
|
|
, inject
|
|
, runFunction
|
|
, runFunctionIO
|
|
, mapDepGenM
|
|
, mapDepGenM_
|
|
, filterDepGenM
|
|
|
|
, joinPaths
|
|
, isImageFilename
|
|
, convertedImageFilename
|
|
, applyTemplate
|
|
, listDirectory
|
|
, readTemplate
|
|
, convertImage
|
|
, saveFile
|
|
, makeDir
|
|
, runPandoc
|
|
) where
|
|
|
|
import Types.Token (Token(..))
|
|
import Types.Values
|
|
import Types.Value (Valuable(..))
|
|
import Types.Function (Function(..))
|
|
import Types.FunctionIO (FunctionIO(..))
|
|
import Types.Dependency (Action(..), Dependency, makeDependency)
|
|
|
|
import Control.Monad.State (MonadState, State, runState, put, get)
|
|
import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell)
|
|
|
|
newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
|
|
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
|
|
|
|
type DepGenM' a = DepGenM (Token a)
|
|
|
|
evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int)
|
|
evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top
|
|
|
|
evalDepGenM :: DepGenM () -> [Dependency]
|
|
evalDepGenM m = fst (evalDepGenM' 0 m)
|
|
|
|
tellDep :: Dependency -> DepGenM ()
|
|
tellDep dep = tell [dep]
|
|
|
|
genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a
|
|
genDependencyM f = do
|
|
top <- get
|
|
let top' = top + 1
|
|
target = Token top'
|
|
put top'
|
|
result <- f target
|
|
tellDep result
|
|
pure target
|
|
|
|
genDependency :: (Token a -> Dependency) -> DepGenM' a
|
|
genDependency f = genDependencyM (pure . f)
|
|
|
|
inject :: Valuable a => a -> DepGenM' a
|
|
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 a outer = do
|
|
tellDep (makeDependency a SetListElem outer)
|
|
|
|
runFunction :: Function -> Token a -> DepGenM' b
|
|
runFunction f input = genDependency (makeDependency input (Function f))
|
|
|
|
runFunctionIO :: FunctionIO -> Token a -> DepGenM' b
|
|
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
|
|
|
|
mapDepGenM :: (Token a -> DepGenM' b) -> Token [a] -> DepGenM' [b]
|
|
mapDepGenM f input = genDependencyM $ \target -> do
|
|
top <- get
|
|
let (res, top') = evalDepGenM' top $ do
|
|
inp <- getListElem input
|
|
outp <- f inp
|
|
setListElem outp target
|
|
put top'
|
|
pure (makeDependency input (MapComp res) target)
|
|
|
|
mapDepGenM_ :: (Token a -> DepGenM ()) -> Token [a] -> DepGenM ()
|
|
mapDepGenM_ f input = do
|
|
_ <- mapDepGenM (\x -> f x >> pure NoToken) input
|
|
pure ()
|
|
|
|
filterDepGenM :: (Token a -> DepGenM' Bool) -> Token [a] -> DepGenM' [a]
|
|
filterDepGenM f input = do
|
|
conds <- mapDepGenM f input
|
|
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 input = do
|
|
_ <- runFunctionIO ConvertImage input
|
|
pure ()
|
|
|
|
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 -> DepGenM' String
|
|
runPandoc = runFunctionIO RunPandoc
|