summaryrefslogtreecommitdiff
path: root/events/src/Events/Types/NDT.hs
diff options
context:
space:
mode:
Diffstat (limited to 'events/src/Events/Types/NDT.hs')
-rw-r--r--events/src/Events/Types/NDT.hs12
1 files changed, 4 insertions, 8 deletions
diff --git a/events/src/Events/Types/NDT.hs b/events/src/Events/Types/NDT.hs
index 848ad39..a417029 100644
--- a/events/src/Events/Types/NDT.hs
+++ b/events/src/Events/Types/NDT.hs
@@ -1,6 +1,5 @@
1{-# LANGUAGE GADTs #-} 1{-# LANGUAGE GADTs #-}
2{-# LANGUAGE TupleSections #-} 2{-# LANGUAGE TupleSections #-}
3{-# LANGUAGE ViewPatterns #-}
4{-# LANGUAGE FlexibleContexts, FlexibleInstances #-} 3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
5{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} 4{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
6 5
@@ -15,6 +14,7 @@ import Data.Monoid
15import Data.Foldable (foldr) 14import Data.Foldable (foldr)
16import Data.Maybe 15import Data.Maybe
17import Data.Either 16import Data.Either
17import Data.Bool (bool)
18 18
19import Control.Applicative (Alternative) 19import Control.Applicative (Alternative)
20import qualified Control.Applicative as Alt (Alternative(..)) 20import qualified Control.Applicative as Alt (Alternative(..))
@@ -41,7 +41,7 @@ instance Functor m => Functor (NDT m) where
41 41
42instance Applicative m => Applicative (NDT m) where 42instance Applicative m => Applicative (NDT m) where
43 pure x = NDTCons . pure $ Just (x, empty) 43 pure x = NDTCons . pure $ Just (x, empty)
44 fs <*> xs = fs >>= (\f -> xs >>= pure . (f $)) 44 fs <*> xs = fs >>= (\f -> xs >>= pure . f)
45 45
46instance Applicative m => Monad (NDT m) where 46instance Applicative m => Monad (NDT m) where
47 return = pure 47 return = pure
@@ -55,7 +55,7 @@ instance Monad m => Monoid (NDT m a) where
55 mappend x y@(NDTBind _ _) = NDTBind x return <> y 55 mappend x y@(NDTBind _ _) = NDTBind x return <> y
56 56
57instance MonadTrans NDT where 57instance MonadTrans NDT where
58 lift = NDTCons . fmap Just . fmap (,empty) 58 lift = NDTCons . fmap (Just . (, empty))
59 59
60instance Monad m => Alternative (NDT m) where 60instance Monad m => Alternative (NDT m) where
61 empty = mempty 61 empty = mempty
@@ -88,11 +88,7 @@ foldNDT sel (NDTCons mx) = do
88 mx' <- mx 88 mx' <- mx
89 case mx' of 89 case mx' of
90 Nothing -> return mempty 90 Nothing -> return mempty
91 Just (x, mxs) -> do 91 Just (x, mxs) -> bool (return mempty) ((pure x <>) <$> foldNDT sel mxs) =<< sel x
92 continue <- sel x
93 case continue of
94 False -> return mempty
95 True -> (pure x <>) <$> foldNDT sel mxs
96foldNDT sel (NDTBind (NDTCons x) f) = do 92foldNDT sel (NDTBind (NDTCons x) f) = do
97 x' <- x 93 x' <- x
98 case x' of 94 case x' of