{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}

module GHC.Data.Maybe (
        module Data.Maybe,

        MaybeErr(..), -- Instance of Monad
        failME, isSuccess,

        orElse,
        firstJust, firstJusts, firstJustsM,
        whenIsJust,
        expectJust,
        rightToMaybe,

        -- * MaybeT
        MaybeT(..), liftMaybeT, tryMaybeT
    ) where

import GHC.Prelude
import GHC.IO (catchException)

import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Exception (SomeException(..))
import Data.Maybe
import Data.Foldable ( foldlM, for_ )
import GHC.Utils.Misc (HasDebugCallStack)
import Data.List.NonEmpty ( NonEmpty )
import Control.Applicative( Alternative( (<|>) ) )

infixr 4 `orElse`

{-
************************************************************************
*                                                                      *
\subsection[Maybe type]{The @Maybe@ type}
*                                                                      *
************************************************************************
-}

firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust :: forall a. Maybe a -> Maybe a -> Maybe a
firstJust = Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
-- @Nothing@ otherwise.
firstJusts :: Foldable f => f (Maybe a) -> Maybe a
firstJusts :: forall (f :: * -> *) a. Foldable f => f (Maybe a) -> Maybe a
firstJusts = f (Maybe a) -> Maybe a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
{-# SPECIALISE firstJusts :: [Maybe a] -> Maybe a #-}
{-# SPECIALISE firstJusts :: NonEmpty (Maybe a) -> Maybe a #-}

-- | Takes computations returnings @Maybes@; tries each one in order.
-- The first one to return a @Just@ wins. Returns @Nothing@ if all computations
-- return @Nothing@.
firstJustsM :: (Monad m, Foldable f) => f (m (Maybe a)) -> m (Maybe a)
firstJustsM :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f (m (Maybe a)) -> m (Maybe a)
firstJustsM = (Maybe a -> m (Maybe a) -> m (Maybe a))
-> Maybe a -> f (m (Maybe a)) -> m (Maybe a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Maybe a -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
Maybe a -> m (Maybe a) -> m (Maybe a)
go Maybe a
forall a. Maybe a
Nothing where
  go :: Monad m => Maybe a -> m (Maybe a) -> m (Maybe a)
  go :: forall (m :: * -> *) a.
Monad m =>
Maybe a -> m (Maybe a) -> m (Maybe a)
go Maybe a
Nothing         m (Maybe a)
action  = m (Maybe a)
action
  go result :: Maybe a
result@(Just a
_) m (Maybe a)
_action = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
result

expectJust :: HasDebugCallStack => String -> Maybe a -> a
{-# INLINE expectJust #-}
expectJust :: forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
_   (Just a
x) = a
x
expectJust String
err Maybe a
Nothing  = String -> a
forall a. HasCallStack => String -> a
error (String
"expectJust " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)

whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust = Maybe a -> (a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_

-- | Flipped version of @fromMaybe@, useful for chaining.
orElse :: Maybe a -> a -> a
orElse :: forall a. Maybe a -> a -> a
orElse = (a -> Maybe a -> a) -> Maybe a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe

rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: forall a b. Either a b -> Maybe b
rightToMaybe (Left a
_)  = Maybe b
forall a. Maybe a
Nothing
rightToMaybe (Right b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x

{-
************************************************************************
*                                                                      *
\subsection[MaybeT type]{The @MaybeT@ monad transformer}
*                                                                      *
************************************************************************
-}

-- We had our own MaybeT in the past. Now we reuse transformer's MaybeT

liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT :: forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
liftMaybeT m a
act = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
act

-- | Try performing an 'IO' action, failing on error.
tryMaybeT :: IO a -> MaybeT IO a
tryMaybeT :: forall a. IO a -> MaybeT IO a
tryMaybeT IO a
action = IO (Maybe a) -> MaybeT IO a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe a) -> MaybeT IO a) -> IO (Maybe a) -> MaybeT IO a
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> (SomeException -> IO (Maybe a)) -> IO (Maybe a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO a
action) SomeException -> IO (Maybe a)
forall {m :: * -> *} {a}. Monad m => SomeException -> m (Maybe a)
handler
  where
    handler :: SomeException -> m (Maybe a)
handler (SomeException e
_) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
\subsection[MaybeErr type]{The @MaybeErr@ type}
*                                                                      *
************************************************************************
-}

data MaybeErr err val = Succeeded val | Failed err
    deriving ((forall a b. (a -> b) -> MaybeErr err a -> MaybeErr err b)
-> (forall a b. a -> MaybeErr err b -> MaybeErr err a)
-> Functor (MaybeErr err)
forall a b. a -> MaybeErr err b -> MaybeErr err a
forall a b. (a -> b) -> MaybeErr err a -> MaybeErr err b
forall err a b. a -> MaybeErr err b -> MaybeErr err a
forall err a b. (a -> b) -> MaybeErr err a -> MaybeErr err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall err a b. (a -> b) -> MaybeErr err a -> MaybeErr err b
fmap :: forall a b. (a -> b) -> MaybeErr err a -> MaybeErr err b
$c<$ :: forall err a b. a -> MaybeErr err b -> MaybeErr err a
<$ :: forall a b. a -> MaybeErr err b -> MaybeErr err a
Functor)

instance Applicative (MaybeErr err) where
  pure :: forall a. a -> MaybeErr err a
pure  = a -> MaybeErr err a
forall err a. a -> MaybeErr err a
Succeeded
  <*> :: forall a b.
MaybeErr err (a -> b) -> MaybeErr err a -> MaybeErr err b
(<*>) = MaybeErr err (a -> b) -> MaybeErr err a -> MaybeErr err b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (MaybeErr err) where
  Succeeded a
v >>= :: forall a b.
MaybeErr err a -> (a -> MaybeErr err b) -> MaybeErr err b
>>= a -> MaybeErr err b
k = a -> MaybeErr err b
k a
v
  Failed err
e    >>= a -> MaybeErr err b
_ = err -> MaybeErr err b
forall err val. err -> MaybeErr err val
Failed err
e

isSuccess :: MaybeErr err val -> Bool
isSuccess :: forall err val. MaybeErr err val -> Bool
isSuccess (Succeeded {}) = Bool
True
isSuccess (Failed {})    = Bool
False

failME :: err -> MaybeErr err val
failME :: forall err val. err -> MaybeErr err val
failME err
e = err -> MaybeErr err val
forall err val. err -> MaybeErr err val
Failed err
e