mad/byg/src/DependencyGenerator.hs

module DependencyGenerator
  ( DepGenM
  , evalDepGenM
  , inject
  , runFunction
  , runFunctionIO
  , mapDepGenM
  , mapDepGenM_
  , filterDepGenM

  , isImageFilename
  , convertedImageFilename
  , listDirectory
  , readTemplate
  , convertImage
  , saveFile
  , 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)
import Language.Haskell.TH.Syntax (Lift)

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 :: (Show a, Lift a) => (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 :: (Show a, Lift a) => (Token a -> Dependency) -> DepGenM a
genDependency f = genDependencyM (pure . f)

inject :: (Show a, Lift a, Valuable a) => a -> DepGenM a
inject x = genDependency (makeDependency NoToken (Inject (toValue x)))

getListElem :: (Show a, Lift a) => Token [a] -> DepGenM a
getListElem outer = genDependency (makeDependency outer GetListElem)

setListElem :: (Show a, Lift a) => Token a -> Token [a] -> DepGenM ()
setListElem a outer = do
  tellDep (makeDependency a SetListElem outer)
  pure NoToken

runFunction :: (Show a, Show b, Lift a, Lift b) => Function -> Token a -> DepGenM b
runFunction f input = genDependency (makeDependency input (Function f))

runFunctionIO :: (Show a, Show b, Lift a, Lift b) => FunctionIO -> Token a -> DepGenM b
runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))

mapDepGenM :: (Show a, Show b, Lift a, Lift b) => (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_ :: (Show a, Lift a) => (Token a -> DepGenM ()) -> Token [a] -> DepGenM ()
mapDepGenM_ f input = do
  _ <- mapDepGenM f input
  pure NoToken

filterDepGenM :: (Show a, Lift a) => (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a]
filterDepGenM f input = do
  conds <- mapDepGenM f input
  genDependency (makeDependency (TupleToken input conds) FilterComp)


isImageFilename :: Token FilePath -> DepGenM Bool
isImageFilename = runFunction IsImageFilename

convertedImageFilename :: Token FilePath -> DepGenM FilePath
convertedImageFilename = runFunction ConvertedImageFilename

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

saveFile :: Token (String, FilePath) -> DepGenM ()
saveFile = runFunctionIO SaveFile

runPandoc :: Token String -> DepGenM String
runPandoc = runFunctionIO RunPandoc