From 9bffd435230514c00177a315bf65d9c13969f7dc Mon Sep 17 00:00:00 2001
From: Gregor Kleen <pngwjpgh@users.noreply.github.com>
Date: Thu, 28 Jul 2016 23:32:02 +0200
Subject: cleanup

---
 events/src/Events/Eval.hs  | 16 ++++++++++++++++
 events/src/Events/Types.hs | 44 ++++++++++++++------------------------------
 2 files changed, 30 insertions(+), 30 deletions(-)
 create mode 100644 events/src/Events/Eval.hs

(limited to 'events/src/Events')

diff --git a/events/src/Events/Eval.hs b/events/src/Events/Eval.hs
new file mode 100644
index 0000000..c5bc134
--- /dev/null
+++ b/events/src/Events/Eval.hs
@@ -0,0 +1,16 @@
+module Events.Eval
+  ( evaluate
+  ) where
+
+import Control.Monad.Fix (MonadFix(mfix))
+
+import Events.Types
+
+import Data.Maybe (catMaybes)
+
+import Control.Lens
+
+evaluate :: MonadFix m => (Maybe Object -> StateT EvalCtx m Bool) -> Eval m () -> m [Object]
+evaluate predicate x = catMaybes <$> mfix x'
+  where
+    x' = evalStateT (foldNDT predicate (preview objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
diff --git a/events/src/Events/Types.hs b/events/src/Events/Types.hs
index 0eff7aa..711e200 100644
--- a/events/src/Events/Types.hs
+++ b/events/src/Events/Types.hs
@@ -4,32 +4,28 @@ module Events.Types
        ( TimeRange(..), rangeStart, rangeDuration
        , Event(..), payload, occursWithin
        , EvalCtx(..), ctxEvents
-       , ObjCtx(..), objVars, objOccurs, objPayload
-       , Eval, evaluate
+       , ObjCtx(..), objVars, objOccurs, objPayload, objCtx
+       , Eval
        , module Data.Aeson
        , module Data.Time.Clock
        , module Data.Default.Class
+       , module Events.Types.NDT
+       , module Control.Monad.State.Lazy
        ) where
 
 import Control.Lens.TH (makeLenses)
+import Control.Lens
   
-import Data.Aeson (Object)
+import Data.Aeson hiding ((.=))
 
-import Data.Time.Clock (UTCTime, NominalDiffTime)
+import Data.Time.Clock
 
-import Control.Monad.State.Lazy (StateT, evalStateT, execStateT)
-
-import Data.Default.Class (Default(def))
-
--- import Data.Monoid
-import Control.Monad.Fix (MonadFix(mfix))
-import Control.Lens ((^.), set)
-import Data.Maybe (catMaybes)
-
--- import Debug.Trace
+import Data.Default.Class
 
 import Events.Types.NDT (NDT, foldNDT)
 
+import Control.Monad.State.Lazy
+
 data TimeRange = TimeRange
                  { _rangeStart :: UTCTime
                  , _rangeDuration :: NominalDiffTime
@@ -66,21 +62,9 @@ instance Default ObjCtx where
         , _objVars = mempty
         }
 
-objCtx :: ObjCtx -> Maybe Object
-objCtx ctx
-  | ctx ^. objOccurs = ctx ^. objPayload
-  | otherwise        = Nothing
-
--- type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a
-
--- evaluate :: MonadFix m => Eval m () -> m [Object] {- TODO: Switch to `ListT m Object` – `m [Object]` will turn out to be to strict. There is no instance for `MonadFix (ListT m)` – writing one seems to be possible. -}
--- evaluate x = catMaybes <$> mfix x'
---   where
---     x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
+objCtx :: Traversal' ObjCtx Object
+objCtx fObj ctx
+  | _objOccurs ctx = traverseOf (objPayload . _Just) fObj ctx
+  | otherwise      = pure ctx
 
 type Eval m a = StateT ObjCtx (NDT (StateT EvalCtx m)) a
-
-evaluate :: MonadFix m => (Maybe Object -> StateT EvalCtx m Bool) -> Eval m () -> m [Object] {- TODO: Switch to `ListT m Object` – `m [Object]` will turn out to be to strict. There is no instance for `MonadFix (ListT m)` – writing one seems to be possible. -}
-evaluate predicate x = catMaybes <$> mfix x'
-  where
-    x' = evalStateT (foldNDT predicate (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
-- 
cgit v1.2.3