From f5311120a05081ee67de73057f1057e6f54b40e2 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 5 Aug 2016 13:21:32 +0200 Subject: formulate interpret as a Sink --- events/src/Events/Spec.hs | 6 +++--- events/src/Events/Types.hs | 2 ++ events/src/Events/Types/NDT.hs | 4 ++++ 3 files changed, 9 insertions(+), 3 deletions(-) (limited to 'events/src/Events') 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 -- cgit v1.2.3