diff options
Diffstat (limited to 'events/src/Events/Types.hs')
-rw-r--r-- | events/src/Events/Types.hs | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/events/src/Events/Types.hs b/events/src/Events/Types.hs new file mode 100644 index 0000000..55e7a5a --- /dev/null +++ b/events/src/Events/Types.hs | |||
@@ -0,0 +1,59 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | |||
3 | module Events.Types | ||
4 | ( TimeRange(..), rangeStart, rangeDuration | ||
5 | , Event(..), payload, occursWithin | ||
6 | , SpecCtx(..), ctxVars | ||
7 | , Spec | ||
8 | , module Data.Aeson | ||
9 | , module Data.Time.Clock | ||
10 | , module Data.Default.Class | ||
11 | ) where | ||
12 | |||
13 | import Control.Lens.TH | ||
14 | |||
15 | import Data.Aeson (Object) | ||
16 | |||
17 | import Data.Time.Clock | ||
18 | |||
19 | import Control.Monad.Reader | ||
20 | import ListT (ListT) | ||
21 | import qualified ListT as ListT | ||
22 | |||
23 | import Data.Default.Class | ||
24 | |||
25 | import Data.Monoid | ||
26 | import Control.Monad.Fix | ||
27 | import Control.Lens | ||
28 | import Data.Maybe | ||
29 | |||
30 | data TimeRange = TimeRange | ||
31 | { _rangeStart :: UTCTime | ||
32 | , _rangeDuration :: NominalDiffTime | ||
33 | } | ||
34 | makeLenses ''TimeRange | ||
35 | |||
36 | data Event = Event | ||
37 | { _payload :: Object | ||
38 | , _occursWithin :: TimeRange -> Bool | ||
39 | } | ||
40 | makeLenses ''Event | ||
41 | |||
42 | data SpecCtx = SpecCtx | ||
43 | { _ctxVars :: Object | ||
44 | , _ctxEvents :: [Event] | ||
45 | } | ||
46 | makeLenses ''SpecCtx | ||
47 | |||
48 | instance Default SpecCtx where | ||
49 | def = SpecCtx | ||
50 | { _ctxVars = mempty | ||
51 | , _ctxEvents = mempty | ||
52 | } | ||
53 | |||
54 | type Spec m a = ListT (ReaderT SpecCtx m) a | ||
55 | |||
56 | interpret :: MonadFix m => Spec m (Maybe Event) -> m [Event] | ||
57 | interpret x = catMaybes <$> mfix x' | ||
58 | where | ||
59 | x' = runReaderT (ListT.toList x) . flip (set ctxEvents) def . catMaybes | ||