blob: 0c2cb228d40e02f23222e32491634c271c8c1f38 (
plain)
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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
-----------------------------------------------------------------------------
-- |
-- Module : Control.Monad.List
-- Copyright : (c) Andy Gill 2001,
-- (c) Oregon Graduate Institute of Science and Technology, 2001
-- License : BSD-style (see the file libraries/core/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : non-portable ( requires mulit-parameter type classes )
--
-- The List monad.
--
-----------------------------------------------------------------------------
module Control.Monad.List (
ListT(..),
runListT,
mapListT,
module Control.Monad,
module Control.Monad.Trans,
) where
import Prelude
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Cont
import Control.Monad.Error
-- ---------------------------------------------------------------------------
-- Our parameterizable list monad, with an inner monad
newtype ListT m a = ListT { runListT :: m [a] }
instance (Monad m) => Functor (ListT m) where
fmap f m = ListT $ do
a <- runListT m
return (map f a)
instance (Monad m) => Monad (ListT m) where
return a = ListT $ return [a]
m >>= k = ListT $ do
a <- runListT m
b <- mapM (runListT . k) a
return (concat b)
fail _ = ListT $ return []
instance (Monad m) => MonadPlus (ListT m) where
mzero = ListT $ return []
m `mplus` n = ListT $ do
a <- runListT m
b <- runListT n
return (a ++ b)
instance MonadTrans ListT where
lift m = ListT $ do
a <- m
return [a]
instance (MonadIO m) => MonadIO (ListT m) where
liftIO = lift . liftIO
instance (MonadReader s m) => MonadReader s (ListT m) where
ask = lift ask
local f m = ListT $ local f (runListT m)
instance (MonadState s m) => MonadState s (ListT m) where
get = lift get
put = lift . put
instance (MonadCont m) => MonadCont (ListT m) where
callCC f = ListT $
callCC $ \c ->
runListT (f (\a -> ListT $ c [a]))
instance (MonadError e m) => MonadError e (ListT m) where
throwError = lift . throwError
m `catchError` h = ListT $ runListT m
`catchError` \e -> runListT (h e)
mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b
mapListT f m = ListT $ f (runListT m)
|
