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

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

module Maybes (
        module Data.Maybe,

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

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

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

import GhcPrelude

import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Exception (catch, SomeException(..))
import Data.Maybe
import Util (HasCallStack)

infixr 4 `orElse`

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

firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust Maybe a
a Maybe a
b = [Maybe a] -> Maybe a
forall a. [Maybe a] -> Maybe a
firstJusts [Maybe a
a, Maybe a
b]

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

expectJust :: HasCallStack => String -> Maybe a -> a
{-# INLINE expectJust #-}
expectJust :: 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 :: Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just a
x) a -> m ()
f = a -> m ()
f a
x
whenIsJust Maybe a
Nothing  a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Flipped version of @fromMaybe@, useful for chaining.
orElse :: Maybe a -> a -> a
orElse :: 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 :: 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 :: 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 :: 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
catch (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
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 (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 (a -> MaybeErr err b -> MaybeErr err a
(a -> b) -> MaybeErr err a -> MaybeErr err b
(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
<$ :: a -> MaybeErr err b -> MaybeErr err a
$c<$ :: forall err a b. a -> MaybeErr err b -> MaybeErr err a
fmap :: (a -> b) -> MaybeErr err a -> MaybeErr err b
$cfmap :: forall err a b. (a -> b) -> MaybeErr err a -> MaybeErr err b
Functor)

instance Applicative (MaybeErr err) where
  pure :: a -> MaybeErr err a
pure  = a -> MaybeErr err a
forall err a. a -> MaybeErr err a
Succeeded
  <*> :: 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 >>= :: 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 :: MaybeErr err val -> Bool
isSuccess (Succeeded {}) = Bool
True
isSuccess (Failed {})    = Bool
False

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