{-# LANGUAGE DeriveFunctor, DeriveFoldable, GeneralizedNewtypeDeriving #-}
module Control.Monad.Plus (
module Control.Monad,
Monad.msum,
msum',
mfold,
mfromList,
mfromMaybe,
mreturn,
mpartition,
mscatter,
mscatter',
mcatMaybes,
mlefts,
mrights,
mpartitionEithers,
mmapMaybe,
mconcatMap,
mconcatMap',
Partial(..),
partial,
predicate,
always,
never,
) where
import Control.Monad hiding (msum)
import Control.Applicative
import Control.Category (Category)
import qualified Control.Category as Category
import Data.Semigroup as Sem
import Data.Monoid
import Data.List (partition)
import Data.Maybe (listToMaybe, maybeToList, catMaybes, mapMaybe, fromMaybe)
import Data.Either (lefts, rights, partitionEithers)
import Data.Foldable (Foldable(..), toList)
import qualified Control.Monad as Monad
import qualified Data.Foldable as Foldable
msum' :: (MonadPlus m, Foldable t) => t (m a) -> m a
msum' :: forall (m :: * -> *) (t :: * -> *) a.
(MonadPlus m, Foldable t) =>
t (m a) -> m a
msum' = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Foldable.msum
mfold :: (MonadPlus m, Foldable t) => t a -> m a
mfold :: forall (m :: * -> *) (t :: * -> *) a.
(MonadPlus m, Foldable t) =>
t a -> m a
mfold = forall (m :: * -> *) a. MonadPlus m => [a] -> m a
mfromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
mfromList :: MonadPlus m => [a] -> m a
mfromList :: forall (m :: * -> *) a. MonadPlus m => [a] -> m a
mfromList = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Monad.msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return
mfromMaybe :: MonadPlus m => Maybe a -> m a
mfromMaybe :: forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
mfromMaybe = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return
mreturn :: MonadPlus m => (a -> Maybe b) -> a -> m b
mreturn :: forall (m :: * -> *) a b. MonadPlus m => (a -> Maybe b) -> a -> m b
mreturn a -> Maybe b
f = forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
mfromMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f
mpartition :: MonadPlus m => (a -> Bool) -> m a -> (m a, m a)
mpartition :: forall (m :: * -> *) a.
MonadPlus m =>
(a -> Bool) -> m a -> (m a, m a)
mpartition a -> Bool
p m a
a = (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter a -> Bool
p m a
a, forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) m a
a)
mcatMaybes :: MonadPlus m => m (Maybe a) -> m a
mcatMaybes :: forall (m :: * -> *) a. MonadPlus m => m (Maybe a) -> m a
mcatMaybes = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
mfromMaybe)
mscatter :: MonadPlus m => m [b] -> m b
mscatter :: forall (m :: * -> *) b. MonadPlus m => m [b] -> m b
mscatter = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadPlus m => [a] -> m a
mfromList)
mscatter' :: (MonadPlus m, Foldable t) => m (t b) -> m b
mscatter' :: forall (m :: * -> *) (t :: * -> *) b.
(MonadPlus m, Foldable t) =>
m (t b) -> m b
mscatter' = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) (t :: * -> *) a.
(MonadPlus m, Foldable t) =>
t a -> m a
mfold)
mlefts :: MonadPlus m => m (Either a b) -> m a
mlefts :: forall (m :: * -> *) a b. MonadPlus m => m (Either a b) -> m a
mlefts = forall (m :: * -> *) a. MonadPlus m => m (Maybe a) -> m a
mcatMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {a} {b}. Either a b -> Maybe a
l
where
l :: Either a b -> Maybe a
l (Left a
a) = forall a. a -> Maybe a
Just a
a
l (Right b
a) = forall a. Maybe a
Nothing
mrights :: MonadPlus m => m (Either a b) -> m b
mrights :: forall (m :: * -> *) a b. MonadPlus m => m (Either a b) -> m b
mrights = forall (m :: * -> *) a. MonadPlus m => m (Maybe a) -> m a
mcatMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {a} {a}. Either a a -> Maybe a
r
where
r :: Either a a -> Maybe a
r (Left a
a) = forall a. Maybe a
Nothing
r (Right a
a) = forall a. a -> Maybe a
Just a
a
mpartitionEithers :: MonadPlus m => m (Either a b) -> (m a, m b)
mpartitionEithers :: forall (m :: * -> *) a b.
MonadPlus m =>
m (Either a b) -> (m a, m b)
mpartitionEithers m (Either a b)
a = (forall (m :: * -> *) a b. MonadPlus m => m (Either a b) -> m a
mlefts m (Either a b)
a, forall (m :: * -> *) a b. MonadPlus m => m (Either a b) -> m b
mrights m (Either a b)
a)
mmapMaybe :: MonadPlus m => (a -> Maybe b) -> m a -> m b
mmapMaybe :: forall (m :: * -> *) a b.
MonadPlus m =>
(a -> Maybe b) -> m a -> m b
mmapMaybe a -> Maybe b
f = forall (m :: * -> *) a. MonadPlus m => m (Maybe a) -> m a
mcatMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe b
f
mconcatMap :: MonadPlus m => (a -> [b]) -> m a -> m b
mconcatMap :: forall (m :: * -> *) a b. MonadPlus m => (a -> [b]) -> m a -> m b
mconcatMap a -> [b]
f = forall (m :: * -> *) b. MonadPlus m => m [b] -> m b
mscatter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> [b]
f
mconcatMap' :: (MonadPlus m, Foldable t) => (a -> t b) -> m a -> m b
mconcatMap' :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadPlus m, Foldable t) =>
(a -> t b) -> m a -> m b
mconcatMap' a -> t b
f = forall (m :: * -> *) (t :: * -> *) b.
(MonadPlus m, Foldable t) =>
m (t b) -> m b
mscatter' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> t b
f
partial :: (a -> Bool) -> a -> Maybe a
partial :: forall a. (a -> Bool) -> a -> Maybe a
partial a -> Bool
p a
x = if a -> Bool
p a
x then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing
predicate :: (a -> Maybe a) -> a -> Bool
predicate :: forall a. (a -> Maybe a) -> a -> Bool
predicate a -> Maybe a
f a
x = case a -> Maybe a
f a
x of
Just a
_ -> Bool
True
Maybe a
Nothing -> Bool
False
always :: (a -> b) -> a -> Maybe b
always :: forall a b. (a -> b) -> a -> Maybe b
always a -> b
f = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
never :: a -> Maybe c
never :: forall a c. a -> Maybe c
never = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
newtype Partial a b = Partial { forall a b. Partial a b -> a -> Maybe b
getPartial :: a -> Maybe b }
instance Functor (Partial r) where
fmap :: forall a b. (a -> b) -> Partial r a -> Partial r b
fmap a -> b
f (Partial r -> Maybe a
g) = forall a b. (a -> Maybe b) -> Partial a b
Partial (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe a
g)
instance Monad (Partial r) where
return :: forall a. a -> Partial r a
return a
x = forall a b. (a -> Maybe b) -> Partial a b
Partial (\r
_ -> forall a. a -> Maybe a
Just a
x)
Partial r -> Maybe a
f >>= :: forall a b. Partial r a -> (a -> Partial r b) -> Partial r b
>>= a -> Partial r b
k = forall a b. (a -> Maybe b) -> Partial a b
Partial forall a b. (a -> b) -> a -> b
$ \r
r -> do { a
x <- r -> Maybe a
f r
r; forall a b. Partial a b -> a -> Maybe b
getPartial (a -> Partial r b
k a
x) r
r }
instance MonadPlus (Partial r) where
mzero :: forall a. Partial r a
mzero = forall a b. (a -> Maybe b) -> Partial a b
Partial (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
Partial r -> Maybe a
f mplus :: forall a. Partial r a -> Partial r a -> Partial r a
`mplus` Partial r -> Maybe a
g = forall a b. (a -> Maybe b) -> Partial a b
Partial forall a b. (a -> b) -> a -> b
$ \r
x -> r -> Maybe a
f r
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` r -> Maybe a
g r
x
instance Applicative (Partial r) where
pure :: forall a. a -> Partial r a
pure a
x = forall a b. (a -> Maybe b) -> Partial a b
Partial (\r
_ -> forall a. a -> Maybe a
Just a
x)
Partial r -> Maybe (a -> b)
f <*> :: forall a b. Partial r (a -> b) -> Partial r a -> Partial r b
<*> Partial r -> Maybe a
g = forall a b. (a -> Maybe b) -> Partial a b
Partial forall a b. (a -> b) -> a -> b
$ \r
x -> r -> Maybe (a -> b)
f r
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> Maybe a
g r
x
instance Alternative (Partial r) where
empty :: forall a. Partial r a
empty = forall a b. (a -> Maybe b) -> Partial a b
Partial (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
Partial r -> Maybe a
f <|> :: forall a. Partial r a -> Partial r a -> Partial r a
<|> Partial r -> Maybe a
g = forall a b. (a -> Maybe b) -> Partial a b
Partial forall a b. (a -> b) -> a -> b
$ \r
x -> r -> Maybe a
f r
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> r -> Maybe a
g r
x
instance Category Partial where
id :: forall a. Partial a a
id = forall a b. (a -> Maybe b) -> Partial a b
Partial (forall a b. (a -> b) -> a -> Maybe b
always forall a. a -> a
id)
Partial b -> Maybe c
f . :: forall b c a. Partial b c -> Partial a b -> Partial a c
. Partial a -> Maybe b
g = forall a b. (a -> Maybe b) -> Partial a b
Partial forall a b. (a -> b) -> a -> b
$ \a
x -> do
b
y <- a -> Maybe b
g a
x
b -> Maybe c
f b
y
instance Sem.Semigroup (Partial a b) where
<> :: Partial a b -> Partial a b -> Partial a b
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monoid (Partial a b) where
mempty :: Partial a b
mempty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
mappend :: Partial a b -> Partial a b -> Partial a b
mappend = forall a. Semigroup a => a -> a -> a
(<>)