-- | Maybe functions.

module Data.Maybe
  (-- * General operations from base
  isJust
  ,isNothing
  ,fromJust
  ,fromMaybe
  ,maybeToList
  ,listToMaybe
  ,catMaybes
  ,mapMaybe
  ,mapMaybeFB
  -- * Fay helpers
  ,whenJust
  ,whenJust'
  ,onJust
  ,joinMaybe)
 where

import Prelude

-- ---------------------------------------------------------------------------
-- Functions over Maybe

-- | The 'isJust' function returns 'True' iff its argument is of the
-- form @Just _@.
isJust         :: Maybe a -> Bool
isJust :: Maybe a -> Bool
isJust Maybe a
Nothing = Bool
False
isJust Maybe a
_       = Bool
True

-- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.
isNothing         :: Maybe a -> Bool
isNothing :: Maybe a -> Bool
isNothing Maybe a
Nothing = Bool
True
isNothing Maybe a
_       = Bool
False

-- | The 'fromJust' function extracts the element out of a 'Just' and
-- throws an error if its argument is 'Nothing'.
fromJust          :: Maybe a -> a
fromJust :: Maybe a -> a
fromJust Maybe a
Nothing  = String -> a
forall a. String -> a
error String
"Maybe.fromJust: Nothing" -- yuck
fromJust (Just a
x) = a
x

-- | The 'fromMaybe' function takes a default value and and 'Maybe'
-- value.  If the 'Maybe' is 'Nothing', it returns the default values;
-- otherwise, it returns the value contained in the 'Maybe'.
fromMaybe     :: a -> Maybe a -> a
fromMaybe :: a -> Maybe a -> a
fromMaybe a
d Maybe a
x = case Maybe a
x of {Maybe a
Nothing -> a
d;Just a
v  -> a
v}

-- | The 'maybeToList' function returns an empty list when given
-- 'Nothing' or a singleton list when not given 'Nothing'.
maybeToList            :: Maybe a -> [a]
maybeToList :: Maybe a -> [a]
maybeToList  Maybe a
Nothing   = []
maybeToList  (Just a
x)  = [a
x]

-- | The 'listToMaybe' function returns 'Nothing' on an empty list
-- or @'Just' a@ where @a@ is the first element of the list.
listToMaybe           :: [a] -> Maybe a
listToMaybe :: [a] -> Maybe a
listToMaybe []        =  Maybe a
forall a. Maybe a
Nothing
listToMaybe (a
a:[a]
_)     =  a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | The 'catMaybes' function takes a list of 'Maybe's and returns
-- a list of all the 'Just' values.
catMaybes              :: [Maybe a] -> [a]
catMaybes :: [Maybe a] -> [a]
catMaybes [Maybe a]
ls = [a
x | Just a
x <- [Maybe a]
ls]

-- | The 'mapMaybe' function is a version of 'map' which can throw
-- out elements.  In particular, the functional argument returns
-- something of type @'Maybe' b@.  If this is 'Nothing', no element
-- is added on to the result list.  If it just @'Just' b@, then @b@ is
-- included in the result list.
mapMaybe          :: (a -> Maybe b) -> [a] -> [b]
mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
_ []     = []
mapMaybe a -> Maybe b
f (a
x:[a]
xs) =
 let rs :: [b]
rs = (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs in
 case a -> Maybe b
f a
x of
  Maybe b
Nothing -> [b]
rs
  Just b
r  -> b
rb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
rs

mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r
mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r
mapMaybeFB b -> r -> r
cons a -> Maybe b
f a
x r
next = case a -> Maybe b
f a
x of
  Maybe b
Nothing -> r
next
  Just b
r -> b -> r -> r
cons b
r r
next

-- | Handy alternative to not having forM.
whenJust :: Maybe a -> (a -> Fay ()) -> Fay ()
whenJust :: Maybe a -> (a -> Fay ()) -> Fay ()
whenJust (Just a
x) a -> Fay ()
f = a -> Fay ()
f a
x
whenJust Maybe a
Nothing a -> Fay ()
_ = () -> Fay ()
forall a. a -> Fay a
return ()

-- | Similar to forM again.
whenJust' :: Maybe a -> (a -> Fay b) -> Fay (Maybe b)
whenJust' :: Maybe a -> (a -> Fay b) -> Fay (Maybe b)
whenJust' (Just a
x) a -> Fay b
f = a -> Fay b
f a
x Fay b -> Ptr (b -> Fay (Maybe b)) -> Fay (Maybe b)
forall a b. Ptr (Fay a) -> Ptr (a -> Fay b) -> Fay b
>>= Maybe b -> Fay (Maybe b)
forall a. a -> Fay a
return (Maybe b -> Fay (Maybe b))
-> (b -> Maybe b) -> Ptr (b -> Fay (Maybe b))
forall t1 t t2. (t1 -> t) -> (t2 -> t1) -> t2 -> t
. b -> Maybe b
forall a. a -> Maybe a
Just
whenJust' Maybe a
Nothing a -> Fay b
_ = Maybe b -> Fay (Maybe b)
forall a. a -> Fay a
return Maybe b
forall a. Maybe a
Nothing

-- | Basically fmap for Maybe.
onJust :: (a -> b) -> Maybe a -> Maybe b
onJust :: (a -> b) -> Maybe a -> Maybe b
onJust a -> b
f (Just a
x) = b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
f a
x)
onJust a -> b
_ Maybe a
Nothing = Maybe b
forall a. Maybe a
Nothing

-- | Join for Maybe.
joinMaybe :: Maybe (Maybe a) -> Maybe a
joinMaybe :: Maybe (Maybe a) -> Maybe a
joinMaybe (Just (Just a
x)) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
joinMaybe Maybe (Maybe a)
_ = Maybe a
forall a. Maybe a
Nothing