{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2018 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- This module is used to resolve the cyclic we get from defining these
-- classes here rather than in a package upstream. Otherwise we'd get
-- orphaned heads for many instances on the types in @transformers@ and @bifunctors@.
----------------------------------------------------------------------------
module Data.Functor.Bind.Class (
  -- * Applyable functors
    Apply(..)
  -- * Wrappers
  , WrappedApplicative(..)
  , MaybeApply(..)
  , (<.*>)
  , (<*.>)
  , traverse1Maybe
  -- * Bindable functors
  , Bind(..)
  , apDefault
  , returning
  -- * Biappliable bifunctors
  , 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 <.>, <., .>

-- | A strong lax semi-monoidal endofunctor.
-- This is equivalent to an 'Applicative' without 'pure'.
--
-- Laws:
--
-- @
-- ('.') '<$>' u '<.>' v '<.>' w = u '<.>' (v '<.>' w)
-- x '<.>' (f '<$>' y) = ('.' f) '<$>' x '<.>' y
-- f '<$>' (x '<.>' y) = (f '.') '<$>' x '<.>' y
-- @
--
-- The laws imply that `.>` and `<.` really ignore their
-- left and right results, respectively, and really
-- return their right and left results, respectively.
-- Specifically,
--
-- @
-- (mf '<$>' m) '.>' (nf '<$>' n) = nf '<$>' (m '.>' n)
-- (mf '<$>' m) '<.' (nf '<$>' n) = mf '<$>' (m '<.' n)
-- @
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

  -- | @ a '.>' b = 'const' 'id' '<$>' a '<.>' b @
  (.>) :: 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

  -- | @ a '<.' b = 'const' '<$>' a '<.>' 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

  -- | Lift a binary function into a comonad with zipping
  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)

-- | A @'Constant' f@ is not 'Applicative' unless its @f@ is a 'Monoid', but it is an instance of 'Apply'
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)

-- | A @'(,)' m@ is not 'Applicative' unless its @m@ is a 'Monoid', but it is an instance of 'Apply'
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

-- | A @'Const' m@ is not 'Applicative' unless its @m@ is a 'Monoid', but it is an instance of 'Apply'
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

-- Applicative Q was only added in template-haskell 2.7 (GHC 7.4), so
-- define in terms of Monad instead.
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
-- | A 'Map k' is not 'Applicative', but it is an instance of 'Apply'
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)

-- | An 'IntMap' is not 'Applicative', but it is an instance of 'Apply'
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
-- | A 'HashMap k' is not 'Applicative', but it is an instance of 'Apply'
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

-- MaybeT is _not_ the same as Compose f Maybe
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))
-- ErrorT e is _not_ the same as Compose f (Either e)
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

-- unfortunately, WriterT has its wrapped product in the wrong order to just use (<.>) instead of flap
-- | A @'Strict.WriterT' w m@ is not 'Applicative' unless its @w@ is a 'Monoid', but it is an instance of 'Apply'
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)

-- | A @'Lazy.WriterT' w m@ is not 'Applicative' unless its @w@ is a 'Monoid', but it is an instance of 'Apply'
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)
-- | @since 5.3.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

-- | An @'Strict.RWST' r w s m@ is not 'Applicative' unless its @w@ is a 'Monoid', but it is an instance of 'Apply'
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

-- | An @'Lazy.RWST' r w s m@ is not 'Applicative' unless its @w@ is a 'Monoid', but it is an instance of 'Apply'
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)
-- | @since 5.3.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
-- | An @'EnvT' e w@ is not 'Applicative' unless its @e@ is a 'Monoid', but it is an instance of 'Apply'
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)

-- | A @'StoreT' s w@ is not 'Applicative' unless its @s@ is a 'Monoid', but it is an instance of 'Apply'
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

-- | Wrap an 'Applicative' to be used as a member of 'Apply'
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)

-- | Transform an Apply into an Applicative by adding a unit.
newtype MaybeApply f a = MaybeApply { forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply :: Either (f a) a }

-- | Apply a non-empty container of functions to a possibly-empty-with-unit container of values.
(<.*>) :: (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 a possibly-empty-with-unit container of functions to a non-empty container of values.
(<*.>) :: (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 <*.>

-- | Traverse a 'Traversable' using 'Apply', getting the results back in a 'MaybeApply'.
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)
-- in GHC 8.6 we'll have to deal with Apply f => Apply (Ap f) the same way
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
(<*)

-- | A @'K1' i c@ is not 'Applicative' unless its @c@ is a 'Monoid', but it is an instance of 'Apply'
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
(<*)

-- | A 'V1' is not 'Applicative', but it is an instance of 'Apply'
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 {}

-- | A 'Monad' sans 'return'.
--
-- Minimal definition: Either 'join' or '>>-'
--
-- If defining both, then the following laws (the default definitions) must hold:
--
-- > join = (>>- id)
-- > m >>- f = join (fmap f m)
--
-- Laws:
--
-- > induced definition of <.>: f <.> x = f >>- (<$> x)
--
-- Finally, there are two associativity conditions:
--
-- > associativity of (>>-):    (m >>- f) >>- g == m >>- (\x -> f x >>- g)
-- > associativity of join:     join . join = join . fmap join
--
-- These can both be seen as special cases of the constraint that
--
-- > associativity of (->-): (f ->- g) ->- h = f ->- (g ->- h)
--

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

-- | A @'(,)' m@ is not a 'Monad' unless its @m@ is a 'Monoid', but it is an instance of 'Bind'
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
(>>=) -- distributive law requires Monad to inject @Nothing@

#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
(>>=) -- distributive law requires Monad to inject @[]@

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

-- | A @'Lazy.WriterT' w m@ is not a 'Monad' unless its @w@ is a 'Monoid', but it is an instance of 'Bind'
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')

-- | A @'Strict.WriterT' w m@ is not a 'Monad' unless its @w@ is a 'Monoid', but it is an instance of 'Bind'
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)
-- | @since 5.3.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'

-- | An @'Lazy.RWST' r w s m@ is not a 'Monad' unless its @w@ is a 'Monoid', but it is an instance of 'Bind'
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')

-- | An @'Strict.RWST' r w s m@ is not a 'Monad' unless its @w@ is a 'Monoid', but it is an instance of 'Bind'
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)
-- | @since 5.3.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
-- | A 'Map k' is not a 'Monad', but it is an instance of 'Bind'
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

-- | An 'IntMap' is not a 'Monad', but it is an instance of 'Bind'
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
-- | A 'HashMap k' is not a 'Monad', but it is an instance of 'Bind'
instance (Hashable k, Eq k) => Bind (HashMap k) where
  -- this is needlessly painful
  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)
-- in GHC 8.6 we'll have to deal with Bind f => Bind (Ap f) the same way
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
(>>=)
-- | A 'V1' is not a 'Monad', but it is an instance of 'Bind'
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 {}

-- | @since 5.3.8
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
(>>=)

-- | @since 5.3.8
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'

-- | @since 5.3.8
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'

-- | @since 5.3.8
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

-- | @since 5.3.8
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

  -- |
  -- @
  -- a '.>' b ≡ 'const' 'id' '<$>' a '<.>' b
  -- @
  (.>>) :: 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 (.>>) #-}

  -- |
  -- @
  -- a '<.' b ≡ 'const' '<$>' a '<.>' b
  -- @
  (<<.) :: 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 (<<.>>) #-}

-- orphan mess
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 (<<.>>) #-}