{-# LANGUAGE FunctionalDependencies #-} module DependencyGenerator ( DepGenM , DepGenM' , evalDepGenM , inject , runFunction , runFunctionIO , mapDepGenM , mapDepGenM_ , filterDepGenM , unzipFstDepGenM , unzipSndDepGenM , unzipDepGenM , joinPaths , fileComponents , isImageExtension , 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)) runFunctionIO' :: FunctionIO -> Token a -> DepGenM () runFunctionIO' f input = tellDep $ makeDependency input (FunctionIO f) NoToken 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 [Bool] -> Token [a] -> DepGenM' [a] filterDepGenM mask input = do genDependency (makeDependency (TupleToken (input, mask)) FilterComp) unzipFstDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a]) unzipFstDepGenM t = do t' <- toToken t case t' of ZipToken (a, _) -> pure a Token _ -> genDependency (makeDependency t' UnzipFst) unzipSndDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [b]) unzipSndDepGenM t = do t' <- toToken t case t' of ZipToken (_, b) -> pure b Token _ -> genDependency (makeDependency t' UnzipSnd) unzipDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a], Token [b]) unzipDepGenM t = do t' <- toToken t a <- unzipFstDepGenM t' b <- unzipSndDepGenM t' pure (a, b) class TokenableTo t s | s -> t where toToken :: s -> DepGenM' t instance TokenableTo a (Token a) where toToken = pure instance TokenableTo a (DepGenM' a) where toToken = id joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath joinPaths (a, b) = do a' <- toToken a b' <- toToken b runFunction JoinPaths $ TupleToken (a', b') fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String) fileComponents a = runFunction FileComponents =<< toToken a isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool isImageExtension a = runFunction IsImageExtension =<< toToken a convertedImageFilename :: TokenableTo FilePath a => a -> DepGenM' FilePath convertedImageFilename a = runFunction ConvertedImageFilename =<< toToken a applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String applyTemplate (a, b) = do a' <- toToken a b' <- toToken b runFunction ApplyTemplate $ TupleToken (a', b') listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath] listDirectory a = runFunctionIO ListDirectory =<< toToken a readTemplate :: TokenableTo FilePath a => a -> DepGenM' Template readTemplate a = runFunctionIO ReadTemplate =<< toToken a convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => (a, b) -> DepGenM () convertImage (a, b) = do a' <- toToken a b' <- toToken b runFunctionIO' ConvertImage $ TupleToken (a', b') saveFile :: (TokenableTo String a, TokenableTo FilePath b) => (a, b) -> DepGenM () saveFile (a, b) = do a' <- toToken a b' <- toToken b runFunctionIO' SaveFile $ TupleToken (a', b') makeDir :: TokenableTo FilePath a => a -> DepGenM () makeDir a = runFunctionIO' MakeDir =<< toToken a runPandoc :: TokenableTo FilePath a => a -> DepGenM' String runPandoc a = runFunctionIO RunPandoc =<< toToken a