e87fb0c585e6e3ab1e933efd8dc65dd7f7c02425
[packages/transformers.git] / Control / Monad / Trans / List.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 710
6 {-# LANGUAGE AutoDeriveTypeable #-}
7 #endif
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Control.Monad.Trans.List
11 -- Copyright : (c) Andy Gill 2001,
12 -- (c) Oregon Graduate Institute of Science and Technology, 2001
13 -- License : BSD-style (see the file LICENSE)
14 --
15 -- Maintainer : R.Paterson@city.ac.uk
16 -- Stability : experimental
17 -- Portability : portable
18 --
19 -- The ListT monad transformer, adding backtracking to a given monad,
20 -- which must be commutative.
21 -----------------------------------------------------------------------------
22
23 module Control.Monad.Trans.List
24 {-# DEPRECATED "This transformer is invalid on most monads" #-} (
25 -- * The ListT monad transformer
26 ListT(..),
27 mapListT,
28 -- * Lifting other operations
29 liftCallCC,
30 liftCatch,
31 ) where
32
33 import Control.Monad.IO.Class
34 import Control.Monad.Signatures
35 import Control.Monad.Trans.Class
36 import Data.Functor.Classes
37
38 import Control.Applicative
39 import Control.Monad
40 #if MIN_VERSION_base(4,9,0)
41 import qualified Control.Monad.Fail as Fail
42 #endif
43 #if MIN_VERSION_base(4,4,0)
44 import Control.Monad.Zip (MonadZip(mzipWith))
45 #endif
46 import Data.Foldable (Foldable(foldMap))
47 import Data.Traversable (Traversable(traverse))
48
49 -- | Parameterizable list monad, with an inner monad.
50 --
51 -- /Note:/ this does not yield a monad unless the argument monad is commutative.
52 newtype ListT m a = ListT { runListT :: m [a] }
53
54 instance (Eq1 m) => Eq1 (ListT m) where
55 liftEq eq (ListT x) (ListT y) = liftEq (liftEq eq) x y
56 {-# INLINE liftEq #-}
57
58 instance (Ord1 m) => Ord1 (ListT m) where
59 liftCompare comp (ListT x) (ListT y) = liftCompare (liftCompare comp) x y
60 {-# INLINE liftCompare #-}
61
62 instance (Read1 m) => Read1 (ListT m) where
63 liftReadsPrec rp rl = readsData $
64 readsUnaryWith (liftReadsPrec rp' rl') "ListT" ListT
65 where
66 rp' = liftReadsPrec rp rl
67 rl' = liftReadList rp rl
68
69 instance (Show1 m) => Show1 (ListT m) where
70 liftShowsPrec sp sl d (ListT m) =
71 showsUnaryWith (liftShowsPrec sp' sl') "ListT" d m
72 where
73 sp' = liftShowsPrec sp sl
74 sl' = liftShowList sp sl
75
76 instance (Eq1 m, Eq a) => Eq (ListT m a) where (==) = eq1
77 instance (Ord1 m, Ord a) => Ord (ListT m a) where compare = compare1
78 instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsPrec1
79 instance (Show1 m, Show a) => Show (ListT m a) where showsPrec = showsPrec1
80
81 -- | Map between 'ListT' computations.
82 --
83 -- * @'runListT' ('mapListT' f m) = f ('runListT' m)@
84 mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b
85 mapListT f m = ListT $ f (runListT m)
86 {-# INLINE mapListT #-}
87
88 instance (Functor m) => Functor (ListT m) where
89 fmap f = mapListT $ fmap $ map f
90 {-# INLINE fmap #-}
91
92 instance (Foldable f) => Foldable (ListT f) where
93 foldMap f (ListT a) = foldMap (foldMap f) a
94 {-# INLINE foldMap #-}
95
96 instance (Traversable f) => Traversable (ListT f) where
97 traverse f (ListT a) = ListT <$> traverse (traverse f) a
98 {-# INLINE traverse #-}
99
100 instance (Applicative m) => Applicative (ListT m) where
101 pure a = ListT $ pure [a]
102 {-# INLINE pure #-}
103 f <*> v = ListT $ (<*>) <$> runListT f <*> runListT v
104 {-# INLINE (<*>) #-}
105
106 instance (Applicative m) => Alternative (ListT m) where
107 empty = ListT $ pure []
108 {-# INLINE empty #-}
109 m <|> n = ListT $ (++) <$> runListT m <*> runListT n
110 {-# INLINE (<|>) #-}
111
112 instance (Monad m) => Monad (ListT m) where
113 #if !(MIN_VERSION_base(4,8,0))
114 return a = ListT $ return [a]
115 {-# INLINE return #-}
116 #endif
117 m >>= k = ListT $ do
118 a <- runListT m
119 b <- mapM (runListT . k) a
120 return (concat b)
121 {-# INLINE (>>=) #-}
122 fail _ = ListT $ return []
123 {-# INLINE fail #-}
124
125 #if MIN_VERSION_base(4,9,0)
126 instance (Monad m) => Fail.MonadFail (ListT m) where
127 fail _ = ListT $ return []
128 {-# INLINE fail #-}
129 #endif
130
131 instance (Monad m) => MonadPlus (ListT m) where
132 mzero = ListT $ return []
133 {-# INLINE mzero #-}
134 m `mplus` n = ListT $ do
135 a <- runListT m
136 b <- runListT n
137 return (a ++ b)
138 {-# INLINE mplus #-}
139
140 instance MonadTrans ListT where
141 lift m = ListT $ do
142 a <- m
143 return [a]
144 {-# INLINE lift #-}
145
146 instance (MonadIO m) => MonadIO (ListT m) where
147 liftIO = lift . liftIO
148 {-# INLINE liftIO #-}
149
150 #if MIN_VERSION_base(4,4,0)
151 instance (MonadZip m) => MonadZip (ListT m) where
152 mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b
153 {-# INLINE mzipWith #-}
154 #endif
155
156 -- | Lift a @callCC@ operation to the new monad.
157 liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b
158 liftCallCC callCC f = ListT $
159 callCC $ \ c ->
160 runListT (f (\ a -> ListT $ c [a]))
161 {-# INLINE liftCallCC #-}
162
163 -- | Lift a @catchE@ operation to the new monad.
164 liftCatch :: Catch e m [a] -> Catch e (ListT m) a
165 liftCatch catchE m h = ListT $ runListT m
166 `catchE` \ e -> runListT (h e)
167 {-# INLINE liftCatch #-}