diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,8 @@ Changelog for Extra +1.6.9, released 2018-07-12 + Add loop, the non-monadic version of loopM + #36, add whenMaybe and whenMaybeM 1.6.8, released 2018-05-24 Add notNull Add listDirectories diff --git a/extra.cabal b/extra.cabal --- a/extra.cabal +++ b/extra.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: extra -version: 1.6.8 +version: 1.6.9 license: BSD3 license-file: LICENSE category: Development @@ -15,7 +15,7 @@ The module "Extra" documents all functions provided by this library. Modules such as "Data.List.Extra" provide extra functions over "Data.List" and also reexport "Data.List". Users are recommended to replace "Data.List" imports with "Data.List.Extra" if they need the extra functionality. homepage: https://github.com/ndmitchell/extra#readme bug-reports: https://github.com/ndmitchell/extra/issues -tested-with: GHC==8.4.2, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +tested-with: GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-doc-files: CHANGES.txt diff --git a/src/Control/Monad/Extra.hs b/src/Control/Monad/Extra.hs --- a/src/Control/Monad/Extra.hs +++ b/src/Control/Monad/Extra.hs @@ -2,15 +2,16 @@ -- | Extra functions for "Control.Monad". -- These functions provide looping, list operations and booleans. --- If you need a wider selection of monad loops and list generalisations, --- see . +-- If you need a wider selection of monad loops and list generalisations, +-- see . module Control.Monad.Extra( module Control.Monad, whenJust, whenJustM, + whenMaybe, whenMaybeM, unit, maybeM, eitherM, -- * Loops - loopM, whileM, + loop, loopM, whileM, -- * Lists partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, @@ -36,8 +37,26 @@ -- | Like 'whenJust', but where the test can be monadic. whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m () +-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply Applicative whenJustM mg f = maybe (return ()) f =<< mg + +-- | Like 'when', but return either 'Nothing' if the predicate was 'False', +-- of 'Just' with the result of the computation. +-- +-- > whenMaybe True (print 1) == fmap Just (print 1) +-- > whenMaybe False (print 1) == return Nothing +whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a) +whenMaybe b x = if b then Just <$> x else pure Nothing + +-- | Like 'whenMaybe', but where the test can be monadic. +whenMaybeM :: Monad m => m Bool -> m a -> m (Maybe a) +-- Can't reuse whenMaybe on GHC 7.8 or lower because Monad does not imply Applicative +whenMaybeM mb x = do + b <- mb + if b then liftM Just x else return Nothing + + -- | The identity function which requires the inner argument to be @()@. Useful for functions -- with overloaded return types. -- @@ -106,6 +125,15 @@ -- Looping -- | A looping operation, where the predicate returns 'Left' as a seed for the next loop +-- or 'Right' to abort the loop. +-- +-- > loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16" +loop :: (a -> Either a b) -> a -> b +loop act x = case act x of + Left x -> loop act x + Right v -> v + +-- | A monadic version of 'loop', where the predicate returns 'Left' as a seed for the next loop -- or 'Right' to abort the loop. loopM :: Monad m => (a -> m (Either a b)) -> a -> m b loopM act x = do diff --git a/src/Extra.hs b/src/Extra.hs --- a/src/Extra.hs +++ b/src/Extra.hs @@ -14,7 +14,7 @@ Partial, retry, retryBool, errorWithoutStackTrace, showException, stringException, errorIO, displayException, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool, -- * Control.Monad.Extra -- | Extra functions available in @"Control.Monad.Extra"@. - whenJust, whenJustM, unit, maybeM, eitherM, loopM, whileM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, + whenJust, whenJustM, whenMaybe, whenMaybeM, unit, maybeM, eitherM, loop, loopM, whileM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM, -- * Data.Either.Extra -- | Extra functions available in @"Data.Either.Extra"@. isLeft, isRight, fromLeft, fromRight, fromEither, fromLeft', fromRight', eitherToMaybe, maybeToEither, diff --git a/test/TestGen.hs b/test/TestGen.hs --- a/test/TestGen.hs +++ b/test/TestGen.hs @@ -25,11 +25,14 @@ testGen "retry 3 (fail \"die\") == fail \"die\"" $ retry 3 (fail "die") == fail "die" testGen "whenJust Nothing print == return ()" $ whenJust Nothing print == return () testGen "whenJust (Just 1) print == print 1" $ whenJust (Just 1) print == print 1 + testGen "whenMaybe True (print 1) == fmap Just (print 1)" $ whenMaybe True (print 1) == fmap Just (print 1) + testGen "whenMaybe False (print 1) == return Nothing" $ whenMaybe False (print 1) == return Nothing testGen "\\(x :: Maybe ()) -> unit x == x" $ \(x :: Maybe ()) -> unit x == x testGen "fold1M (\\x y -> Just x) [] == undefined" $ erroneous $ fold1M (\x y -> Just x) [] testGen "fold1M (\\x y -> Just $ x + y) [1, 2, 3] == Just 6" $ fold1M (\x y -> Just $ x + y) [1, 2, 3] == Just 6 testGen "partitionM (Just . even) [1,2,3] == Just ([2], [1,3])" $ partitionM (Just . even) [1,2,3] == Just ([2], [1,3]) testGen "partitionM (const Nothing) [1,2,3] == Nothing" $ partitionM (const Nothing) [1,2,3] == Nothing + testGen "loop (\\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == \"16\"" $ loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16" testGen "Just True ||^ undefined == Just True" $ Just True ||^ undefined == Just True testGen "Just False ||^ Just True == Just True" $ Just False ||^ Just True == Just True testGen "Just False ||^ Just False == Just False" $ Just False ||^ Just False == Just False