1{-# LANGUAGE ConstraintKinds #-}
2
3-- | Extra functions for "Control.Monad".
4--   These functions provide looping, list operations and booleans.
5--   If you need a wider selection of monad loops and list generalisations,
6--   see <https://hackage.haskell.org/package/monad-loops monad-loops>.
7module Control.Monad.Extra(
8    module Control.Monad,
9    whenJust, whenJustM,
10    pureIf,
11    whenMaybe, whenMaybeM,
12    unit,
13    maybeM, fromMaybeM, eitherM,
14    -- * Loops
15    loop, loopM, whileM, whileJustM, untilJustM,
16    -- * Lists
17    partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM,
18    fold1M, fold1M_,
19    -- * Booleans
20    whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM
21    ) where
22
23import Control.Monad
24import Control.Exception.Extra
25import Data.Maybe
26import Control.Applicative
27import Data.Monoid
28import Prelude
29
30-- General utilities
31
32-- | Perform some operation on 'Just', given the field inside the 'Just'.
33--
34-- > whenJust Nothing  print == pure ()
35-- > whenJust (Just 1) print == print 1
36whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
37whenJust mg f = maybe (pure ()) f mg
38
39-- | Like 'whenJust', but where the test can be monadic.
40whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()
41-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply Applicative
42whenJustM mg f = maybeM (pure ()) f mg
43
44-- | Return either a `pure` value if a condition is `True`, otherwise `empty`.
45--
46-- > pureIf @Maybe True  5 == Just 5
47-- > pureIf @Maybe False 5 == Nothing
48-- > pureIf @[]    True  5 == [5]
49-- > pureIf @[]    False 5 == []
50pureIf :: (Alternative m) => Bool -> a -> m a
51pureIf b a = if b then pure a else empty
52
53-- | Like 'when', but return either 'Nothing' if the predicate was 'False',
54--   of 'Just' with the result of the computation.
55--
56-- > whenMaybe True  (print 1) == fmap Just (print 1)
57-- > whenMaybe False (print 1) == pure Nothing
58whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a)
59whenMaybe b x = if b then Just <$> x else pure Nothing
60
61-- | Like 'whenMaybe', but where the test can be monadic.
62whenMaybeM :: Monad m => m Bool -> m a -> m (Maybe a)
63-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply Applicative
64whenMaybeM mb x = do
65    b <- mb
66    if b then liftM Just x else pure Nothing
67
68-- | The identity function which requires the inner argument to be @()@. Useful for functions
69--   with overloaded return types.
70--
71-- > \(x :: Maybe ()) -> unit x == x
72unit :: m () -> m ()
73unit = id
74
75
76-- | Monadic generalisation of 'maybe'.
77maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
78maybeM n j x = maybe n j =<< x
79
80
81-- | Monadic generalisation of 'fromMaybe'.
82fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
83fromMaybeM n x = maybeM n pure x
84
85
86-- | Monadic generalisation of 'either'.
87eitherM :: Monad m => (a -> m c) -> (b -> m c) -> m (Either a b) -> m c
88eitherM l r x = either l r =<< x
89
90-- | A variant of 'foldM' that has no base case, and thus may only be applied to non-empty lists.
91--
92-- > fold1M (\x y -> Just x) [] == undefined
93-- > fold1M (\x y -> Just $ x + y) [1, 2, 3] == Just 6
94fold1M :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m a
95fold1M f (x:xs) = foldM f x xs
96fold1M f xs = error "fold1M: empty list"
97
98-- | Like 'fold1M' but discards the result.
99fold1M_ :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m ()
100fold1M_ f xs = fold1M f xs >> pure ()
101
102
103-- Data.List for Monad
104
105-- | A version of 'partition' that works with a monadic predicate.
106--
107-- > partitionM (Just . even) [1,2,3] == Just ([2], [1,3])
108-- > partitionM (const Nothing) [1,2,3] == Nothing
109partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
110partitionM f [] = pure ([], [])
111partitionM f (x:xs) = do
112    res <- f x
113    (as,bs) <- partitionM f xs
114    pure ([x | res]++as, [x | not res]++bs)
115
116
117-- | A version of 'concatMap' that works with a monadic predicate.
118concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
119{-# INLINE concatMapM #-}
120concatMapM op = foldr f (pure [])
121    where f x xs = do x <- op x; if null x then xs else do xs <- xs; pure $ x++xs
122
123-- | Like 'concatMapM', but has its arguments flipped, so can be used
124--   instead of the common @fmap concat $ forM@ pattern.
125concatForM :: Monad m => [a] -> (a -> m [b]) -> m [b]
126concatForM = flip concatMapM
127
128-- | A version of 'mconcatMap' that works with a monadic predicate.
129mconcatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
130mconcatMapM f = liftM mconcat . mapM f
131
132-- | A version of 'mapMaybe' that works with a monadic predicate.
133mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
134{-# INLINE mapMaybeM #-}
135mapMaybeM op = foldr f (pure [])
136    where f x xs = do x <- op x; case x of Nothing -> xs; Just x -> do xs <- xs; pure $ x:xs
137
138-- Looping
139
140-- | A looping operation, where the predicate returns 'Left' as a seed for the next loop
141--   or 'Right' to abort the loop.
142--
143-- > loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16"
144loop :: (a -> Either a b) -> a -> b
145loop act x = case act x of
146    Left x -> loop act x
147    Right v -> v
148
149-- | A monadic version of 'loop', where the predicate returns 'Left' as a seed for the next loop
150--   or 'Right' to abort the loop.
151loopM :: Monad m => (a -> m (Either a b)) -> a -> m b
152loopM act x = do
153    res <- act x
154    case res of
155        Left x -> loopM act x
156        Right v -> pure v
157
158-- | Keep running an operation until it becomes 'False'. As an example:
159--
160-- @
161-- whileM $ do sleep 0.1; notM $ doesFileExist "foo.txt"
162-- readFile "foo.txt"
163-- @
164--
165--   If you need some state persisted between each test, use 'loopM'.
166whileM :: Monad m => m Bool -> m ()
167whileM act = do
168    b <- act
169    when b $ whileM act
170
171-- | Keep running an operation until it becomes a 'Nothing', accumulating the
172--   monoid results inside the 'Just's as the result of the overall loop.
173whileJustM :: (Monad m, Monoid a) => m (Maybe a) -> m a
174whileJustM act = go mempty
175  where
176    go accum = do
177        res <- act
178        case res of
179            Nothing -> pure accum
180            Just r -> go $! (accum <> r) -- strict apply, otherwise space leaks
181
182-- | Keep running an operation until it becomes a 'Just', then return the value
183--   inside the 'Just' as the result of the overall loop.
184untilJustM :: Monad m => m (Maybe a) -> m a
185untilJustM act = do
186    res <- act
187    case res of
188        Just r  -> pure r
189        Nothing -> untilJustM act
190
191-- Booleans
192
193-- | Like 'when', but where the test can be monadic.
194whenM :: Monad m => m Bool -> m () -> m ()
195whenM b t = ifM b t (pure ())
196
197-- | Like 'unless', but where the test can be monadic.
198unlessM :: Monad m => m Bool -> m () -> m ()
199unlessM b f = ifM b (pure ()) f
200
201-- | Like @if@, but where the test can be monadic.
202ifM :: Monad m => m Bool -> m a -> m a -> m a
203ifM b t f = do b <- b; if b then t else f
204
205-- | Like 'not', but where the test can be monadic.
206notM :: Functor m => m Bool -> m Bool
207notM = fmap not
208
209-- | The lazy '||' operator lifted to a monad. If the first
210--   argument evaluates to 'True' the second argument will not
211--   be evaluated.
212--
213-- > Just True  ||^ undefined  == Just True
214-- > Just False ||^ Just True  == Just True
215-- > Just False ||^ Just False == Just False
216(||^) :: Monad m => m Bool -> m Bool -> m Bool
217(||^) a b = ifM a (pure True) b
218
219-- | The lazy '&&' operator lifted to a monad. If the first
220--   argument evaluates to 'False' the second argument will not
221--   be evaluated.
222--
223-- > Just False &&^ undefined  == Just False
224-- > Just True  &&^ Just True  == Just True
225-- > Just True  &&^ Just False == Just False
226(&&^) :: Monad m => m Bool -> m Bool -> m Bool
227(&&^) a b = ifM a b (pure False)
228
229-- | A version of 'any' lifted to a monad. Retains the short-circuiting behaviour.
230--
231-- > anyM Just [False,True ,undefined] == Just True
232-- > anyM Just [False,False,undefined] == undefined
233-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)
234anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
235anyM p = foldr ((||^) . p) (pure False)
236
237-- | A version of 'all' lifted to a monad. Retains the short-circuiting behaviour.
238--
239-- > allM Just [True,False,undefined] == Just False
240-- > allM Just [True,True ,undefined] == undefined
241-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)
242allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
243allM p = foldr ((&&^) . p) (pure True)
244
245-- | A version of 'or' lifted to a monad. Retains the short-circuiting behaviour.
246--
247-- > orM [Just False,Just True ,undefined] == Just True
248-- > orM [Just False,Just False,undefined] == undefined
249-- > \xs -> Just (or xs) == orM (map Just xs)
250orM :: Monad m => [m Bool] -> m Bool
251orM = anyM id
252
253-- | A version of 'and' lifted to a monad. Retains the short-circuiting behaviour.
254--
255-- > andM [Just True,Just False,undefined] == Just False
256-- > andM [Just True,Just True ,undefined] == undefined
257-- > \xs -> Just (and xs) == andM (map Just xs)
258andM :: Monad m => [m Bool] -> m Bool
259andM = allM id
260
261-- Searching
262
263-- | Like 'find', but where the test can be monadic.
264--
265-- > findM (Just . isUpper) "teST"             == Just (Just 'S')
266-- > findM (Just . isUpper) "test"             == Just Nothing
267-- > findM (Just . const True) ["x",undefined] == Just (Just "x")
268findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
269findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
270
271-- | Like 'findM', but also allows you to compute some additional information in the predicate.
272firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
273firstJustM p [] = pure Nothing
274firstJustM p (x:xs) = maybeM (firstJustM p xs) (pure . Just) (p x)
275