summaryrefslogtreecommitdiff
path: root/events/src/Events
diff options
context:
space:
mode:
authorGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-28 23:32:02 +0200
committerGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-28 23:32:02 +0200
commit9bffd435230514c00177a315bf65d9c13969f7dc (patch)
tree07dda740f6a3e130233c0e0940ae2f4b954b8103 /events/src/Events
parentb2e4264e7849f322cbb2bb592b15d2ea7aec9149 (diff)
downloadevents-9bffd435230514c00177a315bf65d9c13969f7dc.tar
events-9bffd435230514c00177a315bf65d9c13969f7dc.tar.gz
events-9bffd435230514c00177a315bf65d9c13969f7dc.tar.bz2
events-9bffd435230514c00177a315bf65d9c13969f7dc.tar.xz
events-9bffd435230514c00177a315bf65d9c13969f7dc.zip
cleanup
Diffstat (limited to 'events/src/Events')
-rw-r--r--events/src/Events/Eval.hs16
-rw-r--r--events/src/Events/Types.hs44
2 files changed, 30 insertions, 30 deletions
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 @@
1module Events.Eval
2 ( evaluate
3 ) where
4
5import Control.Monad.Fix (MonadFix(mfix))
6
7import Events.Types
8
9import Data.Maybe (catMaybes)
10
11import Control.Lens
12
13evaluate :: MonadFix m => (Maybe Object -> StateT EvalCtx m Bool) -> Eval m () -> m [Object]
14evaluate predicate x = catMaybes <$> mfix x'
15 where
16 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
4 ( TimeRange(..), rangeStart, rangeDuration 4 ( TimeRange(..), rangeStart, rangeDuration
5 , Event(..), payload, occursWithin 5 , Event(..), payload, occursWithin
6 , EvalCtx(..), ctxEvents 6 , EvalCtx(..), ctxEvents
7 , ObjCtx(..), objVars, objOccurs, objPayload 7 , ObjCtx(..), objVars, objOccurs, objPayload, objCtx
8 , Eval, evaluate 8 , Eval
9 , module Data.Aeson 9 , module Data.Aeson
10 , module Data.Time.Clock 10 , module Data.Time.Clock
11 , module Data.Default.Class 11 , module Data.Default.Class
12 , module Events.Types.NDT
13 , module Control.Monad.State.Lazy
12 ) where 14 ) where
13 15
14import Control.Lens.TH (makeLenses) 16import Control.Lens.TH (makeLenses)
17import Control.Lens
15 18
16import Data.Aeson (Object) 19import Data.Aeson hiding ((.=))
17 20
18import Data.Time.Clock (UTCTime, NominalDiffTime) 21import Data.Time.Clock
19 22
20import Control.Monad.State.Lazy (StateT, evalStateT, execStateT) 23import Data.Default.Class
21
22import Data.Default.Class (Default(def))
23
24-- import Data.Monoid
25import Control.Monad.Fix (MonadFix(mfix))
26import Control.Lens ((^.), set)
27import Data.Maybe (catMaybes)
28
29-- import Debug.Trace
30 24
31import Events.Types.NDT (NDT, foldNDT) 25import Events.Types.NDT (NDT, foldNDT)
32 26
27import Control.Monad.State.Lazy
28
33data TimeRange = TimeRange 29data TimeRange = TimeRange
34 { _rangeStart :: UTCTime 30 { _rangeStart :: UTCTime
35 , _rangeDuration :: NominalDiffTime 31 , _rangeDuration :: NominalDiffTime
@@ -66,21 +62,9 @@ instance Default ObjCtx where
66 , _objVars = mempty 62 , _objVars = mempty
67 } 63 }
68 64
69objCtx :: ObjCtx -> Maybe Object 65objCtx :: Traversal' ObjCtx Object
70objCtx ctx 66objCtx fObj ctx
71 | ctx ^. objOccurs = ctx ^. objPayload 67 | _objOccurs ctx = traverseOf (objPayload . _Just) fObj ctx
72 | otherwise = Nothing 68 | otherwise = pure ctx
73
74-- type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a
75
76-- 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. -}
77-- evaluate x = catMaybes <$> mfix x'
78-- where
79-- x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes
80 69
81type Eval m a = StateT ObjCtx (NDT (StateT EvalCtx m)) a 70type Eval m a = StateT ObjCtx (NDT (StateT EvalCtx m)) a
82
83evaluate :: 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. -}
84evaluate predicate x = catMaybes <$> mfix x'
85 where
86 x' = evalStateT (foldNDT predicate (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes