module Data.Maybe.HT where

import Data.Maybe (fromMaybe, )
import Control.Monad (msum, )

{- $setup
>>> import Control.Monad (guard)
-}

{-
It was proposed as addition to Data.Maybe and rejected at that time.
<http://www.haskell.org/pipermail/libraries/2004-July/002381.html>
-}
{- | Returns 'Just' if the precondition is fulfilled.
prop> \b x ->  (guard b >> x)  ==  (toMaybe b =<< (x::Maybe Char))
-}
{-# INLINE toMaybe #-}
toMaybe :: Bool -> a -> Maybe a
toMaybe :: Bool -> a -> Maybe a
toMaybe Bool
False a
_ = Maybe a
forall a. Maybe a
Nothing
toMaybe Bool
True  a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x


infixl 6 ?->

{- |
This is an infix version of 'fmap'
for writing 'Data.Bool.HT.select' style expressions
using test functions, that produce 'Maybe's.

The precedence is chosen to be higher than '(:)',
in order to allow:

> alternatives default $
>    checkForA ?-> (\a -> f a) :
>    checkForB ?-> (\b -> g b) :
>    []

The operation is left associative
in order to allow to write

> checkForA ?-> f ?-> g

which is equivalent to

> checkForA ?-> g . f

due to the functor law.
-}
(?->) :: Maybe a -> (a -> b) -> Maybe b
?-> :: Maybe a -> (a -> b) -> Maybe b
(?->) = ((a -> b) -> Maybe a -> Maybe b) -> Maybe a -> (a -> b) -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

alternatives :: a -> [Maybe a] -> a
alternatives :: a -> [Maybe a] -> a
alternatives a
deflt = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
deflt (Maybe a -> a) -> ([Maybe a] -> Maybe a) -> [Maybe a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> Maybe a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum