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