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