events/src/Events/Eval.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

{-# LANGUAGE ViewPatterns #-}

module Events.Eval
  ( evaluate
  , ordPredicate
  , module Data.Ord
  ) where

import Control.Monad.Fix (MonadFix(mfix))

import Events.Types

import Data.Maybe (catMaybes)

import Control.Lens

import Data.Ord (Ordering(..))

evaluate :: MonadFix m => (Maybe Object -> ReaderT EvalCtx m Bool) -> Eval m () -> m [Object]
evaluate predicate (unEval -> x) = catMaybes <$> mfix x'
  where
    x' = runReaderT (foldNDT predicate (preview objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes

ordPredicate :: Applicative m => (Object -> Ordering) -> (Maybe Object -> m Bool)
ordPredicate _  Nothing        = pure True
ordPredicate f (Just (f -> o)) = pure $ o <= EQ