Seperated non-value rec. into own layer of state

Fixes lack of fixpoint

1 files changed, 21 insertions, 13 deletions

diff --git a/events/src/Events/Types.hs b/events/src/Events/Types.hs
index 19fccdf..3414b68 100644
--- a/events/src/Events/Types.hs
+++ b/events/src/Events/Types.hs
@@ -6,7 +6,8 @@
 module Events.Types
        ( TimeRange(..), rangeStart, rangeDuration
        , Event(..), payload, occursWithin
-       , EvalCtx(..), ctxVars, ctxEvents, ctxEvent, ctxOccurs
+       , EvalCtx(..), ctxVars, ctxEvents
+       , ObjCtx(..), objOccurs, objPayload
        , Eval, evaluate
        , module Data.Aeson
        , module Data.Time.Clock
@@ -29,7 +30,6 @@ import Data.Monoid
 import Control.Monad.Fix
 import Control.Lens
 import Data.Maybe
-import Data.Bool
 
 import Debug.Trace
 
@@ -48,8 +48,6 @@ makeLenses ''Event
 data EvalCtx = EvalCtx
                { _ctxVars :: Object
                , _ctxEvents :: [Object]
-               , _ctxEvent :: Maybe Object
-               , _ctxOccurs :: Bool
                } deriving (Show)
 makeLenses ''EvalCtx
 
@@ -57,20 +55,30 @@ instance Default EvalCtx where
   def = EvalCtx
         { _ctxVars = mempty
         , _ctxEvents = mempty
-        , _ctxEvent = Nothing
-        , _ctxOccurs = False
         }
 
-type Eval m a = ListT (StateT EvalCtx m) a
+data ObjCtx = ObjCtx
+              { _objOccurs :: Bool
+              , _objPayload :: Maybe Object
+              }
+makeLenses ''ObjCtx
+
+instance Default ObjCtx where
+  def = ObjCtx
+        { _objOccurs = False
+        , _objPayload = Nothing
+        }
+
+objCtx :: ObjCtx -> Maybe Object
+objCtx (ObjCtx False _) = Nothing
+objCtx (ObjCtx True  o) = o
+
+type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a
 
 evaluate :: MonadFix m => Eval m () -> m [Object]
-evaluate x = (^. ctxEvents) <$> mfix x'
+evaluate x = catMaybes <$> mfix x'
   where
-    x' = execStateT (ListT.toList x) . resetState -- flip (set ctxEvents) def . catMaybes
-    resetState = execState $ do
-      ctxEvents <~ bool const (\x y -> x ++ maybe [] pure y) <$> use ctxOccurs <*> use ctxEvents <*> use ctxEvent
-      ctxEvent .= def ^. ctxEvent
-      ctxOccurs .= def ^. ctxOccurs
+    x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
 
 instance MonadState s m => MonadState s (ListT m) where
   get = lift get