Copyright | (c) 2016 Stephen Diehl (c) 2016-2018 Serokell (c) 2018-2020 Kowainik |
---|---|
License | MIT |
Maintainer | Kowainik <xrom.xkov@gmail.com> |
Stability | Stable |
Portability | Portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Monadic boolean combinators.
Synopsis
- guarded :: Alternative f => (a -> Bool) -> a -> f a
- guardM :: MonadPlus m => m Bool -> m ()
- ifM :: Monad m => m Bool -> m a -> m a -> m a
- unlessM :: Monad m => m Bool -> m () -> m ()
- whenM :: Monad m => m Bool -> m () -> m ()
- (&&^) :: Monad m => m Bool -> m Bool -> m Bool
- (||^) :: Monad m => m Bool -> m Bool -> m Bool
Documentation
guarded :: Alternative f => (a -> Bool) -> a -> f a Source #
Either lifts a value into an alternative context or gives a minimal value depending on a predicate.
>>>
guarded even 3 :: [Int]
[]>>>
guarded even 2 :: [Int]
[2]>>>
guarded (const True) "hello" :: Maybe String
Just "hello">>>
guarded (const False) "world" :: Maybe String
Nothing
You can use this function to implement smart constructors simpler:
newtype HttpHost = HttpHost
{ unHttpHost :: Text
}
mkHttpHost :: Text -> Maybe HttpHost
mkHttpHost host = HttpHost <$> guarded
(not . Text.null) host
Since: 0.6.0.0
guardM :: MonadPlus m => m Bool -> m () Source #
Monadic version of guard
. Occasionally useful.
Here some complex but real-life example:
findSomePath :: IO (Maybe FilePath) somePath :: MaybeT IO FilePath somePath = do path <- MaybeT findSomePath guardM $ liftIO $ doesDirectoryExist path return path
ifM :: Monad m => m Bool -> m a -> m a -> m a Source #
Monadic version of if-then-else
.
>>>
ifM (pure True) (putTextLn "True text") (putTextLn "False text")
True text
unlessM :: Monad m => m Bool -> m () -> m () Source #
Monadic version of unless
.
>>>
unlessM (pure False) $ putTextLn "No text :("
No text :(>>>
unlessM (pure True) $ putTextLn "Yes text :)"
whenM :: Monad m => m Bool -> m () -> m () Source #
Monadic version of when
.
>>>
whenM (pure False) $ putTextLn "No text :("
>>>
whenM (pure True) $ putTextLn "Yes text :)"
Yes text :)>>>
whenM (Just True) (pure ())
Just ()>>>
whenM (Just False) (pure ())
Just ()>>>
whenM Nothing (pure ())
Nothing
(&&^) :: Monad m => m Bool -> m Bool -> m Bool Source #
Monadic version of 'Data.Bool.(&&)' operator.
>>>
Just False &&^ Just True
Just False>>>
Just True &&^ Just True
Just True>>>
Just True &&^ Nothing
Nothing>>>
Just False &&^ Nothing
Just False>>>
Just False &&^ error "Shouldn't be evaluated"
Just False
Since: 0.4.0
(||^) :: Monad m => m Bool -> m Bool -> m Bool Source #
Monadic version of 'Data.Bool.(||)' operator.
>>>
Just False ||^ Just True
Just True>>>
Just False ||^ Just False
Just False>>>
Just False ||^ Nothing
Nothing>>>
Just True ||^ Nothing
Just True>>>
Just True ||^ error "Shouldn't be evaluated"
Just True
Since: 0.4.0