{-# LANGUAGE CPP, Rank2Types, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
module Control.Monad.MaybeK
(
MaybeK
, runMaybeK
, toMaybeK
, maybeK
, MaybeKT
, runMaybeKT
, toMaybeKT
, liftMaybeK
, lowerMaybeK
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..))
#endif
import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus(..))
import Control.Monad.Trans (MonadTrans(..))
#if (MIN_VERSION_mtl(2,2,1))
import Control.Monad.Except (MonadError(..))
#else
import Control.Monad.Error (MonadError(..))
#endif
newtype MaybeK a = MK (forall r. (a -> Maybe r) -> Maybe r)
runMaybeK :: MaybeK a -> Maybe a
{-# INLINE runMaybeK #-}
runMaybeK :: MaybeK a -> Maybe a
runMaybeK (MK forall r. (a -> Maybe r) -> Maybe r
m) = (a -> Maybe a) -> Maybe a
forall r. (a -> Maybe r) -> Maybe r
m a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
toMaybeK :: Maybe a -> MaybeK a
{-# INLINE toMaybeK #-}
toMaybeK :: Maybe a -> MaybeK a
toMaybeK Maybe a
Nothing = MaybeK a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
toMaybeK (Just a
a) = a -> MaybeK a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
maybeK :: b -> (a -> b) -> MaybeK a -> b
{-# INLINE maybeK #-}
maybeK :: b -> (a -> b) -> MaybeK a -> b
maybeK b
nothing a -> b
just MaybeK a
m =
case MaybeK a -> Maybe a
forall a. MaybeK a -> Maybe a
runMaybeK MaybeK a
m of
Maybe a
Nothing -> b
nothing
Just a
a -> a -> b
just a
a
instance Functor MaybeK where
fmap :: (a -> b) -> MaybeK a -> MaybeK b
fmap a -> b
f (MK forall r. (a -> Maybe r) -> Maybe r
m) = (forall r. (b -> Maybe r) -> Maybe r) -> MaybeK b
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\b -> Maybe r
k -> (a -> Maybe r) -> Maybe r
forall r. (a -> Maybe r) -> Maybe r
m (b -> Maybe r
k (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
a
x <$ :: a -> MaybeK b -> MaybeK a
<$ MK forall r. (b -> Maybe r) -> Maybe r
m = (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\a -> Maybe r
k -> (b -> Maybe r) -> Maybe r
forall r. (b -> Maybe r) -> Maybe r
m (\b
_ -> a -> Maybe r
k a
x))
instance Applicative MaybeK where
pure :: a -> MaybeK a
pure a
x = (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\a -> Maybe r
k -> a -> Maybe r
k a
x)
MK forall r. ((a -> b) -> Maybe r) -> Maybe r
m <*> :: MaybeK (a -> b) -> MaybeK a -> MaybeK b
<*> MK forall r. (a -> Maybe r) -> Maybe r
n = (forall r. (b -> Maybe r) -> Maybe r) -> MaybeK b
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\b -> Maybe r
k -> ((a -> b) -> Maybe r) -> Maybe r
forall r. ((a -> b) -> Maybe r) -> Maybe r
m (\a -> b
f -> (a -> Maybe r) -> Maybe r
forall r. (a -> Maybe r) -> Maybe r
n (b -> Maybe r
k (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)))
MK forall r. (a -> Maybe r) -> Maybe r
m *> :: MaybeK a -> MaybeK b -> MaybeK b
*> MK forall r. (b -> Maybe r) -> Maybe r
n = (forall r. (b -> Maybe r) -> Maybe r) -> MaybeK b
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\b -> Maybe r
k -> (a -> Maybe r) -> Maybe r
forall r. (a -> Maybe r) -> Maybe r
m (\a
_ -> (b -> Maybe r) -> Maybe r
forall r. (b -> Maybe r) -> Maybe r
n b -> Maybe r
k))
MK forall r. (a -> Maybe r) -> Maybe r
m <* :: MaybeK a -> MaybeK b -> MaybeK a
<* MK forall r. (b -> Maybe r) -> Maybe r
n = (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\a -> Maybe r
k -> (a -> Maybe r) -> Maybe r
forall r. (a -> Maybe r) -> Maybe r
m (\a
x -> (b -> Maybe r) -> Maybe r
forall r. (b -> Maybe r) -> Maybe r
n (\b
_ -> a -> Maybe r
k a
x)))
instance Monad MaybeK where
#if (!(MIN_VERSION_base(4,8,0)))
return = pure
#endif
>> :: MaybeK a -> MaybeK b -> MaybeK b
(>>) = MaybeK a -> MaybeK b -> MaybeK b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
MK forall r. (a -> Maybe r) -> Maybe r
m >>= :: MaybeK a -> (a -> MaybeK b) -> MaybeK b
>>= a -> MaybeK b
f = (forall r. (b -> Maybe r) -> Maybe r) -> MaybeK b
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\b -> Maybe r
k -> (a -> Maybe r) -> Maybe r
forall r. (a -> Maybe r) -> Maybe r
m (\a
a -> case a -> MaybeK b
f a
a of MK forall r. (b -> Maybe r) -> Maybe r
n -> (b -> Maybe r) -> Maybe r
forall r. (b -> Maybe r) -> Maybe r
n b -> Maybe r
k))
instance Alternative MaybeK where
empty :: MaybeK a
empty = (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
forall a. (forall r. (a -> Maybe r) -> Maybe r) -> MaybeK a
MK (\a -> Maybe r
_ -> Maybe r
forall a. Maybe a
Nothing)
MaybeK a
m <|> :: MaybeK a -> MaybeK a -> MaybeK a
<|> MaybeK a
n = MaybeK a -> (a -> MaybeK a) -> MaybeK a -> MaybeK a
forall b a. b -> (a -> b) -> MaybeK a -> b
maybeK MaybeK a
n a -> MaybeK a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaybeK a
m
instance MonadPlus MaybeK
#if (!(MIN_VERSION_base(4,8,0)))
where
mzero = empty
mplus = (<|>)
#endif
instance MonadError () MaybeK where
throwError :: () -> MaybeK a
throwError ()
_ = MaybeK a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
catchError :: MaybeK a -> (() -> MaybeK a) -> MaybeK a
catchError MaybeK a
m () -> MaybeK a
f = MaybeK a -> (a -> MaybeK a) -> MaybeK a -> MaybeK a
forall b a. b -> (a -> b) -> MaybeK a -> b
maybeK (() -> MaybeK a
f ()) a -> MaybeK a
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeK a
m
newtype MaybeKT m a = MKT (forall r . (a -> m (Maybe r)) -> m (Maybe r))
runMaybeKT :: (Applicative m) => MaybeKT m a -> m (Maybe a)
{-# INLINE runMaybeKT #-}
runMaybeKT :: MaybeKT m a -> m (Maybe a)
runMaybeKT (MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
m) = (a -> m (Maybe a)) -> m (Maybe a)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
m (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
toMaybeKT :: (Applicative m) => Maybe a -> MaybeKT m a
{-# INLINE toMaybeKT #-}
toMaybeKT :: Maybe a -> MaybeKT m a
toMaybeKT Maybe a
Nothing = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
_ -> Maybe r -> m (Maybe r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe r
forall a. Maybe a
Nothing)
toMaybeKT (Just a
a) = a -> MaybeKT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
liftMaybeK :: (Applicative m) => MaybeK a -> MaybeKT m a
{-# INLINE liftMaybeK #-}
liftMaybeK :: MaybeK a -> MaybeKT m a
liftMaybeK = Maybe a -> MaybeKT m a
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeKT m a
toMaybeKT (Maybe a -> MaybeKT m a)
-> (MaybeK a -> Maybe a) -> MaybeK a -> MaybeKT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeK a -> Maybe a
forall a. MaybeK a -> Maybe a
runMaybeK
lowerMaybeK :: (Applicative m) => MaybeKT m a -> m (MaybeK a)
{-# INLINE lowerMaybeK #-}
lowerMaybeK :: MaybeKT m a -> m (MaybeK a)
lowerMaybeK = (Maybe a -> MaybeK a) -> m (Maybe a) -> m (MaybeK a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> MaybeK a
forall a. Maybe a -> MaybeK a
toMaybeK (m (Maybe a) -> m (MaybeK a))
-> (MaybeKT m a -> m (Maybe a)) -> MaybeKT m a -> m (MaybeK a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeKT m a -> m (Maybe a)
forall (m :: * -> *) a. Applicative m => MaybeKT m a -> m (Maybe a)
runMaybeKT
instance Functor (MaybeKT m) where
fmap :: (a -> b) -> MaybeKT m a -> MaybeKT m b
fmap a -> b
f (MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
m) = (forall r. (b -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m b
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\b -> m (Maybe r)
k -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
m (b -> m (Maybe r)
k (b -> m (Maybe r)) -> (a -> b) -> a -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
a
x <$ :: a -> MaybeKT m b -> MaybeKT m a
<$ MKT forall r. (b -> m (Maybe r)) -> m (Maybe r)
m = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
k -> (b -> m (Maybe r)) -> m (Maybe r)
forall r. (b -> m (Maybe r)) -> m (Maybe r)
m (\b
_ -> a -> m (Maybe r)
k a
x))
instance Applicative (MaybeKT m) where
pure :: a -> MaybeKT m a
pure a
x = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
k -> a -> m (Maybe r)
k a
x)
MKT forall r. ((a -> b) -> m (Maybe r)) -> m (Maybe r)
m <*> :: MaybeKT m (a -> b) -> MaybeKT m a -> MaybeKT m b
<*> MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
n = (forall r. (b -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m b
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\b -> m (Maybe r)
k -> ((a -> b) -> m (Maybe r)) -> m (Maybe r)
forall r. ((a -> b) -> m (Maybe r)) -> m (Maybe r)
m (\a -> b
f -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
n (b -> m (Maybe r)
k (b -> m (Maybe r)) -> (a -> b) -> a -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)))
MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
m *> :: MaybeKT m a -> MaybeKT m b -> MaybeKT m b
*> MKT forall r. (b -> m (Maybe r)) -> m (Maybe r)
n = (forall r. (b -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m b
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\b -> m (Maybe r)
k -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
m (\a
_ -> (b -> m (Maybe r)) -> m (Maybe r)
forall r. (b -> m (Maybe r)) -> m (Maybe r)
n b -> m (Maybe r)
k))
MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
m <* :: MaybeKT m a -> MaybeKT m b -> MaybeKT m a
<* MKT forall r. (b -> m (Maybe r)) -> m (Maybe r)
n = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
k -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
m (\a
x -> (b -> m (Maybe r)) -> m (Maybe r)
forall r. (b -> m (Maybe r)) -> m (Maybe r)
n (\b
_ -> a -> m (Maybe r)
k a
x)))
instance Monad (MaybeKT m) where
#if (!(MIN_VERSION_base(4,8,0)))
return = pure
#endif
>> :: MaybeKT m a -> MaybeKT m b -> MaybeKT m b
(>>) = MaybeKT m a -> MaybeKT m b -> MaybeKT m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
m >>= :: MaybeKT m a -> (a -> MaybeKT m b) -> MaybeKT m b
>>= a -> MaybeKT m b
f = (forall r. (b -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m b
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\b -> m (Maybe r)
k -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
m (\a
a -> case a -> MaybeKT m b
f a
a of MKT forall r. (b -> m (Maybe r)) -> m (Maybe r)
n -> (b -> m (Maybe r)) -> m (Maybe r)
forall r. (b -> m (Maybe r)) -> m (Maybe r)
n b -> m (Maybe r)
k))
instance (Applicative m, Monad m) => Alternative (MaybeKT m) where
empty :: MaybeKT m a
empty = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
_ -> Maybe r -> m (Maybe r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe r
forall a. Maybe a
Nothing)
MaybeKT m a
m <|> :: MaybeKT m a -> MaybeKT m a -> MaybeKT m a
<|> MaybeKT m a
n = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT ((forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a)
-> (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall a b. (a -> b) -> a -> b
$ \a -> m (Maybe r)
k ->
MaybeKT m a -> m (Maybe a)
forall (m :: * -> *) a. Applicative m => MaybeKT m a -> m (Maybe a)
runMaybeKT MaybeKT m a
m m (Maybe a) -> (Maybe a -> m (Maybe r)) -> m (Maybe r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
mb ->
case Maybe a
mb of
Maybe a
Nothing -> case MaybeKT m a
n of MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
n' -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
n' a -> m (Maybe r)
k
Just a
a -> a -> m (Maybe r)
k a
a
instance (Applicative m, Monad m) => MonadPlus (MaybeKT m)
#if (!(MIN_VERSION_base(4,8,0)))
where
mzero = empty
mplus = (<|>)
#endif
instance (Applicative m, Monad m) => MonadError () (MaybeKT m) where
throwError :: () -> MaybeKT m a
throwError ()
_ = MaybeKT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
catchError :: MaybeKT m a -> (() -> MaybeKT m a) -> MaybeKT m a
catchError MaybeKT m a
m () -> MaybeKT m a
f = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT ((forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a)
-> (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall a b. (a -> b) -> a -> b
$ \a -> m (Maybe r)
k ->
MaybeKT m a -> m (Maybe a)
forall (m :: * -> *) a. Applicative m => MaybeKT m a -> m (Maybe a)
runMaybeKT MaybeKT m a
m m (Maybe a) -> (Maybe a -> m (Maybe r)) -> m (Maybe r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
mb ->
case Maybe a
mb of
Maybe a
Nothing -> case () -> MaybeKT m a
f () of MKT forall r. (a -> m (Maybe r)) -> m (Maybe r)
n -> (a -> m (Maybe r)) -> m (Maybe r)
forall r. (a -> m (Maybe r)) -> m (Maybe r)
n a -> m (Maybe r)
k
Just a
a -> a -> m (Maybe r)
k a
a
instance MonadTrans MaybeKT where
lift :: m a -> MaybeKT m a
lift m a
m = (forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
forall (m :: * -> *) a.
(forall r. (a -> m (Maybe r)) -> m (Maybe r)) -> MaybeKT m a
MKT (\a -> m (Maybe r)
k -> m a
m m a -> (a -> m (Maybe r)) -> m (Maybe r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m (Maybe r)
k)