diff options
Diffstat (limited to 'events/src/Events/Eval.hs')
-rw-r--r-- | events/src/Events/Eval.hs | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/events/src/Events/Eval.hs b/events/src/Events/Eval.hs index c5bc134..280c577 100644 --- a/events/src/Events/Eval.hs +++ b/events/src/Events/Eval.hs | |||
@@ -1,5 +1,9 @@ | |||
1 | {-# LANGUAGE ViewPatterns #-} | ||
2 | |||
1 | module Events.Eval | 3 | module Events.Eval |
2 | ( evaluate | 4 | ( evaluate |
5 | , ordPredicate | ||
6 | , module Data.Ord | ||
3 | ) where | 7 | ) where |
4 | 8 | ||
5 | import Control.Monad.Fix (MonadFix(mfix)) | 9 | import Control.Monad.Fix (MonadFix(mfix)) |
@@ -10,7 +14,13 @@ import Data.Maybe (catMaybes) | |||
10 | 14 | ||
11 | import Control.Lens | 15 | import Control.Lens |
12 | 16 | ||
13 | evaluate :: MonadFix m => (Maybe Object -> StateT EvalCtx m Bool) -> Eval m () -> m [Object] | 17 | import Data.Ord (Ordering(..)) |
18 | |||
19 | evaluate :: MonadFix m => (Maybe Object -> ReaderT EvalCtx m Bool) -> Eval m () -> m [Object] | ||
14 | evaluate predicate x = catMaybes <$> mfix x' | 20 | evaluate predicate x = catMaybes <$> mfix x' |
15 | where | 21 | where |
16 | x' = evalStateT (foldNDT predicate (preview objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes | 22 | x' = runReaderT (foldNDT predicate (preview objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes |
23 | |||
24 | ordPredicate :: Applicative m => (Object -> Ordering) -> (Maybe Object -> m Bool) | ||
25 | ordPredicate _ Nothing = pure True | ||
26 | ordPredicate f (Just (f -> o)) = pure $ o <= EQ | ||