From 10be4c21eba0c4df2d2cf03f2d5adb547fb08e0a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <pngwjpgh@users.noreply.github.com>
Date: Fri, 5 Aug 2016 12:36:29 +0200
Subject: cleanup

---
 events/src/Events/Spec.hs       | 24 +++++++++---------------
 events/src/Events/Spec/Eval.hs  | 23 -----------------------
 events/src/Events/Spec/Types.hs | 35 +++++++++++++++++++++++++++++------
 3 files changed, 38 insertions(+), 44 deletions(-)

diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs
index c2a84ac..f0b1456 100644
--- a/events/src/Events/Spec.hs
+++ b/events/src/Events/Spec.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Events.Spec
        ( interpret
-       , Spec, Cmnd(..), Expr(..), Elem(..)
+       , Spec, Expr(..), Elem(..)
        , module Events.Spec.Parse
        , module Events.Spec.Eval
        ) where
@@ -12,20 +12,14 @@ import Events.Spec.Eval
 
 import Events.Spec.Parse
 
-import Control.Monad ((<=<))
-import Control.Monad.IO.Class
-import Control.Monad.State.Lazy
 
-import Data.Monoid
-import Data.Foldable
-import Control.Lens
+import Data.Conduit
 
-import Debug.Trace
+import Data.Text (Text)
+import qualified Data.Text as T
 
-interpret :: MonadIO m => Spec m -> Eval m ()
-interpret = join . fmap interpretCmnd . evalExpr
+import Control.Monad.Catch (MonadThrow)
 
-interpretCmnd :: MonadIO m => Cmnd -> Eval m ()
-interpretCmnd (COverride obj) = objPayload ?= obj
-interpretCmnd (COccurs b)     = objOccurs .= b
-interpretCmnd _               = return ()
+
+interpret :: MonadThrow m => Producer m Text -> Eval m ()
+interpret source = evalExpr =<< lift (connect source parse)
diff --git a/events/src/Events/Spec/Eval.hs b/events/src/Events/Spec/Eval.hs
index 9cfb7c1..fdc18c8 100644
--- a/events/src/Events/Spec/Eval.hs
+++ b/events/src/Events/Spec/Eval.hs
@@ -1,10 +1,7 @@
 {-# LANGUAGE GADTs, DataKinds, TypeFamilies, TypeOperators, RankNTypes, ScopedTypeVariables #-}
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-{-# LANGUAGE InstanceSigs #-}
 
 module Events.Spec.Eval
   ( evalExpr
-  , Bindable(..) 
   ) where
 
 import Events.Spec.Types
@@ -42,23 +39,3 @@ evalExpr (EVal a)                 = a
 evalExpr (ELam a)                 = a
 evalExpr (EApp (ELam (EPri f)) a) = evalExpr . f $ evalExpr a
 evalExpr (EApp f a)               = evalExpr $ beta a (evalExpr f)
-
-type family Ctx m f where
-  Ctx m (m a -> b) = (a ': Ctx m b)
-  Ctx m a = '[]
-
-type family Fin m f where
-  Fin m (m a -> b) = Fin m b
-  Fin m (m a) = a
-  Fin m a = a
-
-class Bindable m b where
-  liftE :: (Val m a -> b) -> Expr m (a ': Ctx m b) (Fin m b)
-
-instance ((Val m b) ~ (m b), Applicative m, Bindable m c) => Bindable m (m b -> c) where
-  liftE :: (Val m a -> m b -> c) -> Expr m (a ': b ': Ctx m c) (Fin m c)
-  liftE f = (EPri :: (Val m a -> Expr m (b ': Ctx m c) (Fin m c)) -> Expr m (a ': b ': Ctx m c) (Fin m c)) . ((liftE :: (Val m b -> c) -> Expr m (b ': Ctx m c) (Fin m c)) . ) $ f
-
-instance {-# OVERLAPPABLE #-} (Val m b ~ m b, Ctx m (m b) ~ '[], Fin m (m b) ~ b) => Bindable m (m b) where
-  liftE :: (Val m a -> Val m b) -> Expr m '[a] b
-  liftE = EPri . (EVal .)
diff --git a/events/src/Events/Spec/Types.hs b/events/src/Events/Spec/Types.hs
index c7fd058..af99f55 100644
--- a/events/src/Events/Spec/Types.hs
+++ b/events/src/Events/Spec/Types.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE GADTs, DataKinds, PolyKinds, TypeOperators, KindSignatures, TypeFamilies, ExplicitNamespaces #-}
+{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 
 module Events.Spec.Types
   ( Expr(..)
   , Val(..)
+  , Bindable(..)
   , Spec
-  , Cmnd(..)
   , Elem(..)
   , Length(..)
   , type (++)(..)
@@ -26,12 +28,33 @@ type family Val m a where
   Val m (a -> b) = Expr m '[a] b
   Val m a        = m a
 
-type Spec m = Expr (Eval m) '[] Cmnd
+type family Ctx m f where
+  Ctx m (m a -> b) = (a ': Ctx m b)
+  Ctx m a = '[]
+
+type family Fin m f where
+  Fin m (m a -> b) = Fin m b
+  Fin m (m a) = a
+  Fin m a = a
+
+class Bindable m a where
+  liftE :: a -> Expr m (Ctx m a) (Fin m a)
+
+instance (Val m a ~ m a, Bindable m b) => Bindable m (m a -> b) where
+  liftE :: (m a -> b) -> Expr m (a ': Ctx m b) (Fin m b)
+  liftE = (EPri :: (Val m a -> Expr m (Ctx m b) (Fin m b)) -> Expr m (a ': Ctx m b) (Fin m b)) . ((liftE :: b -> Expr m (Ctx m b) (Fin m b)) . )
+
+instance {-# OVERLAPPABLE #-} (Val m a ~ m a, Val m b ~ m b, Ctx m (m b) ~ '[], Fin m (m b) ~ b) => Bindable m (m a -> m b) where
+  liftE :: (m a -> m b) -> Expr m '[a] b
+  liftE = EPri . (EVal .)
+
+instance (Val m a ~ m a, Fin m (m a) ~ a, Ctx m (m a) ~ '[]) => Bindable m (m a) where
+  liftE :: m a -> Expr m '[] a
+  liftE = EVal
+
+
+type Spec m = Expr (Eval m) '[] ()
 
-data Cmnd = COverride Object
-          | COccurs Bool
-          | CNop
-          deriving (Show)
 
 data Elem :: a -> [a] -> * where
   EZ :: Elem x (x ': xs)
-- 
cgit v1.2.3