{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE EmptyCase #-}
#endif

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710
{-# OPTIONS_GHC -fno-warn-amp #-}
#endif

{-# OPTIONS_GHC -fno-warn-deprecations #-}

-----------------------------------------------------------------------------
-- |
-- 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.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.Semigroup as Semigroup
import qualified Data.Monoid as Monoid
import Data.Orphans ()
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

#if MIN_VERSION_base(4,6,0)
import Data.Ord (Down (..))
#else
import GHC.Exts (Down (..))
#endif


#if MIN_VERSION_base(4,4,0)
import Data.Complex
#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

#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)
import Data.Proxy
#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_generic_deriving
import Generics.Deriving.Base as Generics
#else
import GHC.Generics as Generics
#endif

#if __GLASGOW_HASKELL__ < 710
import Data.Traversable
#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
  (<.>) = ((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (a -> b) -> a -> b
forall a. a -> a
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 = (b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> b -> b) -> f a -> f (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> b) -> f b -> f b
forall a b. f (a -> b) -> f a -> f b
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 = a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> f a -> f (b -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> a) -> f b -> f a
forall a b. f (a -> b) -> f a -> f b
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 (a -> b -> c) -> f a -> f (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> c) -> f b -> f c
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
b
  {-# INLINE liftF2 #-}

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
  {-# MINIMAL (<.>) | liftF2 #-}
#endif

#ifdef MIN_VERSION_tagged
instance Apply (Tagged a) where
  <.> :: forall a b. Tagged a (a -> b) -> Tagged a a -> Tagged a b
(<.>) = Tagged a (a -> b) -> Tagged a a -> Tagged a b
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
(<.) = Tagged a a -> Tagged a b -> Tagged a a
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
(.>) = Tagged a a -> Tagged a b -> Tagged a b
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

#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)
instance Apply Proxy where
  <.> :: forall a b. Proxy (a -> b) -> Proxy a -> Proxy b
(<.>) = Proxy (a -> b) -> Proxy a -> Proxy b
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
(<.) = Proxy a -> Proxy b -> Proxy a
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
(.>) = Proxy a -> Proxy b -> Proxy b
forall a b. Proxy a -> Proxy b -> Proxy b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#endif

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 = f b -> Backwards f b
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> (a -> b) -> b) -> f a -> f ((a -> b) -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f ((a -> b) -> b) -> f (a -> b) -> f b
forall a b. f (a -> b) -> f a -> f b
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 = f (g b) -> Compose f g b
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) (g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a -> g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
f f (g a -> g b) -> f (g a) -> f (g b)
forall a b. f (a -> b) -> f a -> f b
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 = f -> Constant f b
forall {k} a (b :: k). a -> Constant a b
Constant (f
a f -> f -> f
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 = f -> Constant f a
forall {k} a (b :: k). a -> Constant a b
Constant (f
a f -> f -> f
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 = f -> Constant f b
forall {k} a (b :: k). a -> Constant a b
Constant (f
a f -> f -> f
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  = b -> Lift f b
forall (f :: * -> *) a. a -> Lift f a
Pure (a -> b
f a
x)
  Pure a -> b
f  <.> Other f a
y = f b -> Lift f b
forall (f :: * -> *) a. f a -> Lift f a
Other (a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
y)
  Other f (a -> b)
f <.> Pure a
x  = f b -> Lift f b
forall (f :: * -> *) a. f a -> Lift f a
Other (((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> b) -> b) -> f (a -> b) -> f b
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 = f b -> Lift f b
forall (f :: * -> *) a. f a -> Lift f a
Other (f (a -> b)
f f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 = f b -> g b -> Product f g b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (f (a -> b)
f f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
x) (g (a -> b)
g g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g b
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 = f b -> Reverse f b
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f (a -> b)
a f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 m -> 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 m -> 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 m -> 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
(<.>) = 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
_       = a -> Either a b
forall a b. a -> Either a b
Left a
a
  Right a -> b
_ <.> Left a
a  = a -> Either a b
forall a b. a -> Either a b
Left a
a
  Right a -> b
f <.> Right a
b = b -> Either 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
_       = a -> Either a a
forall a b. a -> Either a b
Left a
a
  Right a
_ <.  Left a
a  = a -> Either a a
forall a b. a -> Either a b
Left a
a
  Right a
a <.  Right b
_ = a -> Either a a
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
_       = a -> Either a b
forall a b. a -> Either a b
Left a
a
  Right a
_  .> Left a
a  = a -> Either a b
forall a b. a -> Either a b
Left a
a
  Right a
_  .> Right b
b = b -> Either a 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 = m -> Const m b
forall {k} a (b :: k). a -> Const a b
Const (m
m m -> 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 = m -> Const m a
forall {k} a (b :: k). a -> Const a b
Const (m
m m -> 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 = m -> Const m b
forall {k} a (b :: k). a -> Const a b
Const (m
m m -> 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
(<.>) = (m -> a -> b) -> (m -> a) -> m -> b
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
(<.>) = ZipList (a -> b) -> ZipList a -> ZipList b
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]
(<.>) = [a -> b] -> [a] -> [b]
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
(<.>) = IO (a -> b) -> IO a -> IO b
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
(<.>) = Maybe (a -> b) -> Maybe a -> Maybe b
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
(<.>) = Identity (a -> b) -> Identity a -> Identity b
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 = w b -> IdentityT w b
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (w (a -> b)
wa w (a -> b) -> w a -> w b
forall a b. w (a -> b) -> w a -> w b
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
(<.>) = WrappedMonad m (a -> b) -> WrappedMonad m a -> WrappedMonad m b
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
(<.>) = WrappedArrow a b (a -> b)
-> WrappedArrow a b a -> WrappedArrow a b b
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
(<*>)
  (<. ) = (<* )
  ( .>) = ( *>)

#if MIN_VERSION_base(4,4,0)
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 b -> b -> Complex b
forall a. a -> a -> Complex a
:+ a -> b
b a
d
#endif

-- 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
(<.>) = 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
(<.>) = ((a -> b) -> 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 (a -> b) -> a -> b
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  (<. ) = (a -> b -> a) -> Map k a -> Map k b -> Map k a
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith a -> b -> a
forall a b. a -> b -> a
const
  ( .>) = (a -> b -> b) -> Map k a -> Map k b -> Map k b
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
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
(<.>) = ((a -> b) -> a -> b) -> IntMap (a -> b) -> IntMap a -> IntMap b
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith (a -> b) -> a -> b
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  (<. ) = (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith a -> b -> a
forall a b. a -> b -> a
const
  ( .>) = (a -> b -> b) -> IntMap a -> IntMap b -> IntMap b
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
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
(<.>) = 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
(<.>) = Tree (a -> b) -> Tree a -> Tree b
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
(<.>) = ((a -> b) -> 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 (a -> b) -> a -> b
forall a. a -> a
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
(<.>) = 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
(<.>) = 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 = m [b] -> ListT m b
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [b] -> ListT m b) -> m [b] -> ListT m b
forall a b. (a -> b) -> a -> b
$ [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) ([a -> b] -> [a] -> [b]) -> m [a -> b] -> m ([a] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a -> b]
f m ([a] -> [b]) -> m [a] -> m [b]
forall a b. m (a -> b) -> m a -> m b
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
(<.>) = 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 = (e -> m b) -> ReaderT e m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m b) -> ReaderT e m b) -> (e -> m b) -> ReaderT e m b
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> m (a -> b)
f e
e m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
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 = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ (a -> b, w) -> (a, w) -> (b, w)
forall {b} {t} {a}. Semigroup b => (t -> a, b) -> (t, b) -> (a, b)
flap ((a -> b, w) -> (a, w) -> (b, w))
-> m (a -> b, w) -> m ((a, w) -> (b, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, w)
f m ((a, w) -> (b, w)) -> m (a, w) -> m (b, w)
forall a b. m (a -> b) -> m a -> m b
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 b -> b -> b
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 = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ (a -> b, w) -> (a, w) -> (b, w)
forall {b} {t} {a}. Semigroup b => (t -> a, b) -> (t, b) -> (a, b)
flap ((a -> b, w) -> (a, w) -> (b, w))
-> m (a -> b, w) -> m ((a, w) -> (b, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, w)
f m ((a, w) -> (b, w)) -> m (a, w) -> m (b, w)
forall a b. m (a -> b) -> m a -> m b
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 b -> b -> b
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 = (w -> m (b, w)) -> WriterT w m b
forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT ((w -> m (b, w)) -> WriterT w m b)
-> (w -> m (b, w)) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ \w
w ->
    WriterT w m (a -> b) -> w -> m (a -> b, w)
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w m (a -> b)
mf w
w m (a -> b, w) -> ((a -> b, w) -> m (b, w)) -> m (b, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a -> b
f, w
w') -> WriterT w m b -> w -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT (a -> b
f (a -> b) -> WriterT w m a -> WriterT w m b
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
(<.>) = 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
(<.>) = 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
(<.>) = 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
(<.>) = 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 = (r -> s -> w -> m (b, s, w)) -> RWST r w s m b
forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST ((r -> s -> w -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> w -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \ r
r s
s w
w ->
    RWST r w s m (a -> b) -> r -> s -> w -> m (a -> b, s, 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 m (a -> b, s, w) -> ((a -> b, s, w) -> m (b, s, w)) -> m (b, s, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a -> b
f, s
s', w
w') -> RWST r w s m b -> r -> s -> w -> m (b, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST (a -> b
f (a -> b) -> RWST r w s m a -> RWST r w s m b
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 = ((b -> m r) -> m r) -> ContT r m b
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((b -> m r) -> m r) -> ContT r m b)
-> ((b -> m r) -> m r) -> ContT r m b
forall a b. (a -> b) -> a -> b
$ \b -> m r
k -> ((a -> b) -> m r) -> m r
f (((a -> b) -> m r) -> m r) -> ((a -> b) -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \a -> b
g -> (a -> m r) -> m r
v (b -> m r
k (b -> m r) -> (a -> b) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 = e -> w b -> EnvT e w b
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT (e
ef e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
ea) (w (a -> b)
wf w (a -> b) -> w a -> w b
forall a b. w (a -> b) -> w a -> w b
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 = w (s -> b) -> s -> StoreT s w b
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT ((s -> a -> b) -> (s -> a) -> s -> b
forall a b. (s -> a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((s -> a -> b) -> (s -> a) -> s -> b)
-> w (s -> a -> b) -> w ((s -> a) -> s -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (s -> a -> b)
ff w ((s -> a) -> s -> b) -> w (s -> a) -> w (s -> b)
forall a b. w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> w (s -> a)
fa) (s
m s -> s -> s
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 = w (m -> b) -> TracedT m w b
forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT ((m -> a -> b) -> (m -> a) -> m -> b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap ((m -> a -> b) -> (m -> a) -> m -> b)
-> w (m -> a -> b) -> w ((m -> a) -> m -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (m -> a -> b)
wf w ((m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
forall a b. w (a -> b) -> w a -> w b
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) = f b -> WrappedApplicative f b
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (a -> b
f (a -> b) -> f a -> f b
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 = f b -> WrappedApplicative f b
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (a -> b)
f f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a f a -> f b -> f a
forall a b. f a -> f b -> f 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 = f b -> WrappedApplicative f b
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a  f a -> f b -> f b
forall a b. f a -> f b -> f b
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 = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a -> WrappedApplicative f a)
-> (a -> f a) -> a -> WrappedApplicative f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f a
forall a. a -> f a
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 = f b -> WrappedApplicative f b
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (a -> b)
f f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a f a -> f b -> f a
forall a b. f a -> f b -> f 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 = f b -> WrappedApplicative f b
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a  f a -> f b -> f b
forall a b. f a -> f b -> f b
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 = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative f a
forall a. f a
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 = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a f a -> f a -> f a
forall a. f a -> f a -> f 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 f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa
f (a -> b)
ff <.*> MaybeApply (Right a
a) = ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) ((a -> b) -> b) -> f (a -> b) -> f b
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 f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 (a -> b) -> f a -> f b
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 = (a -> MaybeApply f b) -> t a -> MaybeApply f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (f b) b -> MaybeApply f b)
-> (a -> Either (f b) b) -> a -> MaybeApply f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f b -> Either (f b) b
forall a b. a -> Either a b
Left (f b -> Either (f b) b) -> (a -> f b) -> a -> Either (f b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (b -> Either (f b) b
forall a b. b -> Either a b
Right (a -> b
f     a
a ))
  fmap a -> b
f (MaybeApply (Left f a
fa)) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left  (a -> b
f (a -> b) -> f a -> f b
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) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (b -> Either (f b) b
forall a b. b -> Either a b
Right (a -> b
f         a
a ))
  MaybeApply (Right a -> b
f) <.> MaybeApply (Left f a
fa) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left  (a -> b
f     (a -> b) -> f a -> f b
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) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left  (((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) ((a -> b) -> b) -> f (a -> b) -> f b
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) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left  (f (a -> b)
ff    f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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
_) = Either (f a) a -> MaybeApply f a
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) = Either (f a) a -> MaybeApply f a
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f a -> Either (f a) a
forall a b. a -> Either a b
Left (a
a  a -> f b -> f a
forall a b. a -> f b -> f 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) = Either (f a) a -> MaybeApply f a
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f a -> Either (f a) a
forall a b. a -> Either a b
Left (f a
fa f a -> f b -> f a
forall a b. f a -> f b -> f a
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 = Either (f b) b -> MaybeApply f 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) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left (f a
fa f a -> b -> f b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
b ))
  MaybeApply (Left f a
fa) .> MaybeApply (Left f b
fb) = Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f b -> Either (f b) b
forall a b. a -> Either a b
Left (f a
fa f a -> f b -> f b
forall a b. f a -> f b -> f b
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 = Either (f a) a -> MaybeApply f a
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (a -> Either (f a) a
forall a b. b -> Either a b
Right a
a)
  <*> :: forall a b.
MaybeApply f (a -> b) -> MaybeApply f a -> MaybeApply f b
(<*>) = MaybeApply f (a -> b) -> MaybeApply f a -> MaybeApply f b
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{}) = Either (f (MaybeApply f a)) (MaybeApply f a)
-> MaybeApply f (MaybeApply f a)
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (MaybeApply f a -> Either (f (MaybeApply f a)) (MaybeApply f a)
forall a b. b -> Either a b
Right MaybeApply f a
w)
  duplicated (MaybeApply (Left f a
fa)) = Either (f (MaybeApply f a)) (MaybeApply f a)
-> MaybeApply f (MaybeApply f a)
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f (MaybeApply f a) -> Either (f (MaybeApply f a)) (MaybeApply f a)
forall a b. a -> Either a b
Left ((f a -> MaybeApply f a) -> f a -> f (MaybeApply f a)
forall a b. (f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Either (f a) a -> MaybeApply f a
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (f a) a -> MaybeApply f a)
-> (f a -> Either (f a) a) -> f a -> MaybeApply f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Either (f a) a
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{}) = Either (f (MaybeApply f a)) (MaybeApply f a)
-> MaybeApply f (MaybeApply f a)
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (MaybeApply f a -> Either (f (MaybeApply f a)) (MaybeApply f a)
forall a b. b -> Either a b
Right MaybeApply f a
w)
  duplicate (MaybeApply (Left f a
fa)) = Either (f (MaybeApply f a)) (MaybeApply f a)
-> MaybeApply f (MaybeApply f a)
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (f (MaybeApply f a) -> Either (f (MaybeApply f a)) (MaybeApply f a)
forall a b. a -> Either a b
Left ((f a -> MaybeApply f a) -> f a -> f (MaybeApply f a)
forall a b. (f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Either (f a) a -> MaybeApply f a
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (f a) a -> MaybeApply f a)
-> (f a -> Either (f a) a) -> f a -> MaybeApply f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Either (f a) a
forall a b. a -> Either a b
Left) f a
fa))
  extract :: forall a. MaybeApply f a -> a
extract (MaybeApply (Left f a
fa)) = f a -> a
forall a. f a -> a
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 = (w a -> b) -> Cokleisli w a b
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
(<.>)=Down (a -> b) -> Down a -> Down b
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
(.>)=Down a -> Down b -> Down 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
(<.)=Down a -> Down b -> Down a
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
(<.>)=Sum (a -> b) -> Sum a -> Sum b
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
(.>)=Sum a -> Sum b -> Sum 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
(<.)=Sum a -> Sum b -> Sum a
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
(<.>)=Product (a -> b) -> Product a -> Product b
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
(.>)=Product a -> Product b -> Product 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
(<.)=Product a -> Product b -> Product a
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
(<.>)=Dual (a -> b) -> Dual a -> Dual b
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
(.>)=Dual a -> Dual b -> Dual 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
(<.)=Dual a -> Dual b -> Dual a
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
(<.>)=First (a -> b) -> First a -> First b
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
(.>)=First a -> First b -> First 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
(<.)=First a -> First b -> First a
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
(<.>)=Last (a -> b) -> Last a -> Last b
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
(.>)=Last a -> Last b -> Last 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
(<.)=Last a -> Last b -> Last a
forall a b. Last a -> Last b -> Last a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
#if MIN_VERSION_base(4,8,0)
deriving instance Apply f => Apply (Monoid.Alt f)
#endif
-- 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
(<.>)=First (a -> b) -> First a -> First b
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
(.>)=First a -> First b -> First 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
(<.)=First a -> First b -> First a
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
(<.>)=Last (a -> b) -> Last a -> Last b
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
(.>)=Last a -> Last b -> Last 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
(<.)=Last a -> Last b -> Last a
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
(<.>)=Min (a -> b) -> Min a -> Min b
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
(.>)=Min a -> Min b -> Min 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
(<.)=Min a -> Min b -> Min a
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
(<.>)=Max (a -> b) -> Max a -> Max b
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
(.>)=Max a -> Max b -> Max 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
(<.)=Max a -> Max b -> Max a
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 f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
c) f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g (a -> b)
b g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g 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 = f (g b) -> (:.:) f g b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g b) -> (:.:) f g b) -> f (g b) -> (:.:) f g b
forall a b. (a -> b) -> a -> b
$ g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) (g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a -> g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
m f (g a -> g b) -> f (g a) -> f (g b)
forall a b. f (a -> b) -> f a -> f b
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
(<.>)=U1 (a -> b) -> U1 a -> U1 b
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
(.>)=U1 a -> U1 b -> U1 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
(<.)=U1 a -> U1 b -> U1 a
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 = c -> K1 i c b
forall k i c (p :: k). c -> K1 i c p
K1 (c
a c -> c -> c
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 = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c
a c -> c -> c
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 = c -> K1 i c b
forall k i c (p :: k). c -> K1 i c p
K1 (c
a c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
b)
instance Apply Par1 where <.> :: forall a b. Par1 (a -> b) -> Par1 a -> Par1 b
(<.>)=Par1 (a -> b) -> Par1 a -> Par1 b
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
(.>)=Par1 a -> Par1 b -> Par1 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
(<.)=Par1 a -> Par1 b -> Par1 a
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
#if __GLASGOW_HASKELL__ >= 708
  V1 (a -> b)
e <.> :: forall a b. V1 (a -> b) -> V1 a -> V1 b
<.> V1 a
_ = case V1 (a -> b)
e of {}
#else
  e <.> _ = e `seq` undefined
#endif

-- | 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 = m (m b) -> m b
forall a. m (m a) -> m a
forall (m :: * -> *) a. Bind m => m (m a) -> m a
join ((a -> m b) -> m a -> m (m b)
forall a b. (a -> b) -> m a -> m b
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 = (m (m a) -> (m a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- m a -> m a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)

#if __GLASGOW_HASKELL__ >= 708
  {-# MINIMAL (>>-) | join #-}
#endif

returning :: Functor f => f a -> (a -> b) -> f b
returning :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
returning = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
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 f (a -> b) -> ((a -> b) -> f b) -> f b
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a -> b
f' -> a -> b
f' (a -> b) -> f a -> f b
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 m -> 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

#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)
instance Bind Proxy where
  Proxy a
_ >>- :: forall a b. Proxy a -> (a -> Proxy b) -> Proxy b
>>- a -> Proxy b
_ = Proxy b
forall {k} (t :: k). Proxy t
Proxy
  join :: forall a. Proxy (Proxy a) -> Proxy a
join Proxy (Proxy a)
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy
#endif

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
_ = 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 = f b -> g b -> Product f g b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (f a
m f a -> (a -> f b) -> f b
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- Product f g b -> f b
forall {f :: * -> *} {g :: * -> *} {a}. Product f g a -> f a
fstP (Product f g b -> f b) -> (a -> Product f g b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 g a -> (a -> g b) -> g b
forall a b. g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- Product f g b -> g b
forall {f :: * -> *} {g :: * -> *} {a}. Product f g a -> g a
sndP (Product f g b -> g b) -> (a -> Product f g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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]
(>>-) = [a] -> (a -> [b]) -> [b]
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
(>>-) = NonEmpty a -> (a -> NonEmpty b) -> NonEmpty b
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
(>>-) = IO a -> (a -> IO b) -> IO b
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
(>>-) = Maybe a -> (a -> Maybe b) -> Maybe b
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
(>>-) = Identity a -> (a -> Identity b) -> Identity b
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
(>>-) = Q a -> (a -> Q b) -> Q b
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 = m b -> IdentityT m b
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- IdentityT m b -> m b
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m b -> m b) -> (a -> IdentityT m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 = m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b) -> m b -> WrappedMonad m b
forall a b. (a -> b) -> a -> b
$ m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WrappedMonad m b -> m b
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m b -> m b) -> (a -> WrappedMonad m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
(>>-) = MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
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
(>>-) = ListT m a -> (a -> ListT m b) -> ListT m b
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 = m (Either e b) -> ErrorT e m b
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e b) -> ErrorT e m b) -> m (Either e b) -> ErrorT e m b
forall a b. (a -> b) -> a -> b
$ do
    Either e a
a <- ErrorT e m a -> m (Either e 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 -> Either e b -> m (Either e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
l)
      Right a
r -> ErrorT e m b -> m (Either e b)
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 = m (Either e b) -> ExceptT e m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e b) -> ExceptT e m b)
-> m (Either e b) -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$ do
    Either e a
a <- ExceptT e m a -> m (Either e 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 -> Either e b -> m (Either e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
l)
      Right a
r -> ExceptT e m b -> m (Either e b)
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 = (e -> m b) -> ReaderT e m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m b) -> ReaderT e m b) -> (e -> m b) -> ReaderT e m b
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> m a
m e
e m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
x -> ReaderT e m b -> e -> m b
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 = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$
    WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
m m (a, w) -> ((a, w) -> m (b, w)) -> m (b, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, w
w) ->
    WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> WriterT w m b
k a
a) m (b, w) -> ((b, w) -> (b, w)) -> m (b, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ ~(b
b, w
w') ->
      (b
b, w
w w -> 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 = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$
    WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
m m (a, w) -> ((a, w) -> m (b, w)) -> m (b, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ (a
a, w
w) ->
    WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> WriterT w m b
k a
a) m (b, w) -> ((b, w) -> (b, w)) -> m (b, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
`returning` \ (b
b, w
w') ->
      (b
b, w
w w -> 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 = (w -> m (b, w)) -> WriterT w m b
forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT ((w -> m (b, w)) -> WriterT w m b)
-> (w -> m (b, w)) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ \ w
w ->
    WriterT w m a -> w -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w m a
m w
w m (a, w) -> ((a, w) -> m (b, w)) -> m (b, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a
a, w
w') -> WriterT w m b -> w -> m (b, 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 = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \s
s ->
    StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s m (a, s) -> ((a, s) -> m (b, s)) -> m (b, s)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s') ->
    StateT s m b -> s -> m (b, 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 = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \s
s ->
    StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s m (a, s) -> ((a, s) -> m (b, s)) -> m (b, s)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s') ->
    StateT s m b -> s -> m (b, 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 = (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    RWST r w s m a -> r -> s -> m (a, s, w)
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 m (a, s, w) -> ((a, s, w) -> m (b, s, w)) -> m (b, s, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ ~(a
a, s
s', w
w) ->
    RWST r w s m b -> r -> s -> m (b, s, 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' m (b, s, w) -> ((b, s, w) -> (b, s, w)) -> m (b, s, w)
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 w -> 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 = (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    RWST r w s m a -> r -> s -> m (a, s, w)
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 m (a, s, w) -> ((a, s, w) -> m (b, s, w)) -> m (b, s, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \ (a
a, s
s', w
w) ->
    RWST r w s m b -> r -> s -> m (b, s, 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' m (b, s, w) -> ((b, s, w) -> (b, s, w)) -> m (b, s, w)
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 w -> 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 = (r -> s -> w -> m (b, s, w)) -> RWST r w s m b
forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST ((r -> s -> w -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> w -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \ r
r s
s w
w ->
    RWST r w s m a -> r -> s -> w -> m (a, s, 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 m (a, s, w) -> ((a, s, w) -> m (b, s, w)) -> m (b, s, w)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \(a
a, s
s', w
w') -> RWST r w s m b -> r -> s -> w -> m (b, s, 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 = ((b -> m r) -> m r) -> ContT r m b
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((b -> m r) -> m r) -> ContT r m b)
-> ((b -> m r) -> m r) -> ContT r m b
forall a b. (a -> b) -> a -> b
$ \b -> m r
c -> ContT r m a -> (a -> m r) -> m r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m a
m ((a -> m r) -> m r) -> (a -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \a
a -> ContT r m b -> (b -> m r) -> m r
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

#if MIN_VERSION_base(4,4,0)
instance Bind Complex where
  (a
a :+ a
b) >>- :: forall a b. Complex a -> (a -> Complex b) -> Complex b
>>- a -> Complex b
f = b
a' b -> b -> Complex b
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 (>>-) #-}
#endif

#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 = (k -> a -> Maybe b) -> Map k a -> Map k b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (\k
k -> k -> Map k b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (Map k b -> Maybe b) -> (a -> Map k b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 = (Key -> a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (Key -> a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybeWithKey (\Key
k -> Key -> IntMap b -> Maybe b
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
k (IntMap b -> Maybe b) -> (a -> IntMap b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
(>>-) = Seq a -> (a -> Seq b) -> Seq b
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
(>>-) = Tree a -> (a -> Tree b) -> Tree b
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 = [(k, b)] -> HashMap k b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(k, b)] -> HashMap k b) -> [(k, b)] -> HashMap k b
forall a b. (a -> b) -> a -> b
$ do
    (k
k, a
a) <- HashMap k a -> [(k, a)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k a
m
    case k -> HashMap k b -> Maybe b
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
(>>-) = Sum a -> (a -> Sum b) -> Sum b
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
(>>-) = Product a -> (a -> Product b) -> Product b
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
(>>-) = Dual a -> (a -> Dual b) -> Dual b
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
(>>-) = First a -> (a -> First b) -> First b
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
(>>-) = Last a -> (a -> Last b) -> Last b
forall a b. Last a -> (a -> Last b) -> Last b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
#if MIN_VERSION_base(4,8,0)
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 = f b -> Alt f b
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt (f a
m f a -> (a -> f b) -> f b
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- Alt f b -> f b
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt (Alt f b -> f b) -> (a -> Alt f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)
#endif
-- 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
(>>-) = First a -> (a -> First b) -> First b
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
(>>-) = Last a -> (a -> Last b) -> Last b
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
(>>-) = Min a -> (a -> Min b) -> Min b
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
(>>-) = Max a -> (a -> Max b) -> Max b
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
#if __GLASGOW_HASKELL__ >= 708
  V1 a
m >>- :: forall a b. V1 a -> (a -> V1 b) -> V1 b
>>- a -> V1 b
_ = case V1 a
m of {}
#else
  m >>- _ = m `seq` undefined
#endif

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 = (a -> c -> c) -> (b -> d -> d) -> p a b -> p (c -> c) (d -> d)
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((c -> c) -> a -> c -> c
forall a b. a -> b -> a
const c -> c
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) ((d -> d) -> b -> d -> d
forall a b. a -> b -> a
const d -> d
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (p a b -> p (c -> c) (d -> d)) -> p a b -> p (c -> c) (d -> d)
forall a b. (a -> b) -> a -> b
<<$>> p a b
a p (c -> c) (d -> d) -> p c d -> p c d
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 = (a -> c -> a) -> (b -> d -> b) -> p a b -> p (c -> a) (d -> b)
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> c -> a
forall a b. a -> b -> a
const b -> d -> b
forall a b. a -> b -> a
const (p a b -> p (c -> a) (d -> b)) -> p a b -> p (c -> a) (d -> b)
forall a b. (a -> b) -> a -> b
<<$>> p a b
a p (c -> a) (d -> b) -> p c d -> p a b
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 = b -> d -> Arg b d
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 x -> 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 x -> x -> x
forall a. Semigroup a => a -> a -> a
<> x
x', y
y y -> 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 x -> x -> x
forall a. Semigroup a => a -> a -> a
<> x
x', y
y y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
y', z
z z -> 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 = b -> Const b d
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 = d -> Tagged b d
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 = p (f b) (g d) -> Biff p f g b d
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 ((f (a -> b) -> f a -> f b)
-> (g (c -> d) -> g c -> g d)
-> p (f (a -> b)) (g (c -> d))
-> p (f a -> f b) (g c -> g d)
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) g (c -> d) -> g c -> g d
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) p (f (a -> b)) (g (c -> d))
fg p (f a -> f b) (g c -> g d) -> p (f a) (g c) -> p (f b) (g d)
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 = f b -> Clown f b d
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f (a -> b)
fg f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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 = p d b -> Flip p b d
forall {k} {k1} (p :: k -> k1 -> *) (a :: k1) (b :: k).
p b a -> Flip p a b
Flip (p (c -> d) (a -> b)
fg p (c -> d) (a -> b) -> p c a -> p d b
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 = g d -> Joker g b d
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (g (c -> d)
fg g (c -> d) -> g c -> g d
forall a b. g (a -> b) -> g a -> g b
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 = p b b -> Join p b
forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p (a -> b) (a -> b)
f p (a -> b) (a -> b) -> p a a -> p b b
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 = p b b -> Join p b
forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p a a
a p a a -> p b b -> p b b
forall a b c d. p a b -> p c d -> p c d
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 = p a a -> Join p a
forall {k} (p :: k -> k -> *) (a :: k). p a a -> Join p a
Join (p a a
a p a a -> p b b -> p a a
forall a b c d. p a b -> p c d -> p a b
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 = p b d -> q b d -> Product p q b d
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 p (a -> b) (c -> d) -> p a c -> p b d
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
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 q (a -> b) (c -> d) -> q a c -> q b d
forall a b c d. q (a -> b) (c -> d) -> q a c -> q b d
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 = f (p b d) -> Tannen f p b d
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (p (a -> b) (c -> d) -> p a c -> p b d
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
(<<.>>) (p (a -> b) (c -> d) -> p a c -> p b d)
-> f (p (a -> b) (c -> d)) -> f (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 f (p a c -> p b d) -> f (p a c) -> f (p b d)
forall a b. f (a -> b) -> f a -> f b
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 = p b d -> WrappedBifunctor p b d
forall {k} {k1} (p :: k -> k1 -> *) (a :: k) (b :: k1).
p a b -> WrappedBifunctor p a b
WrapBifunctor (p (a -> b) (c -> d)
fg p (a -> b) (c -> d) -> p a c -> p b d
forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> p a c
xy)
  {-# INLINE (<<.>>) #-}