diff options
| -rw-r--r-- | src/Eval.hs | 19 | ||||
| -rw-r--r-- | src/Expr.hs | 4 |
2 files changed, 20 insertions, 3 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index 9ef8718..a918910 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -1,7 +1,7 @@ module Eval ( EvalInput(..), EvalError(..), textEvalError, - Eval, runEval, + Eval, runEval, eval, RepoRef(..), evalJobSet, @@ -13,6 +13,7 @@ module Eval ( ) where import Control.Monad +import Control.Monad.Catch import Control.Monad.Except import Control.Monad.Reader @@ -26,6 +27,7 @@ import System.FilePath import Config import Destination +import Expr import Job.Types import Repo @@ -51,6 +53,21 @@ runEval :: Eval a -> EvalInput -> IO (Either EvalError a) runEval action einput = runExceptT $ flip runReaderT einput action +eval :: forall ctx a. ctx -> Expr ctx a -> Eval a +eval ctx = \case + Pure x -> return x + App f x -> eval' f <*> eval' x + GetContext -> return ctx + AddDependency _ x -> eval' x + ExprIO act x -> do + x' <- eval' x + liftIO (handleIOError (\e -> return $ Left e) (Right <$> act x')) >>= \case + Left e -> throwError $ OtherEvalError $ "IO error: " <> T.pack (show e) + Right y -> return y + where + eval' :: forall b. Expr ctx b -> Eval b + eval' = eval ctx + repoRefLimit :: RepoDepLevel -> RepoRef -> Eval RepoRef repoRefLimit (RepoDepSubtree path) rref = do diff --git a/src/Expr.hs b/src/Expr.hs index fa17158..b4ea0b0 100644 --- a/src/Expr.hs +++ b/src/Expr.hs @@ -17,7 +17,7 @@ data Expr c a where App :: Expr c (a -> b) -> Expr c a -> Expr c b GetContext :: Expr c c AddDependency :: ExprContext c => ExprDependency c -> Expr c a -> Expr c a - ExprIO :: IO a -> Expr c a + ExprIO :: (a -> IO b) -> Expr c a -> Expr c b instance Functor (Expr c) where fmap f x = Pure f <*> x @@ -47,5 +47,5 @@ collectDependencies = \case ExprIO {} -> mempty -exprIO :: IO a -> Expr c a +exprIO :: (a -> IO b) -> Expr c a -> Expr c b exprIO = ExprIO |