{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Functor.Bind.Class (
Apply(..)
, WrappedApplicative(..)
, MaybeApply(..)
, (<.*>)
, (<*.>)
, traverse1Maybe
, Bind(..)
, apDefault
, returning
, Biapply(..)
) where
import Data.Semigroup
import Control.Applicative
import Control.Applicative.Backwards
import Control.Applicative.Lift
import Control.Arrow
import Control.Category
import Control.Monad (ap)
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.RWS.CPS as CPS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Semigroupoids.Internal
#endif
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Strict as Strict
import Data.Biapplicative
import Data.Bifunctor.Biff
import Data.Bifunctor.Clown
import Data.Bifunctor.Flip
import Data.Bifunctor.Joker
import Data.Bifunctor.Join
import Data.Bifunctor.Product as Bifunctor
import Data.Bifunctor.Tannen
import Data.Bifunctor.Wrapped
import Data.Complex
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Functor.Product as Functor
import Data.Functor.Reverse
import Data.Functor.Extend
import Data.List.NonEmpty (NonEmpty)
import Data.Ord (Down (..))
import Data.Proxy
import Data.Semigroup as Semigroup
import qualified Data.Monoid as Monoid
import Data.Orphans ()
import GHC.Generics as Generics
import Language.Haskell.TH (Q)
import Prelude hiding (id, (.))
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif
#ifdef MIN_VERSION_containers
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Tree (Tree)
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged
#endif
#ifdef MIN_VERSION_unordered_containers
import Data.Hashable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
#endif
#ifdef MIN_VERSION_comonad
import Control.Comonad
import Control.Comonad.Trans.Env
import Control.Comonad.Trans.Store
import Control.Comonad.Trans.Traced
#else
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
#endif
infixl 1 >>-
infixl 4 <.>, <., .>
class Functor f => Apply f where
(<.>) :: f (a -> b) -> f a -> f b
(<.>) = forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
(.>) :: f a -> f b -> f b
f a
a .> f b
b = forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
b
(<.) :: f a -> f b -> f a
f a
a <. f b
b = forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
b
liftF2 :: (a -> b -> c) -> f a -> f b -> f c
liftF2 a -> b -> c
f f a
a f b
b = a -> b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
b
{-# INLINE liftF2 #-}
{-# MINIMAL (<.>) | liftF2 #-}
#ifdef MIN_VERSION_tagged
instance Apply (Tagged a) where
<.> :: forall a b. Tagged a (a -> b) -> Tagged a a -> Tagged a b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
<. :: forall a b. Tagged a a -> Tagged a b -> Tagged a a
(<.) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
.> :: forall a b. Tagged a a -> Tagged a b -> Tagged a b
(.>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#endif
instance Apply Proxy where
<.> :: forall a b. Proxy (a -> b) -> Proxy a -> Proxy b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
<. :: forall a b. Proxy a -> Proxy b -> Proxy a
(<.) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
.> :: forall a b. Proxy a -> Proxy b -> Proxy b
(.>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
instance Apply f => Apply (Backwards f) where
Backwards f (a -> b)
f <.> :: forall a b. Backwards f (a -> b) -> Backwards f a -> Backwards f b
<.> Backwards f a
a = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (a -> b)
f)
instance (Apply f, Apply g) => Apply (Compose f g) where
Compose f (g (a -> b))
f <.> :: forall a b. Compose f g (a -> b) -> Compose f g a -> Compose f g b
<.> Compose f (g a)
x = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (g a)
x)
instance Semigroup f => Apply (Constant f) where
Constant f
a <.> :: forall a b. Constant f (a -> b) -> Constant f a -> Constant f b
<.> Constant f
b = forall {k} a (b :: k). a -> Constant a b
Constant (f
a forall a. Semigroup a => a -> a -> a
<> f
b)
Constant f
a <. :: forall a b. Constant f a -> Constant f b -> Constant f a
<. Constant f
b = forall {k} a (b :: k). a -> Constant a b
Constant (f
a forall a. Semigroup a => a -> a -> a
<> f
b)
Constant f
a .> :: forall a b. Constant f a -> Constant f b -> Constant f b
.> Constant f
b = forall {k} a (b :: k). a -> Constant a b
Constant (f
a forall a. Semigroup a => a -> a -> a
<> f
b)
instance Apply f => Apply (Lift f) where
Pure a -> b
f <.> :: forall a b. Lift f (a -> b) -> Lift f a -> Lift f b
<.> Pure a
x = forall (f :: * -> *) a. a -> Lift f a
Pure (a -> b
f a
x)
Pure a -> b
f <.> Other f a
y = forall (f :: * -> *) a. f a -> Lift f a
Other (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
y)
Other f (a -> b)
f <.> Pure a
x = forall (f :: * -> *) a. f a -> Lift f a
Other ((forall a b. (a -> b) -> a -> b
$ a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
f)
Other f (a -> b)
f <.> Other f a
y = forall (f :: * -> *) a. f a -> Lift f a
Other (f (a -> b)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
y)
instance (Apply f, Apply g) => Apply (Functor.Product f g) where
Functor.Pair f (a -> b)
f g (a -> b)
g <.> :: forall a b. Product f g (a -> b) -> Product f g a -> Product f g b
<.> Functor.Pair f a
x g a
y = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (f (a -> b)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
x) (g (a -> b)
g forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> g a
y)
instance Apply f => Apply (Reverse f) where
Reverse f (a -> b)
a <.> :: forall a b. Reverse f (a -> b) -> Reverse f a -> Reverse f b
<.> Reverse f a
b = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f (a -> b)
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
b)
instance Semigroup m => Apply ((,)m) where
(m
m, a -> b
f) <.> :: forall a b. (m, a -> b) -> (m, a) -> (m, b)
<.> (m
n, a
a) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, a -> b
f a
a)
(m
m, a
a) <. :: forall a b. (m, a) -> (m, b) -> (m, a)
<. (m
n, b
_) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, a
a)
(m
m, a
_) .> :: forall a b. (m, a) -> (m, b) -> (m, b)
.> (m
n, b
b) = (m
m forall a. Semigroup a => a -> a -> a
<> m
n, b
b)
instance Apply NonEmpty where
<.> :: forall a b. NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
(<.>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Apply (Either a) where
Left a
a <.> :: forall a b. Either a (a -> b) -> Either a a -> Either a b
<.> Either a a
_ = forall a b. a -> Either a b
Left a
a
Right a -> b
_ <.> Left a
a = forall a b. a -> Either a b
Left a
a
Right a -> b
f <.> Right a
b = forall a b. b -> Either a b
Right (a -> b
f a
b)
Left a
a <. :: forall a b. Either a a -> Either a b -> Either a a
<. Either a b
_ = forall a b. a -> Either a b
Left a
a
Right a
_ <. Left a
a = forall a b. a -> Either a b
Left a
a
Right a
a <. Right b
_ = forall a b. b -> Either a b
Right a
a
Left a
a .> :: forall a b. Either a a -> Either a b -> Either a b
.> Either a b
_ = forall a b. a -> Either a b
Left a
a
Right a
_ .> Left a
a = forall a b. a -> Either a b
Left a
a
Right a
_ .> Right b
b = forall a b. b -> Either a b
Right b
b
instance Semigroup m => Apply (Const m) where
Const m
m <.> :: forall a b. Const m (a -> b) -> Const m a -> Const m b
<.> Const m
n = forall {k} a (b :: k). a -> Const a b
Const (m
m forall a. Semigroup a => a -> a -> a
<> m
n)
Const m
m <. :: forall a b. Const m a -> Const m b -> Const m a
<. Const m
n = forall {k} a (b :: k). a -> Const a b
Const (m
m forall a. Semigroup a => a -> a -> a
<> m
n)
Const m
m .> :: forall a b. Const m a -> Const m b -> Const m b
.> Const m
n = forall {k} a (b :: k). a -> Const a b
Const (m
m forall a. Semigroup a => a -> a -> a
<> m
n)
instance Apply ((->)m) where
<.> :: forall a b. (m -> (a -> b)) -> (m -> a) -> m -> b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply ZipList where
<.> :: forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply [] where
<.> :: forall a b. [a -> b] -> [a] -> [b]
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply IO where
<.> :: forall a b. IO (a -> b) -> IO a -> IO b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply Maybe where
<.> :: forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
#if !(MIN_VERSION_base(4,16,0))
instance Apply Option where
(<.>) = (<*>)
(<. ) = (<* )
( .>) = ( *>)
#endif
instance Apply Identity where
<.> :: forall a b. Identity (a -> b) -> Identity a -> Identity b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply w => Apply (IdentityT w) where
IdentityT w (a -> b)
wa <.> :: forall a b. IdentityT w (a -> b) -> IdentityT w a -> IdentityT w b
<.> IdentityT w a
wb = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (w (a -> b)
wa forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> w a
wb)
instance Monad m => Apply (WrappedMonad m) where
<.> :: forall a b.
WrappedMonad m (a -> b) -> WrappedMonad m a -> WrappedMonad m b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Arrow a => Apply (WrappedArrow a b) where
<.> :: forall a b.
WrappedArrow a b (a -> b)
-> WrappedArrow a b a -> WrappedArrow a b b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
instance Apply Complex where
(a -> b
a :+ a -> b
b) <.> :: forall a b. Complex (a -> b) -> Complex a -> Complex b
<.> (a
c :+ a
d) = a -> b
a a
c forall a. a -> a -> Complex a
:+ a -> b
b a
d
instance Apply Q where
<.> :: forall a b. Q (a -> b) -> Q a -> Q b
(<.>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
#ifdef MIN_VERSION_containers
instance Ord k => Apply (Map k) where
<.> :: forall a b. Map k (a -> b) -> Map k a -> Map k b
(<.>) = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
(<. ) = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a b. a -> b -> a
const
( .>) = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
instance Apply IntMap where
<.> :: forall a b. IntMap (a -> b) -> IntMap a -> IntMap b
(<.>) = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
(<. ) = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith forall a b. a -> b -> a
const
( .>) = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith (forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
instance Apply Seq where
<.> :: forall a b. Seq (a -> b) -> Seq a -> Seq b
(<.>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Apply Tree where
<.> :: forall a b. Tree (a -> b) -> Tree a -> Tree b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
(<. ) = (<* )
( .>) = ( *>)
#endif
#ifdef MIN_VERSION_unordered_containers
instance (Hashable k, Eq k) => Apply (HashMap k) where
<.> :: forall a b. HashMap k (a -> b) -> HashMap k a -> HashMap k b
(<.>) = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
#endif
instance (Functor m, Monad m) => Apply (MaybeT m) where
<.> :: forall a b. MaybeT m (a -> b) -> MaybeT m a -> MaybeT m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
#if !(MIN_VERSION_transformers(0,6,0))
instance (Functor m, Monad m) => Apply (ErrorT e m) where
<.> :: forall a b. ErrorT e m (a -> b) -> ErrorT e m a -> ErrorT e m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance Apply m => Apply (ListT m) where
ListT m [a -> b]
f <.> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m b
<.> ListT m [a]
a = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a -> b]
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> m [a]
a
#endif
instance (Functor m, Monad m) => Apply (ExceptT e m) where
<.> :: forall a b. ExceptT e m (a -> b) -> ExceptT e m a -> ExceptT e m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance Apply m => Apply (ReaderT e m) where
ReaderT e -> m (a -> b)
f <.> :: forall a b. ReaderT e m (a -> b) -> ReaderT e m a -> ReaderT e m b
<.> ReaderT e -> m a
a = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \e
e -> e -> m (a -> b)
f e
e forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> e -> m a
a e
e
instance (Apply m, Semigroup w) => Apply (Strict.WriterT w m) where
Strict.WriterT m (a -> b, w)
f <.> :: forall a b. WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
<.> Strict.WriterT m (a, w)
a = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ forall {b} {t} {a}. Semigroup b => (t -> a, b) -> (t, b) -> (a, b)
flap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, w)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> m (a, w)
a where
flap :: (t -> a, b) -> (t, b) -> (a, b)
flap (t -> a
x,b
m) (t
y,b
n) = (t -> a
x t
y, b
m forall a. Semigroup a => a -> a -> a
<> b
n)
instance (Apply m, Semigroup w) => Apply (Lazy.WriterT w m) where
Lazy.WriterT m (a -> b, w)
f <.> :: forall a b. WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
<.> Lazy.WriterT m (a, w)
a = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ forall {b} {t} {a}. Semigroup b => (t -> a, b) -> (t, b) -> (a, b)
flap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, w)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> m (a, w)
a where
flap :: (t -> a, b) -> (t, b) -> (a, b)
flap ~(t -> a
x,b
m) ~(t
y,b
n) = (t -> a
x t
y, b
m forall a. Semigroup a => a -> a -> a
<> b
n)
#if MIN_VERSION_transformers(0,5,6)
instance (Bind m) => Apply (CPS.WriterT w m) where
WriterT w m (a -> b)
mf <.> :: forall a b. WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
<.> WriterT w m a
mx = forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT forall a b. (a -> b) -> a -> b
$ \w
w ->
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w m (a -> b)
mf w
w forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a -> b
f, w
w') -> forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m a
mx) w
w'
#endif
instance Bind m => Apply (Strict.StateT s m) where
<.> :: forall a b. StateT s m (a -> b) -> StateT s m a -> StateT s m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance Bind m => Apply (Lazy.StateT s m) where
<.> :: forall a b. StateT s m (a -> b) -> StateT s m a -> StateT s m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance (Bind m, Semigroup w) => Apply (Strict.RWST r w s m) where
<.> :: forall a b.
RWST r w s m (a -> b) -> RWST r w s m a -> RWST r w s m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance (Bind m, Semigroup w) => Apply (Lazy.RWST r w s m) where
<.> :: forall a b.
RWST r w s m (a -> b) -> RWST r w s m a -> RWST r w s m b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
#if MIN_VERSION_transformers(0,5,6)
instance (Bind m) => Apply (CPS.RWST r w s m) where
RWST r w s m (a -> b)
mf <.> :: forall a b.
RWST r w s m (a -> b) -> RWST r w s m a -> RWST r w s m b
<.> RWST r w s m a
mx = forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s w
w ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST RWST r w s m (a -> b)
mf r
r s
s w
w forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a -> b
f, s
s', w
w') -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m a
mx) r
r s
s' w
w'
#endif
instance Apply (ContT r m) where
ContT ((a -> b) -> m r) -> m r
f <.> :: forall a b. ContT r m (a -> b) -> ContT r m a -> ContT r m b
<.> ContT (a -> m r) -> m r
v = forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ \b -> m r
k -> ((a -> b) -> m r) -> m r
f forall a b. (a -> b) -> a -> b
$ \a -> b
g -> (a -> m r) -> m r
v (b -> m r
k forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
g)
#ifdef MIN_VERSION_comonad
instance (Semigroup e, Apply w) => Apply (EnvT e w) where
EnvT e
ef w (a -> b)
wf <.> :: forall a b. EnvT e w (a -> b) -> EnvT e w a -> EnvT e w b
<.> EnvT e
ea w a
wa = forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT (e
ef forall a. Semigroup a => a -> a -> a
<> e
ea) (w (a -> b)
wf forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> w a
wa)
instance (Apply w, Semigroup s) => Apply (StoreT s w) where
StoreT w (s -> a -> b)
ff s
m <.> :: forall a b. StoreT s w (a -> b) -> StoreT s w a -> StoreT s w b
<.> StoreT w (s -> a)
fa s
n = forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (s -> a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> w (s -> a)
fa) (s
m forall a. Semigroup a => a -> a -> a
<> s
n)
instance Apply w => Apply (TracedT m w) where
TracedT w (m -> a -> b)
wf <.> :: forall a b. TracedT m w (a -> b) -> TracedT m w a -> TracedT m w b
<.> TracedT w (m -> a)
wa = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (m -> a -> b)
wf forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> w (m -> a)
wa)
#endif
newtype WrappedApplicative f a = WrapApplicative { forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative :: f a }
instance Functor f => Functor (WrappedApplicative f) where
fmap :: forall a b.
(a -> b) -> WrappedApplicative f a -> WrappedApplicative f b
fmap a -> b
f (WrapApplicative f a
a) = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a)
instance Applicative f => Apply (WrappedApplicative f) where
WrapApplicative f (a -> b)
f <.> :: forall a b.
WrappedApplicative f (a -> b)
-> WrappedApplicative f a -> WrappedApplicative f b
<.> WrapApplicative f a
a = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
a)
WrapApplicative f a
a <. :: forall a b.
WrappedApplicative f a
-> WrappedApplicative f b -> WrappedApplicative f a
<. WrapApplicative f b
b = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
b)
WrapApplicative f a
a .> :: forall a b.
WrappedApplicative f a
-> WrappedApplicative f b -> WrappedApplicative f b
.> WrapApplicative f b
b = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
b)
instance Applicative f => Applicative (WrappedApplicative f) where
pure :: forall a. a -> WrappedApplicative f a
pure = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
WrapApplicative f (a -> b)
f <*> :: forall a b.
WrappedApplicative f (a -> b)
-> WrappedApplicative f a -> WrappedApplicative f b
<*> WrapApplicative f a
a = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
a)
WrapApplicative f a
a <* :: forall a b.
WrappedApplicative f a
-> WrappedApplicative f b -> WrappedApplicative f a
<* WrapApplicative f b
b = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
b)
WrapApplicative f a
a *> :: forall a b.
WrappedApplicative f a
-> WrappedApplicative f b -> WrappedApplicative f b
*> WrapApplicative f b
b = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
b)
instance Alternative f => Alternative (WrappedApplicative f) where
empty :: forall a. WrappedApplicative f a
empty = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative forall (f :: * -> *) a. Alternative f => f a
empty
WrapApplicative f a
a <|> :: forall a.
WrappedApplicative f a
-> WrappedApplicative f a -> WrappedApplicative f a
<|> WrapApplicative f a
b = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b)
newtype MaybeApply f a = MaybeApply { forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply :: Either (f a) a }
(<.*>) :: (Apply f) => f (a -> b) -> MaybeApply f a -> f b
f (a -> b)
ff <.*> :: forall (f :: * -> *) a b.
Apply f =>
f (a -> b) -> MaybeApply f a -> f b
<.*> MaybeApply (Left f a
fa) = f (a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa
f (a -> b)
ff <.*> MaybeApply (Right a
a) = (forall a b. (a -> b) -> a -> b
$ a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
ff
infixl 4 <.*>
(<*.>) :: (Apply f) => MaybeApply f (a -> b) -> f a -> f b
MaybeApply (Left f (a -> b)
ff) <*.> :: forall (f :: * -> *) a b.
Apply f =>
MaybeApply f (a -> b) -> f a -> f b
<*.> f a
fa = f (a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa
MaybeApply (Right a -> b
f) <*.> f a
fa = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
infixl 4 <*.>
traverse1Maybe :: (Traversable t, Apply f) => (a -> f b) -> t a -> MaybeApply f (t b)
traverse1Maybe :: forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Apply f) =>
(a -> f b) -> t a -> MaybeApply f (t b)
traverse1Maybe a -> f b
f = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f b
f)
instance Functor f => Functor (MaybeApply f) where
fmap :: forall a b. (a -> b) -> MaybeApply f a -> MaybeApply f b
fmap a -> b
f (MaybeApply (Right a
a)) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right (a -> b
f a
a ))
fmap a -> b
f (MaybeApply (Left f a
fa)) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa))
instance Apply f => Apply (MaybeApply f) where
MaybeApply (Right a -> b
f) <.> :: forall a b.
MaybeApply f (a -> b) -> MaybeApply f a -> MaybeApply f b
<.> MaybeApply (Right a
a) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right (a -> b
f a
a ))
MaybeApply (Right a -> b
f) <.> MaybeApply (Left f a
fa) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa))
MaybeApply (Left f (a -> b)
ff) <.> MaybeApply (Right a
a) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left ((forall a b. (a -> b) -> a -> b
$ a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
ff))
MaybeApply (Left f (a -> b)
ff) <.> MaybeApply (Left f a
fa) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (f (a -> b)
ff forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa))
MaybeApply Either (f a) a
a <. :: forall a b. MaybeApply f a -> MaybeApply f b -> MaybeApply f a
<. MaybeApply (Right b
_) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply Either (f a) a
a
MaybeApply (Right a
a) <. MaybeApply (Left f b
fb) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
fb))
MaybeApply (Left f a
fa) <. MaybeApply (Left f b
fb) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (f a
fa forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. f b
fb))
MaybeApply (Right a
_) .> :: forall a b. MaybeApply f a -> MaybeApply f b -> MaybeApply f b
.> MaybeApply Either (f b) b
b = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply Either (f b) b
b
MaybeApply (Left f a
fa) .> MaybeApply (Right b
b) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (f a
fa forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
b ))
MaybeApply (Left f a
fa) .> MaybeApply (Left f b
fb) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (f a
fa forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
.> f b
fb))
instance Apply f => Applicative (MaybeApply f) where
pure :: forall a. a -> MaybeApply f a
pure a
a = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right a
a)
<*> :: forall a b.
MaybeApply f (a -> b) -> MaybeApply f a -> MaybeApply f b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
(<* ) = (<. )
( *>) = ( .>)
instance Extend f => Extend (MaybeApply f) where
duplicated :: forall a. MaybeApply f a -> MaybeApply f (MaybeApply f a)
duplicated w :: MaybeApply f a
w@(MaybeApply Right{}) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right MaybeApply f a
w)
duplicated (MaybeApply (Left f a
fa)) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left) f a
fa))
#ifdef MIN_VERSION_comonad
instance Comonad f => Comonad (MaybeApply f) where
duplicate :: forall a. MaybeApply f a -> MaybeApply f (MaybeApply f a)
duplicate w :: MaybeApply f a
w@(MaybeApply Right{}) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. b -> Either a b
Right MaybeApply f a
w)
duplicate (MaybeApply (Left f a
fa)) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall a b. a -> Either a b
Left (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left) f a
fa))
extract :: forall a. MaybeApply f a -> a
extract (MaybeApply (Left f a
fa)) = forall (w :: * -> *) a. Comonad w => w a -> a
extract f a
fa
extract (MaybeApply (Right a
a)) = a
a
instance Apply (Cokleisli w a) where
Cokleisli w a -> a -> b
f <.> :: forall a b.
Cokleisli w a (a -> b) -> Cokleisli w a a -> Cokleisli w a b
<.> Cokleisli w a -> a
a = forall {k} (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli (\w a
w -> (w a -> a -> b
f w a
w) (w a -> a
a w a
w))
#endif
instance Apply Down where <.> :: forall a b. Down (a -> b) -> Down a -> Down b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Down a -> Down b -> Down b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Down a -> Down b -> Down a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Monoid.Sum where <.> :: forall a b. Sum (a -> b) -> Sum a -> Sum b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Sum a -> Sum b -> Sum b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Sum a -> Sum b -> Sum a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Monoid.Product where <.> :: forall a b. Product (a -> b) -> Product a -> Product b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Product a -> Product b -> Product b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Product a -> Product b -> Product a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Monoid.Dual where <.> :: forall a b. Dual (a -> b) -> Dual a -> Dual b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Dual a -> Dual b -> Dual b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Dual a -> Dual b -> Dual a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Monoid.First where <.> :: forall a b. First (a -> b) -> First a -> First b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. First a -> First b -> First b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. First a -> First b -> First a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Monoid.Last where <.> :: forall a b. Last (a -> b) -> Last a -> Last b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Last a -> Last b -> Last b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Last a -> Last b -> Last a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
deriving instance Apply f => Apply (Monoid.Alt f)
instance Apply Semigroup.First where <.> :: forall a b. First (a -> b) -> First a -> First b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. First a -> First b -> First b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. First a -> First b -> First a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Semigroup.Last where <.> :: forall a b. Last (a -> b) -> Last a -> Last b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Last a -> Last b -> Last b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Last a -> Last b -> Last a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Semigroup.Min where <.> :: forall a b. Min (a -> b) -> Min a -> Min b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Min a -> Min b -> Min b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Min a -> Min b -> Min a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Semigroup.Max where <.> :: forall a b. Max (a -> b) -> Max a -> Max b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Max a -> Max b -> Max b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Max a -> Max b -> Max a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance (Apply f, Apply g) => Apply (f :*: g) where
(f (a -> b)
a :*: g (a -> b)
b) <.> :: forall a b. (:*:) f g (a -> b) -> (:*:) f g a -> (:*:) f g b
<.> (f a
c :*: g a
d) = (f (a -> b)
a forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
c) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g (a -> b)
b forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> g a
d)
deriving instance Apply f => Apply (M1 i t f)
deriving instance Apply f => Apply (Rec1 f)
instance (Apply f, Apply g) => Apply (f :.: g) where
Comp1 f (g (a -> b))
m <.> :: forall a b. (:.:) f g (a -> b) -> (:.:) f g a -> (:.:) f g b
<.> Comp1 f (g a)
n = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
m forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (g a)
n
instance Apply U1 where <.> :: forall a b. U1 (a -> b) -> U1 a -> U1 b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. U1 a -> U1 b -> U1 b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. U1 a -> U1 b -> U1 a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Semigroup c => Apply (K1 i c) where
K1 c
a <.> :: forall a b. K1 i c (a -> b) -> K1 i c a -> K1 i c b
<.> K1 c
b = forall k i c (p :: k). c -> K1 i c p
K1 (c
a forall a. Semigroup a => a -> a -> a
<> c
b)
K1 c
a <. :: forall a b. K1 i c a -> K1 i c b -> K1 i c a
<. K1 c
b = forall k i c (p :: k). c -> K1 i c p
K1 (c
a forall a. Semigroup a => a -> a -> a
<> c
b)
K1 c
a .> :: forall a b. K1 i c a -> K1 i c b -> K1 i c b
.> K1 c
b = forall k i c (p :: k). c -> K1 i c p
K1 (c
a forall a. Semigroup a => a -> a -> a
<> c
b)
instance Apply Par1 where <.> :: forall a b. Par1 (a -> b) -> Par1 a -> Par1 b
(<.>)=forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>);.> :: forall a b. Par1 a -> Par1 b -> Par1 b
(.>)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>);<. :: forall a b. Par1 a -> Par1 b -> Par1 a
(<.)=forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
instance Apply Generics.V1 where
V1 (a -> b)
e <.> :: forall a b. V1 (a -> b) -> V1 a -> V1 b
<.> V1 a
_ = case V1 (a -> b)
e of {}
class Apply m => Bind m where
(>>-) :: m a -> (a -> m b) -> m b
m a
m >>- a -> m b
f = forall (m :: * -> *) a. Bind m => m (m a) -> m a
join (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m b
f m a
m)
join :: m (m a) -> m a
join = (forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
{-# MINIMAL (>>-) | join #-}
returning :: Functor f => f a -> (a -> b) -> f b
returning :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
returning = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
apDefault :: Bind f => f (a -> b) -> f a -> f b
apDefault :: forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault f (a -> b)
f f a
x = f (a -> b)
f forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a -> b
f' -> a -> b
f' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
instance Semigroup m => Bind ((,) m) where
~(m
m, a
a) >>- :: forall a b. (m, a) -> (a -> (m, b)) -> (m, b)
>>- a -> (m, b)
f = let (m
n, b
b) = a -> (m, b)
f a
a in (m
m forall a. Semigroup a => a -> a -> a
<> m
n, b
b)
#ifdef MIN_VERSION_tagged
instance Bind (Tagged a) where
Tagged a
a >>- :: forall a b. Tagged a a -> (a -> Tagged a b) -> Tagged a b
>>- a -> Tagged a b
f = a -> Tagged a b
f a
a
join :: forall a. Tagged a (Tagged a a) -> Tagged a a
join (Tagged Tagged a a
a) = Tagged a a
a
#endif
instance Bind Proxy where
Proxy a
_ >>- :: forall a b. Proxy a -> (a -> Proxy b) -> Proxy b
>>- a -> Proxy b
_ = forall {k} (t :: k). Proxy t
Proxy
join :: forall a. Proxy (Proxy a) -> Proxy a
join Proxy (Proxy a)
_ = forall {k} (t :: k). Proxy t
Proxy
instance Bind (Either a) where
Left a
a >>- :: forall a b. Either a a -> (a -> Either a b) -> Either a b
>>- a -> Either a b
_ = forall a b. a -> Either a b
Left a
a
Right a
a >>- a -> Either a b
f = a -> Either a b
f a
a
instance (Bind f, Bind g) => Bind (Functor.Product f g) where
Functor.Pair f a
m g a
n >>- :: forall a b. Product f g a -> (a -> Product f g b) -> Product f g b
>>- a -> Product f g b
f = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (f a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {f :: * -> *} {g :: * -> *} {a}. Product f g a -> f a
fstP forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Product f g b
f) (g a
n forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {f :: * -> *} {g :: * -> *} {a}. Product f g a -> g a
sndP forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Product f g b
f) where
fstP :: Product f g a -> f a
fstP (Functor.Pair f a
a g a
_) = f a
a
sndP :: Product f g a -> g a
sndP (Functor.Pair f a
_ g a
b) = g a
b
instance Bind ((->)m) where
m -> a
f >>- :: forall a b. (m -> a) -> (a -> m -> b) -> m -> b
>>- a -> m -> b
g = \m
e -> a -> m -> b
g (m -> a
f m
e) m
e
instance Bind [] where
>>- :: forall a b. [a] -> (a -> [b]) -> [b]
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind NonEmpty where
>>- :: forall a b. NonEmpty a -> (a -> NonEmpty b) -> NonEmpty b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind IO where
>>- :: forall a b. IO a -> (a -> IO b) -> IO b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Maybe where
>>- :: forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
#if !(MIN_VERSION_base(4,16,0))
instance Bind Option where
(>>-) = (>>=)
#endif
instance Bind Identity where
>>- :: forall a b. Identity a -> (a -> Identity b) -> Identity b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Q where
>>- :: forall a b. Q a -> (a -> Q b) -> Q b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind m => Bind (IdentityT m) where
IdentityT m a
m >>- :: forall a b. IdentityT m a -> (a -> IdentityT m b) -> IdentityT m b
>>- a -> IdentityT m b
f = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> IdentityT m b
f)
instance Monad m => Bind (WrappedMonad m) where
WrapMonad m a
m >>- :: forall a b.
WrappedMonad m a -> (a -> WrappedMonad m b) -> WrappedMonad m b
>>- a -> WrappedMonad m b
f = forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall a b. (a -> b) -> a -> b
$ m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> WrappedMonad m b
f
instance (Functor m, Monad m) => Bind (MaybeT m) where
>>- :: forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
#if !(MIN_VERSION_transformers(0,6,0))
instance (Apply m, Monad m) => Bind (ListT m) where
>>- :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance (Functor m, Monad m) => Bind (ErrorT e m) where
ErrorT e m a
m >>- :: forall a b. ErrorT e m a -> (a -> ErrorT e m b) -> ErrorT e m b
>>- a -> ErrorT e m b
k = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ do
Either e a
a <- forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT e m a
m
case Either e a
a of
Left e
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
l)
Right a
r -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (a -> ErrorT e m b
k a
r)
#endif
instance (Functor m, Monad m) => Bind (ExceptT e m) where
ExceptT e m a
m >>- :: forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
>>- a -> ExceptT e m b
k = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
Either e a
a <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
m
case Either e a
a of
Left e
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
l)
Right a
r -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExceptT e m b
k a
r)
instance Bind m => Bind (ReaderT e m) where
ReaderT e -> m a
m >>- :: forall a b. ReaderT e m a -> (a -> ReaderT e m b) -> ReaderT e m b
>>- a -> ReaderT e m b
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \e
e -> e -> m a
m e
e forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
x -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT e m b
f a
x) e
e
instance (Bind m, Semigroup w) => Bind (Lazy.WriterT w m) where
WriterT w m a
m >>- :: forall a b. WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
>>- a -> WriterT w m b
k = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, w
w) ->
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> WriterT w m b
k a
a) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ ~(b
b, w
w') ->
(b
b, w
w forall a. Semigroup a => a -> a -> a
<> w
w')
instance (Bind m, Semigroup w) => Bind (Strict.WriterT w m) where
WriterT w m a
m >>- :: forall a b. WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
>>- a -> WriterT w m b
k = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ (a
a, w
w) ->
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> WriterT w m b
k a
a) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ (b
b, w
w') ->
(b
b, w
w forall a. Semigroup a => a -> a -> a
<> w
w')
#if MIN_VERSION_transformers(0,5,6)
instance (Bind m) => Bind (CPS.WriterT w m) where
WriterT w m a
m >>- :: forall a b. WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
>>- a -> WriterT w m b
k = forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT forall a b. (a -> b) -> a -> b
$ \ w
w ->
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w m a
m w
w forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a
a, w
w') -> forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT (a -> WriterT w m b
k a
a) w
w'
#endif
instance Bind m => Bind (Lazy.StateT s m) where
StateT s m a
m >>- :: forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
>>- a -> StateT s m b
k = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s') ->
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (a -> StateT s m b
k a
a) s
s'
instance Bind m => Bind (Strict.StateT s m) where
StateT s m a
m >>- :: forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
>>- a -> StateT s m b
k = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s') ->
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (a -> StateT s m b
k a
a) s
s'
instance (Bind m, Semigroup w) => Bind (Lazy.RWST r w s m) where
RWST r w s m a
m >>- :: forall a b.
RWST r w s m a -> (a -> RWST r w s m b) -> RWST r w s m b
>>- a -> RWST r w s m b
k = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
m r
r s
s forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s', w
w) ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (a -> RWST r w s m b
k a
a) r
r s
s' forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ ~(b
b, s
s'', w
w') ->
(b
b, s
s'', w
w forall a. Semigroup a => a -> a -> a
<> w
w')
instance (Bind m, Semigroup w) => Bind (Strict.RWST r w s m) where
RWST r w s m a
m >>- :: forall a b.
RWST r w s m a -> (a -> RWST r w s m b) -> RWST r w s m b
>>- a -> RWST r w s m b
k = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ (a
a, s
s', w
w) ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (a -> RWST r w s m b
k a
a) r
r s
s' forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ (b
b, s
s'', w
w') ->
(b
b, s
s'', w
w forall a. Semigroup a => a -> a -> a
<> w
w')
#if MIN_VERSION_transformers(0,5,6)
instance (Bind m) => Bind (CPS.RWST r w s m) where
RWST r w s m a
m >>- :: forall a b.
RWST r w s m a -> (a -> RWST r w s m b) -> RWST r w s m b
>>- a -> RWST r w s m b
k = forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s w
w ->
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST RWST r w s m a
m r
r s
s w
w forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a
a, s
s', w
w') -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST (a -> RWST r w s m b
k a
a) r
r s
s' w
w'
#endif
instance Bind (ContT r m) where
ContT r m a
m >>- :: forall a b. ContT r m a -> (a -> ContT r m b) -> ContT r m b
>>- a -> ContT r m b
k = forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ \b -> m r
c -> forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m a
m forall a b. (a -> b) -> a -> b
$ \a
a -> forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (a -> ContT r m b
k a
a) b -> m r
c
instance Bind Complex where
(a
a :+ a
b) >>- :: forall a b. Complex a -> (a -> Complex b) -> Complex b
>>- a -> Complex b
f = b
a' forall a. a -> a -> Complex a
:+ b
b' where
b
a' :+ b
_ = a -> Complex b
f a
a
b
_ :+ b
b' = a -> Complex b
f a
b
{-# INLINE (>>-) #-}
#ifdef MIN_VERSION_containers
instance Ord k => Bind (Map k) where
Map k a
m >>- :: forall a b. Map k a -> (a -> Map k b) -> Map k b
>>- a -> Map k b
f = forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (\k
k -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Map k b
f) Map k a
m
instance Bind IntMap where
IntMap a
m >>- :: forall a b. IntMap a -> (a -> IntMap b) -> IntMap b
>>- a -> IntMap b
f = forall a b. (Key -> a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybeWithKey (\Key
k -> forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
k forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> IntMap b
f) IntMap a
m
instance Bind Seq where
>>- :: forall a b. Seq a -> (a -> Seq b) -> Seq b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Tree where
>>- :: forall a b. Tree a -> (a -> Tree b) -> Tree b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
#endif
#ifdef MIN_VERSION_unordered_containers
instance (Hashable k, Eq k) => Bind (HashMap k) where
HashMap k a
m >>- :: forall a b. HashMap k a -> (a -> HashMap k b) -> HashMap k b
>>- a -> HashMap k b
f = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ do
(k
k, a
a) <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k a
m
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
k (a -> HashMap k b
f a
a) of
Just b
b -> [(k
k,b
b)]
Maybe b
Nothing -> []
#endif
instance Bind Down where Down a
a >>- :: forall a b. Down a -> (a -> Down b) -> Down b
>>- a -> Down b
f = a -> Down b
f a
a
instance Bind Monoid.Sum where >>- :: forall a b. Sum a -> (a -> Sum b) -> Sum b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Monoid.Product where >>- :: forall a b. Product a -> (a -> Product b) -> Product b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Monoid.Dual where >>- :: forall a b. Dual a -> (a -> Dual b) -> Dual b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Monoid.First where >>- :: forall a b. First a -> (a -> First b) -> First b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Monoid.Last where >>- :: forall a b. Last a -> (a -> Last b) -> Last b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind f => Bind (Monoid.Alt f) where
Monoid.Alt f a
m >>- :: forall a b. Alt f a -> (a -> Alt f b) -> Alt f b
>>- a -> Alt f b
k = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt (f a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Alt f b
k)
instance Bind Semigroup.First where >>- :: forall a b. First a -> (a -> First b) -> First b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Semigroup.Last where >>- :: forall a b. Last a -> (a -> Last b) -> Last b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Semigroup.Min where >>- :: forall a b. Min a -> (a -> Min b) -> Min b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Semigroup.Max where >>- :: forall a b. Max a -> (a -> Max b) -> Max b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind Generics.V1 where
V1 a
m >>- :: forall a b. V1 a -> (a -> V1 b) -> V1 b
>>- a -> V1 b
_ = case V1 a
m of {}
instance Bind Generics.U1 where >>- :: forall a b. U1 a -> (a -> U1 b) -> U1 b
(>>-)=forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Bind f => Bind (Generics.M1 i c f) where
M1 f a
m >>- :: forall a b. M1 i c f a -> (a -> M1 i c f b) -> M1 i c f b
>>- a -> M1 i c f b
f = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall a b. (a -> b) -> a -> b
$ f a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
a -> case a -> M1 i c f b
f a
a of
M1 f b
m' -> f b
m'
instance Bind m => Bind (Generics.Rec1 m) where
Rec1 m a
m >>- :: forall a b. Rec1 m a -> (a -> Rec1 m b) -> Rec1 m b
>>- a -> Rec1 m b
f = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall a b. (a -> b) -> a -> b
$ m a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
a -> case a -> Rec1 m b
f a
a of
Rec1 m b
m' -> m b
m'
instance Bind Generics.Par1 where
Par1 a
m >>- :: forall a b. Par1 a -> (a -> Par1 b) -> Par1 b
>>- a -> Par1 b
f = a -> Par1 b
f a
m
instance (Bind f, Bind g) => Bind (f :*: g) where
f a
m :*: g a
n >>- :: forall a b. (:*:) f g a -> (a -> (:*:) f g b) -> (:*:) f g b
>>- a -> (:*:) f g b
f = (f a
m forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> f p
fstP forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> (:*:) f g b
f) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g a
n forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> g p
sndP forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> (:*:) f g b
f) where
fstP :: (:*:) f g p -> f p
fstP (f p
a :*: g p
_) = f p
a
sndP :: (:*:) f g p -> g p
sndP (f p
_ :*: g p
b) = g p
b
infixl 4 <<.>>, <<., .>>
class Bifunctor p => Biapply p where
(<<.>>) :: p (a -> b) (c -> d) -> p a c -> p b d
(.>>) :: p a b -> p c d -> p c d
p a b
a .>> p c d
b = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) forall a b. (a -> b) -> a -> b
<<$>> p a b
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p c d
b
{-# INLINE (.>>) #-}
(<<.) :: p a b -> p c d -> p a b
p a b
a <<. p c d
b = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. a -> b -> a
const forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
<<$>> p a b
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p c d
b
{-# INLINE (<<.) #-}
instance Biapply (,) where
(a -> b
f, c -> d
g) <<.>> :: forall a b c d. (a -> b, c -> d) -> (a, c) -> (b, d)
<<.>> (a
a, c
b) = (a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<.>>) #-}
instance Biapply Arg where
Arg a -> b
f c -> d
g <<.>> :: forall a b c d. Arg (a -> b) (c -> d) -> Arg a c -> Arg b d
<<.>> Arg a
a c
b = forall a b. a -> b -> Arg a b
Arg (a -> b
f a
a) (c -> d
g c
b)
{-# INLINE (<<.>>) #-}
instance Semigroup x => Biapply ((,,) x) where
(x
x, a -> b
f, c -> d
g) <<.>> :: forall a b c d. (x, a -> b, c -> d) -> (x, a, c) -> (x, b, d)
<<.>> (x
x', a
a, c
b) = (x
x forall a. Semigroup a => a -> a -> a
<> x
x', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<.>>) #-}
instance (Semigroup x, Semigroup y) => Biapply ((,,,) x y) where
(x
x, y
y, a -> b
f, c -> d
g) <<.>> :: forall a b c d.
(x, y, a -> b, c -> d) -> (x, y, a, c) -> (x, y, b, d)
<<.>> (x
x', y
y', a
a, c
b) = (x
x forall a. Semigroup a => a -> a -> a
<> x
x', y
y forall a. Semigroup a => a -> a -> a
<> y
y', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<.>>) #-}
instance (Semigroup x, Semigroup y, Semigroup z) => Biapply ((,,,,) x y z) where
(x
x, y
y, z
z, a -> b
f, c -> d
g) <<.>> :: forall a b c d.
(x, y, z, a -> b, c -> d) -> (x, y, z, a, c) -> (x, y, z, b, d)
<<.>> (x
x', y
y', z
z', a
a, c
b) = (x
x forall a. Semigroup a => a -> a -> a
<> x
x', y
y forall a. Semigroup a => a -> a -> a
<> y
y', z
z forall a. Semigroup a => a -> a -> a
<> z
z', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<.>>) #-}
instance Biapply Const where
Const a -> b
f <<.>> :: forall a b c d. Const (a -> b) (c -> d) -> Const a c -> Const b d
<<.>> Const a
x = forall {k} a (b :: k). a -> Const a b
Const (a -> b
f a
x)
{-# INLINE (<<.>>) #-}
#ifdef MIN_VERSION_tagged
instance Biapply Tagged where
Tagged c -> d
f <<.>> :: forall a b c d.
Tagged (a -> b) (c -> d) -> Tagged a c -> Tagged b d
<<.>> Tagged c
x = forall {k} (s :: k) b. b -> Tagged s b
Tagged (c -> d
f c
x)
{-# INLINE (<<.>>) #-}
#endif
instance (Biapply p, Apply f, Apply g) => Biapply (Biff p f g) where
Biff p (f (a -> b)) (g (c -> d))
fg <<.>> :: forall a b c d.
Biff p f g (a -> b) (c -> d) -> Biff p f g a c -> Biff p f g b d
<<.>> Biff p (f a) (g c)
xy = forall {k} {k1} {k2} {k3} (p :: k -> k1 -> *) (f :: k2 -> k)
(g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) p (f (a -> b)) (g (c -> d))
fg forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p (f a) (g c)
xy)
{-# INLINE (<<.>>) #-}
instance Apply f => Biapply (Clown f) where
Clown f (a -> b)
fg <<.>> :: forall a b c d.
Clown f (a -> b) (c -> d) -> Clown f a c -> Clown f b d
<<.>> Clown f a
xy = forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f (a -> b)
fg forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
xy)
{-# INLINE (<<.>>) #-}
instance Biapply p => Biapply (Flip p) where
Flip p (c -> d) (a -> b)
fg <<.>> :: forall a b c d.
Flip p (a -> b) (c -> d) -> Flip p a c -> Flip p b d
<<.>> Flip p c a
xy = forall {k} {k1} (p :: k -> k1 -> *) (a :: k1) (b :: k).
p b a -> Flip p a b
Flip (p (c -> d) (a -> b)
fg forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p c a
xy)
{-# INLINE (<<.>>) #-}
instance Apply g => Biapply (Joker g) where
Joker g (c -> d)
fg <<.>> :: forall a b c d.
Joker g (a -> b) (c -> d) -> Joker g a c -> Joker g b d
<<.>> Joker g c
xy = forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (g (c -> d)
fg forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> g c
xy)
{-# INLINE (<<.>>) #-}
instance Biapply p => Apply (Join p) where
Join p (a -> b) (a -> b)
f <.> :: forall a b. Join p (a -> b) -> Join p a -> Join p b
<.> Join p a a
a = forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p (a -> b) (a -> b)
f forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p a a
a)
{-# INLINE (<.>) #-}
Join p a a
a .> :: forall a b. Join p a -> Join p b -> Join p b
.> Join p b b
b = forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p a a
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p a b -> p c d -> p c d
.>> p b b
b)
{-# INLINE (.>) #-}
Join p a a
a <. :: forall a b. Join p a -> Join p b -> Join p a
<. Join p b b
b = forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p a a
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p a b -> p c d -> p a b
<<. p b b
b)
{-# INLINE (<.) #-}
instance (Biapply p, Biapply q) => Biapply (Bifunctor.Product p q) where
Bifunctor.Pair p (a -> b) (c -> d)
w q (a -> b) (c -> d)
x <<.>> :: forall a b c d.
Product p q (a -> b) (c -> d) -> Product p q a c -> Product p q b d
<<.>> Bifunctor.Pair p a c
y q a c
z = forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
(b :: k1).
f a b -> g a b -> Product f g a b
Bifunctor.Pair (p (a -> b) (c -> d)
w forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p a c
y) (q (a -> b) (c -> d)
x forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> q a c
z)
{-# INLINE (<<.>>) #-}
instance (Apply f, Biapply p) => Biapply (Tannen f p) where
Tannen f (p (a -> b) (c -> d))
fg <<.>> :: forall a b c d.
Tannen f p (a -> b) (c -> d) -> Tannen f p a c -> Tannen f p b d
<<.>> Tannen f (p a c)
xy = forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
(b :: k2).
f (p a b) -> Tannen f p a b
Tannen (forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
(<<.>>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p (a -> b) (c -> d))
fg forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (p a c)
xy)
{-# INLINE (<<.>>) #-}
instance Biapply p => Biapply (WrappedBifunctor p) where
WrapBifunctor p (a -> b) (c -> d)
fg <<.>> :: forall a b c d.
WrappedBifunctor p (a -> b) (c -> d)
-> WrappedBifunctor p a c -> WrappedBifunctor p b d
<<.>> WrapBifunctor p a c
xy = forall {k} {k1} (p :: k -> k1 -> *) (a :: k) (b :: k1).
p a b -> WrappedBifunctor p a b
WrapBifunctor (p (a -> b) (c -> d)
fg forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p a c
xy)
{-# INLINE (<<.>>) #-}