    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE Trustworthy #-}

    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (C) 2011-2015 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    ----------------------------------------------------------------------------
    module Data.Biapplicative (
      -- * Biapplicative bifunctors
        Biapplicative(..)
      , (<<$>>)
      , (<<**>>)
      , biliftA3
      , traverseBia
      , sequenceBia
      , traverseBiaWith
      , module Data.Bifunctor
      ) where

    import Control.Applicative
    import Data.Bifunctor
    import Data.Functor.Identity
    import Data.Semigroup (Arg(..))
    import GHC.Exts (inline)

    #ifdef MIN_VERSION_tagged
    import Data.Tagged
    #endif

    infixl 4 <<$>>, <<*>>, <<*, *>>, <<**>>
    (<<$>>) :: (a -> b) -> a -> b
    <<$>> :: forall a b. (a -> b) -> a -> b
    (<<$>>) = (a -> b) -> a -> b
    forall a. a -> a
    id
    {-# INLINE (<<$>>) #-}

    class Bifunctor p => Biapplicative p where
      {-# MINIMAL bipure, ((<<*>>) | biliftA2 ) #-}
      bipure :: a -> b -> p a b

      (<<*>>) :: p (a -> b) (c -> d) -> p a c -> p b d
      (<<*>>) = ((a -> b) -> a -> b)
    -> ((c -> d) -> c -> d) -> p (a -> b) (c -> d) -> p a c -> p b d
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 (a -> b) -> a -> b
    forall a. a -> a
    id (c -> d) -> c -> d
    forall a. a -> a
    id
      {-# INLINE (<<*>>) #-}

      -- | Lift binary functions
      biliftA2 :: (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
      biliftA2 a -> b -> c
    f d -> e -> f
    g p a d
    a p b e
    b = (a -> b -> c) -> (d -> e -> f) -> p a d -> p (b -> c) (e -> f)
    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 -> b -> c
    f d -> e -> f
    g (p a d -> p (b -> c) (e -> f)) -> p a d -> p (b -> c) (e -> f)
    forall a b. (a -> b) -> a -> b
    <<$>> p a d
    a p (b -> c) (e -> f) -> p b e -> p c f
    forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
    forall (p :: * -> * -> *) a b c d.
    Biapplicative p =>
    p (a -> b) (c -> d) -> p a c -> p b d
    <<*>> p b e
    b
      {-# INLINE biliftA2 #-}

      -- |
      -- @
      -- a '*>>' b ≡ 'bimap' ('const' 'id') ('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 d -> p c d
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 ((c -> c) -> a -> c -> c
    forall a b. a -> b -> a
    const c -> c
    forall a. a -> a
    id) ((d -> d) -> b -> d -> d
    forall a b. a -> b -> a
    const d -> d
    forall a. a -> a
    id) p a b
    a p c d
    b
      {-# INLINE (*>>) #-}

      -- |
      -- @
      -- a '<<*' b ≡ 'bimap' 'const' '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 d -> p a b
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 a -> c -> a
    forall a b. a -> b -> a
    const b -> d -> b
    forall a b. a -> b -> a
    const p a b
    a p c d
    b
      {-# INLINE (<<*) #-}

    (<<**>>) :: Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d
    <<**>> :: forall (p :: * -> * -> *) a c b d.
    Biapplicative p =>
    p a c -> p (a -> b) (c -> d) -> p b d
    (<<**>>) = (a -> (a -> b) -> b)
    -> (c -> (c -> d) -> d) -> p a c -> p (a -> b) (c -> d) -> p b d
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 (((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
    id) (((c -> d) -> c -> d) -> c -> (c -> d) -> d
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (c -> d) -> c -> d
    forall a. a -> a
    id)
    {-# INLINE (<<**>>) #-}

    -- | Lift ternary functions
    biliftA3 :: Biapplicative w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
    biliftA3 :: forall (w :: * -> * -> *) a b c d e f g h.
    Biapplicative w =>
    (a -> b -> c -> d)
    -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
    biliftA3 a -> b -> c -> d
    f e -> f -> g -> h
    g w a e
    a w b f
    b w c g
    c = (a -> b -> c -> d)
    -> (e -> f -> g -> h) -> w a e -> w b f -> w (c -> d) (g -> h)
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 a -> b -> c -> d
    f e -> f -> g -> h
    g w a e
    a w b f
    b w (c -> d) (g -> h) -> w c g -> w d h
    forall a b c d. w (a -> b) (c -> d) -> w a c -> w b d
    forall (p :: * -> * -> *) a b c d.
    Biapplicative p =>
    p (a -> b) (c -> d) -> p a c -> p b d
    <<*>> w c g
    c
    {-# INLINE biliftA3 #-}

    -- | Traverse a 'Traversable' container in a 'Biapplicative'.
    --
    -- 'traverseBia' satisfies the following properties:
    --
    -- [/Pairing/]
    --
    --     @'traverseBia' (,) t = (t, t)@
    --
    -- [/Composition/]
    --
    --     @'traverseBia' ('Data.Bifunctor.Biff.Biff' . 'bimap' g h . f) = 'Data.Bifunctor.Biff.Biff' . 'bimap' ('traverse' g) ('traverse' h) . 'traverseBia' f@
    --
    --     @'traverseBia' ('Data.Bifunctor.Tannen.Tannen' . 'fmap' f . g) = 'Data.Bifunctor.Tannen.Tannen' . 'fmap' ('traverseBia' f) . 'traverse' g@
    --
    -- [/Naturality/]
    --
    --     @ t . 'traverseBia' f = 'traverseBia' (t . f) @
    --
    --     for every biapplicative transformation @t@.
    --
    --     A /biapplicative transformation/ from a 'Biapplicative' @P@ to a 'Biapplicative' @Q@
    --     is a function
    --
    --     @t :: P a b -> Q a b@
    --
    --     preserving the 'Biapplicative' operations. That is,
    --
    --     * @t ('bipure' x y) = 'bipure' x y@
    --
    --     * @t (x '<<*>>' y) = t x '<<*>>' t y@
    --
    -- === Performance note
    --
    -- 'traverseBia' is fairly efficient, and uses compiler rewrite rules
    -- to be even more efficient for a few important types like @[]@. However,
    -- if performance is critical, you might consider writing a container-specific
    -- implementation.
    traverseBia :: (Traversable t, Biapplicative p)
                => (a -> p b c) -> t a -> p (t b) (t c)
    traverseBia :: forall (t :: * -> *) (p :: * -> * -> *) a b c.
    (Traversable t, Biapplicative p) =>
    (a -> p b c) -> t a -> p (t b) (t c)
    traverseBia = ((a -> p b c) -> t a -> p (t b) (t c))
    -> (a -> p b c) -> t a -> p (t b) (t c)
    forall a. a -> a
    inline ((forall (f :: * -> *) x.
     Applicative f =>
     (a -> f x) -> t a -> f (t x))
    -> (a -> p b c) -> t a -> p (t b) (t c)
    forall (p :: * -> * -> *) a b c s (t :: * -> *).
    Biapplicative p =>
    (forall (f :: * -> *) x.
     Applicative f =>
     (a -> f x) -> s -> f (t x))
    -> (a -> p b c) -> s -> p (t b) (t c)
    traverseBiaWith (a -> f x) -> t a -> f (t x)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) x.
    Applicative f =>
    (a -> f x) -> t a -> f (t x)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b)
    traverse)
    -- We explicitly inline traverseBiaWith because it seems likely to help
    -- specialization. I'm not much of an expert at the inlining business,
    -- so I won't mind if someone else decides to do this differently.

    -- We use a staged INLINABLE so we can rewrite traverseBia to specialized
    -- versions for a few important types.
    {-# INLINABLE [1] traverseBia #-}

    -- | Perform all the 'Biapplicative' actions in a 'Traversable' container
    -- and produce a container with all the results.
    --
    -- @
    -- sequenceBia = 'traverseBia' id
    -- @
    sequenceBia :: (Traversable t, Biapplicative p)
                => t (p b c) -> p (t b) (t c)
    sequenceBia :: forall (t :: * -> *) (p :: * -> * -> *) b c.
    (Traversable t, Biapplicative p) =>
    t (p b c) -> p (t b) (t c)
    sequenceBia = (t (p b c) -> p (t b) (t c)) -> t (p b c) -> p (t b) (t c)
    forall a. a -> a
    inline ((p b c -> p b c) -> t (p b c) -> p (t b) (t c)
    forall (t :: * -> *) (p :: * -> * -> *) a b c.
    (Traversable t, Biapplicative p) =>
    (a -> p b c) -> t a -> p (t b) (t c)
    traverseBia p b c -> p b c
    forall a. a -> a
    id)
    {-# INLINABLE sequenceBia #-}

    -- | A version of 'traverseBia' that doesn't care how the traversal is
    -- done.
    --
    -- @
    -- 'traverseBia' = traverseBiaWith traverse
    -- @
    traverseBiaWith :: forall p a b c s t. Biapplicative p
      => (forall f x. Applicative f => (a -> f x) -> s -> f (t x))
      -> (a -> p b c) -> s -> p (t b) (t c)
    traverseBiaWith :: forall (p :: * -> * -> *) a b c s (t :: * -> *).
    Biapplicative p =>
    (forall (f :: * -> *) x.
     Applicative f =>
     (a -> f x) -> s -> f (t x))
    -> (a -> p b c) -> s -> p (t b) (t c)
    traverseBiaWith forall (f :: * -> *) x. Applicative f => (a -> f x) -> s -> f (t x)
    trav a -> p b c
    p s
    s = (a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
    forall (p :: * -> * -> *) (t :: * -> *) a b c.
    Biapplicative p =>
    (a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
    smash a -> p b c
    p ((a -> Mag a x x) -> s -> Mag a x (t x)
    forall (f :: * -> *) x. Applicative f => (a -> f x) -> s -> f (t x)
    trav a -> Mag a x x
    forall a b. a -> Mag a b b
    One s
    s)
    {-# INLINABLE traverseBiaWith #-}

    smash :: forall p t a b c. Biapplicative p
          => (a -> p b c)
          -> (forall x. Mag a x (t x))
          -> p (t b) (t c)
    smash :: forall (p :: * -> * -> *) (t :: * -> *) a b c.
    Biapplicative p =>
    (a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
    smash a -> p b c
    p forall x. Mag a x (t x)
    m = Mag a b (t b) -> Mag a c (t c) -> p (t b) (t c)
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b (t b)
    forall x. Mag a x (t x)
    m Mag a c (t c)
    forall x. Mag a x (t x)
    m
      where
        go :: forall x y. Mag a b x -> Mag a c y -> p x y
        go :: forall x y. Mag a b x -> Mag a c y -> p x y
    go (Pure x
    t) (Pure y
    u) = x -> y -> p x y
    forall a b. a -> b -> p a b
    forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
    bipure x
    t y
    u
        go (Map x -> x
    f Mag a b x
    x) (Map x -> y
    g Mag a c x
    y) = (x -> x) -> (x -> y) -> p x x -> p x y
    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 x -> x
    f x -> y
    g (Mag a b x -> Mag a c x -> p x x
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b x
    x Mag a c x
    y)
        go (Ap Mag a b (t -> x)
    fs Mag a b t
    xs) (Ap Mag a c (t -> y)
    gs Mag a c t
    ys) = Mag a b (t -> x) -> Mag a c (t -> y) -> p (t -> x) (t -> y)
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b (t -> x)
    fs Mag a c (t -> y)
    gs p (t -> x) (t -> y) -> p t t -> p x y
    forall a b c d. p (a -> b) (c -> d) -> p a c -> p b d
    forall (p :: * -> * -> *) a b c d.
    Biapplicative p =>
    p (a -> b) (c -> d) -> p a c -> p b d
    <<*>> Mag a b t -> Mag a c t -> p t t
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b t
    xs Mag a c t
    ys
    #if MIN_VERSION_base(4,10,0)
        go (LiftA2 t -> u -> x
    f Mag a b t
    xs Mag a b u
    ys) (LiftA2 t -> u -> y
    g Mag a c t
    zs Mag a c u
    ws) = (t -> u -> x) -> (t -> u -> y) -> p t t -> p u u -> p x y
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 t -> u -> x
    f t -> u -> y
    g (Mag a b t -> Mag a c t -> p t t
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b t
    xs Mag a c t
    zs) (Mag a b u -> Mag a c u -> p u u
    forall x y. Mag a b x -> Mag a c y -> p x y
    go Mag a b u
    ys Mag a c u
    ws)
    #endif
        go (One a
    x) (One a
    _) = a -> p b c
    p a
    x
        go Mag a b x
    _ Mag a c y
    _ = p x y
    forall a. a
    impossibleError
    {-# INLINABLE smash #-}

    -- Let's not end up with a bunch of CallStack junk in the smash
    -- unfolding.
    impossibleError :: a
    impossibleError :: forall a. a
    impossibleError = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Impossible: the arguments are always the same."

    -- This is used to reify a traversal for 'traverseBia'. It's a somewhat
    -- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the
    -- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so
    -- we leave them out. We offer all the rest of the Functor and Applicative
    -- operations to improve performance: we generally want to keep the structure
    -- as small as possible. We might even consider using RULES to widen lifts
    -- when we can:
    --
    --   liftA2 f x y <*> z ==> liftA3 f x y z,
    --
    -- etc., up to the pointer tagging limit. But we do need to be careful. I don't
    -- *think* GHC will ever inline the traversal into the go function (because that
    -- would duplicate work), but if it did, and if different RULES fired for the
    -- two copies, everything would break horribly.
    --
    -- Note: if it's necessary for some reason, we *could* relax GADTs to
    -- ExistentialQuantification by changing the type of One to
    --
    --   One :: (b -> c) -> a -> Mag a b c
    --
    -- where the function will always end up being id. But we allocate a *lot*
    -- of One constructors, so this would definitely be bad for performance.
    data Mag a b t where
      Pure :: t -> Mag a b t
      Map :: (x -> t) -> Mag a b x -> Mag a b t
      Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
    #if MIN_VERSION_base(4,10,0)
      LiftA2 :: (t -> u -> v) -> Mag a b t -> Mag a b u -> Mag a b v
    #endif
      One :: a -> Mag a b b

    instance Functor (Mag a b) where
      fmap :: forall a b. (a -> b) -> Mag a b a -> Mag a b b
    fmap = (a -> b) -> Mag a b a -> Mag a b b
    forall t t a b. (t -> t) -> Mag a b t -> Mag a b t
    Map

    instance Applicative (Mag a b) where
      pure :: forall a. a -> Mag a b a
    pure = a -> Mag a b a
    forall t a b. t -> Mag a b t
    Pure
      <*> :: forall a b. Mag a b (a -> b) -> Mag a b a -> Mag a b b
    (<*>) = Mag a b (a -> b) -> Mag a b a -> Mag a b b
    forall a b a b. Mag a b (a -> b) -> Mag a b a -> Mag a b b
    Ap
    #if MIN_VERSION_base(4,10,0)
      liftA2 :: forall a b c. (a -> b -> c) -> Mag a b a -> Mag a b b -> Mag a b c
    liftA2 = (a -> b -> c) -> Mag a b a -> Mag a b b -> Mag a b c
    forall t u v a b.
    (t -> u -> v) -> Mag a b t -> Mag a b u -> Mag a b v
    LiftA2
    #endif

    -- Rewrite rules for traversing a few important types. These avoid the overhead
    -- of allocating and matching on a Mag.
    {-# RULES
    "traverseBia/list" forall f t. traverseBia f t = traverseBiaList f t
    "traverseBia/Maybe" forall f t. traverseBia f t = traverseBiaMaybe f t
    "traverseBia/Either" forall f t. traverseBia f t = traverseBiaEither f t
    "traverseBia/Identity" forall f t. traverseBia f t = traverseBiaIdentity f t
    "traverseBia/Const" forall f t. traverseBia f t = traverseBiaConst f t
    "traverseBia/Pair" forall f t. traverseBia f t = traverseBiaPair f t
     #-}

    traverseBiaList :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
    traverseBiaList :: forall (p :: * -> * -> *) a b c.
    Biapplicative p =>
    (a -> p b c) -> [a] -> p [b] [c]
    traverseBiaList a -> p b c
    f = (a -> p [b] [c] -> p [b] [c]) -> p [b] [c] -> [a] -> p [b] [c]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> p [b] [c] -> p [b] [c]
    go ([b] -> [c] -> p [b] [c]
    forall a b. a -> b -> p a b
    forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
    bipure [] [])
      where
        go :: a -> p [b] [c] -> p [b] [c]
    go a
    x p [b] [c]
    r = (b -> [b] -> [b])
    -> (c -> [c] -> [c]) -> p b c -> p [b] [c] -> p [b] [c]
    forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    forall (p :: * -> * -> *) a b c d e f.
    Biapplicative p =>
    (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
    biliftA2 (:) (:) (a -> p b c
    f a
    x) p [b] [c]
    r

    traverseBiaMaybe :: Biapplicative p => (a -> p b c) -> Maybe a -> p (Maybe b) (Maybe c)
    traverseBiaMaybe :: forall (p :: * -> * -> *) a b c.
    Biapplicative p =>
    (a -> p b c) -> Maybe a -> p (Maybe b) (Maybe c)
    traverseBiaMaybe a -> p b c
    _f Maybe a
    Nothing = Maybe b -> Maybe c -> p (Maybe b) (Maybe c)
    forall a b. a -> b -> p a b
    forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
    bipure Maybe b
    forall a. Maybe a
    Nothing Maybe c
    forall a. Maybe a
    Nothing
    traverseBiaMaybe a -> p b c
    f (Just a
    x) = (b -> Maybe b) -> (c -> Maybe c) -> p b c -> p (Maybe b) (Maybe c)
    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 b -> Maybe b
    forall a. a -> Maybe a
    Just c -> Maybe c
    forall a. a -> Maybe a
    Just (a -> p b c
    f a
    x)

    traverseBiaEither :: Biapplicative p => (a -> p b c) -> Either e a -> p (Either e b) (Either e c)
    traverseBiaEither :: forall (p :: * -> * -> *) a b c e.
    Biapplicative p =>
    (a -> p b c) -> Either e a -> p (Either e b) (Either e c)
    traverseBiaEither a -> p b c
    f (Right a
    x) = (b -> Either e b)
    -> (c -> Either e c) -> p b c -> p (Either e b) (Either e c)
    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 b -> Either e b
    forall a b. b -> Either a b
    Right c -> Either e c
    forall a b. b -> Either a b
    Right (a -> p b c
    f a
    x)
    traverseBiaEither a -> p b c
    _f (Left (e
    e :: e)) = Either e b -> Either e c -> p (Either e b) (Either e c)
    forall a b. a -> b -> p a b
    forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
    bipure Either e b
    forall x. Either e x
    m Either e c
    forall x. Either e x
    m
      where
        m :: Either e x
        m :: forall x. Either e x
    m = e -> Either e x
    forall a b. a -> Either a b
    Left e
    e

    traverseBiaIdentity :: Biapplicative p => (a -> p b c) -> Identity a -> p (Identity b) (Identity c)
    traverseBiaIdentity :: forall (p :: * -> * -> *) a b c.
    Biapplicative p =>
    (a -> p b c) -> Identity a -> p (Identity b) (Identity c)
    traverseBiaIdentity a -> p b c
    f (Identity a
    x) = (b -> Identity b)
    -> (c -> Identity c) -> p b c -> p (Identity b) (Identity c)
    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 b -> Identity b
    forall a. a -> Identity a
    Identity c -> Identity c
    forall a. a -> Identity a
    Identity (a -> p b c
    f a
    x)

    traverseBiaConst :: Biapplicative p => (a -> p b c) -> Const x a -> p (Const x b) (Const x c)
    traverseBiaConst :: forall (p :: * -> * -> *) a b c x.
    Biapplicative p =>
    (a -> p b c) -> Const x a -> p (Const x b) (Const x c)
    traverseBiaConst a -> p b c
    _f (Const x
    x) = Const x b -> Const x c -> p (Const x b) (Const x c)
    forall a b. a -> b -> p a b
    forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
    bipure (x -> Const x b
    forall {k} a (b :: k). a -> Const a b
    Const x
    x) (x -> Const x c
    forall {k} a (b :: k). a -> Const a b
    Const x
    x)

    traverseBiaPair :: Biapplicative p => (a -> p b c) -> (e, a) -> p (e, b) (e, c)
    traverseBiaPair :: forall (p :: * -> * -> *) a b c e.
    Biapplicative p =>
    (a -> p b c) -> (e, a) -> p (e, b) (e, c)
    traverseBiaPair a -> p b c
    f (e
    x,a
    y) = (b -> (e, b)) -> (c -> (e, c)) -> p b c -> p (e, b) (e, c)
    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 ((,) e
    x) ((,) e
    x) (a -> p b c
    f a
    y)

    ----------------------------------------------
    --
    -- Instances

    instance Biapplicative (,) where
      bipure :: forall a b. a -> b -> (a, b)
    bipure = (,)
      {-# INLINE bipure #-}
      ~(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 (<<*>>) #-}
      biliftA2 :: forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> (a, d) -> (b, e) -> (c, f)
    biliftA2 a -> b -> c
    f d -> e -> f
    g ~(a
    x, d
    y) ~(b
    a, e
    b) = (a -> b -> c
    f a
    x b
    a, d -> e -> f
    g d
    y e
    b)
      {-# INLINE biliftA2 #-}

    instance Biapplicative Arg where
      bipure :: forall a b. a -> b -> Arg a b
    bipure = a -> b -> Arg a b
    forall a b. a -> b -> Arg a b
    Arg
      {-# INLINE bipure #-}
      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 (<<*>>) #-}
      biliftA2 :: forall a b c d e f.
    (a -> b -> c) -> (d -> e -> f) -> Arg a d -> Arg b e -> Arg c f
    biliftA2 a -> b -> c
    f d -> e -> f
    g (Arg a
    x d
    y) (Arg b
    a e
    b) = c -> f -> Arg c f
    forall a b. a -> b -> Arg a b
    Arg (a -> b -> c
    f a
    x b
    a) (d -> e -> f
    g d
    y e
    b)
      {-# INLINE biliftA2 #-}

    instance Monoid x => Biapplicative ((,,) x) where
      bipure :: forall a b. a -> b -> (x, a, b)
    bipure = (,,) x
    forall a. Monoid a => a
    mempty
      {-# INLINE bipure #-}
      ~(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
    forall a. Monoid a => a -> a -> a
    mappend x
    x x
    x', a -> b
    f a
    a, c -> d
    g c
    b)
      {-# INLINE (<<*>>) #-}

    instance (Monoid x, Monoid y) => Biapplicative ((,,,) x y) where
      bipure :: forall a b. a -> b -> (x, y, a, b)
    bipure = (,,,) x
    forall a. Monoid a => a
    mempty y
    forall a. Monoid a => a
    mempty
      {-# INLINE bipure #-}
      ~(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
    forall a. Monoid a => a -> a -> a
    mappend x
    x x
    x', y -> y -> y
    forall a. Monoid a => a -> a -> a
    mappend y
    y y
    y', a -> b
    f a
    a, c -> d
    g c
    b)
      {-# INLINE (<<*>>) #-}

    instance (Monoid x, Monoid y, Monoid z) => Biapplicative ((,,,,) x y z) where
      bipure :: forall a b. a -> b -> (x, y, z, a, b)
    bipure = (,,,,) x
    forall a. Monoid a => a
    mempty y
    forall a. Monoid a => a
    mempty z
    forall a. Monoid a => a
    mempty
      {-# INLINE bipure #-}
      ~(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
    forall a. Monoid a => a -> a -> a
    mappend x
    x x
    x', y -> y -> y
    forall a. Monoid a => a -> a -> a
    mappend y
    y y
    y', z -> z -> z
    forall a. Monoid a => a -> a -> a
    mappend z
    z z
    z', a -> b
    f a
    a, c -> d
    g c
    b)
      {-# INLINE (<<*>>) #-}

    instance (Monoid x, Monoid y, Monoid z, Monoid w) => Biapplicative ((,,,,,) x y z w) where
      bipure :: forall a b. a -> b -> (x, y, z, w, a, b)
    bipure = (,,,,,) x
    forall a. Monoid a => a
    mempty y
    forall a. Monoid a => a
    mempty z
    forall a. Monoid a => a
    mempty w
    forall a. Monoid a => a
    mempty
      {-# INLINE bipure #-}
      ~(x
    x, y
    y, z
    z, w
    w, a -> b
    f, c -> d
    g) <<*>> :: forall a b c d.
    (x, y, z, w, a -> b, c -> d)
    -> (x, y, z, w, a, c) -> (x, y, z, w, b, d)
    <<*>> ~(x
    x', y
    y', z
    z', w
    w', a
    a, c
    b) = (x -> x -> x
    forall a. Monoid a => a -> a -> a
    mappend x
    x x
    x', y -> y -> y
    forall a. Monoid a => a -> a -> a
    mappend y
    y y
    y', z -> z -> z
    forall a. Monoid a => a -> a -> a
    mappend z
    z z
    z', w -> w -> w
    forall a. Monoid a => a -> a -> a
    mappend w
    w w
    w', a -> b
    f a
    a, c -> d
    g c
    b)
      {-# INLINE (<<*>>) #-}

    instance (Monoid x, Monoid y, Monoid z, Monoid w, Monoid v) => Biapplicative ((,,,,,,) x y z w v) where
      bipure :: forall a b. a -> b -> (x, y, z, w, v, a, b)
    bipure = (,,,,,,) x
    forall a. Monoid a => a
    mempty y
    forall a. Monoid a => a
    mempty z
    forall a. Monoid a => a
    mempty w
    forall a. Monoid a => a
    mempty v
    forall a. Monoid a => a
    mempty
      {-# INLINE bipure #-}
      ~(x
    x, y
    y, z
    z, w
    w, v
    v, a -> b
    f, c -> d
    g) <<*>> :: forall a b c d.
    (x, y, z, w, v, a -> b, c -> d)
    -> (x, y, z, w, v, a, c) -> (x, y, z, w, v, b, d)
    <<*>> ~(x
    x', y
    y', z
    z', w
    w', v
    v', a
    a, c
    b) = (x -> x -> x
    forall a. Monoid a => a -> a -> a
    mappend x
    x x
    x', y -> y -> y
    forall a. Monoid a => a -> a -> a
    mappend y
    y y
    y', z -> z -> z
    forall a. Monoid a => a -> a -> a
    mappend z
    z z
    z', w -> w -> w
    forall a. Monoid a => a -> a -> a
    mappend w
    w w
    w', v -> v -> v
    forall a. Monoid a => a -> a -> a
    mappend v
    v v
    v', a -> b
    f a
    a, c -> d
    g c
    b)
      {-# INLINE (<<*>>) #-}

    #ifdef MIN_VERSION_tagged
    instance Biapplicative Tagged where
      bipure :: forall a b. a -> b -> Tagged a b
    bipure a
    _ b
    b = b -> Tagged a b
    forall {k} (s :: k) b. b -> Tagged s b
    Tagged b
    b
      {-# INLINE bipure #-}

      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 Biapplicative Const where
      bipure :: forall a b. a -> b -> Const a b
    bipure a
    a b
    _ = a -> Const a b
    forall {k} a (b :: k). a -> Const a b
    Const a
    a
      {-# INLINE bipure #-}
      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 (<<*>>) #-}