Evaluation of Expr type

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