formulate interpret as a Sink

3 files changed, 9 insertions, 3 deletions

diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs
index f0b1456..a4546f8 100644
--- a/events/src/Events/Spec.hs
+++ b/events/src/Events/Spec.hs
@@ -2,7 +2,7 @@
 
 module Events.Spec
        ( interpret
-       , Spec, Expr(..), Elem(..)
+       , Spec, Expr(..), Val(..), Bindable(..), Elem(..)
        , module Events.Spec.Parse
        , module Events.Spec.Eval
        ) where
@@ -21,5 +21,5 @@ import qualified Data.Text as T
 import Control.Monad.Catch (MonadThrow)
 
 
-interpret :: MonadThrow m => Producer m Text -> Eval m ()
-interpret source = evalExpr =<< lift (connect source parse)
+interpret :: Monad m => Sink (Spec m) (Eval m) ()
+interpret = maybe (lift mzero) (const interpret <=< lift . evalExpr) =<< await
diff --git a/events/src/Events/Types.hs b/events/src/Events/Types.hs
index 6a8517b..ec4f62d 100644
--- a/events/src/Events/Types.hs
+++ b/events/src/Events/Types.hs
@@ -27,6 +27,7 @@ import Events.Types.NDT (NDT, foldNDT)
 
 import Control.Monad.State.Lazy
 import Control.Monad.Reader
+import Control.Monad.Catch (MonadThrow)
 
 import Control.Applicative (Alternative(..))
 
@@ -80,6 +81,7 @@ newtype Eval m a = Eval { unEval :: StateT ObjCtx (NDT (ReaderT EvalCtx m)) a }
            , Alternative
            , Monad
            , MonadPlus
+           , MonadThrow
            )
 
 instance MonadTrans Eval where
diff --git a/events/src/Events/Types/NDT.hs b/events/src/Events/Types/NDT.hs
index f6d3000..848ad39 100644
--- a/events/src/Events/Types/NDT.hs
+++ b/events/src/Events/Types/NDT.hs
@@ -24,6 +24,7 @@ import Control.Monad.Identity
 import Control.Monad.Trans
 import Control.Monad.Reader (MonadReader(..))
 import Control.Monad.Trans.Maybe
+import Control.Monad.Catch (MonadThrow(..))
 
 import Debug.Trace
 
@@ -72,6 +73,9 @@ instance MonadReader r m => MonadReader r (NDT m) where
 instance MonadIO m => MonadIO (NDT m) where
   liftIO = lift . liftIO
 
+instance MonadThrow m => MonadThrow (NDT m) where
+  throwM = lift . throwM
+
 empty :: Applicative m => NDT m a
 empty = NDTCons $ pure Nothing