diff options
| author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-08-05 13:24:30 +0200 | 
|---|---|---|
| committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-08-05 13:24:30 +0200 | 
| commit | c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec (patch) | |
| tree | d02da42f3833aeb02b9d15f2d4a08d18af2f20a1 | |
| parent | f5311120a05081ee67de73057f1057e6f54b40e2 (diff) | |
| download | events-c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec.tar events-c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec.tar.gz events-c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec.tar.bz2 events-c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec.tar.xz events-c5147d03e9f460f8ac8abfec2f5fe48bb2f9a5ec.zip  | |
linting
| -rw-r--r-- | events/src/Events/Types/NDT.hs | 12 | 
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 | |||
| 15 | import Data.Foldable (foldr) | 14 | import Data.Foldable (foldr) | 
| 16 | import Data.Maybe | 15 | import Data.Maybe | 
| 17 | import Data.Either | 16 | import Data.Either | 
| 17 | import Data.Bool (bool) | ||
| 18 | 18 | ||
| 19 | import Control.Applicative (Alternative) | 19 | import Control.Applicative (Alternative) | 
| 20 | import qualified Control.Applicative as Alt (Alternative(..)) | 20 | import qualified Control.Applicative as Alt (Alternative(..)) | 
| @@ -41,7 +41,7 @@ instance Functor m => Functor (NDT m) where | |||
| 41 | 41 | ||
| 42 | instance Applicative m => Applicative (NDT m) where | 42 | instance 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 | ||
| 46 | instance Applicative m => Monad (NDT m) where | 46 | instance 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 | ||
| 57 | instance MonadTrans NDT where | 57 | instance MonadTrans NDT where | 
| 58 | lift = NDTCons . fmap Just . fmap (,empty) | 58 | lift = NDTCons . fmap (Just . (, empty)) | 
| 59 | 59 | ||
| 60 | instance Monad m => Alternative (NDT m) where | 60 | instance 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 | ||
| 96 | foldNDT sel (NDTBind (NDTCons x) f) = do | 92 | foldNDT sel (NDTBind (NDTCons x) f) = do | 
| 97 | x' <- x | 93 | x' <- x | 
| 98 | case x' of | 94 | case x' of | 
