{-# LANGUAGE CPP #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}

#if __GLASGOW_HASKELL__ >= 806

{-# LANGUAGE QuantifiedConstraints #-}

#endif

{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
module Barbies.Bi
  ( -- * Functor
    -- | A bifunctor is simultaneously a 'FunctorT' and a 'FunctorB'.
    btmap
  , btmap1

    -- * Traversable
    -- | A traversable bifunctor is simultaneously a 'TraversableT'
    --   and a 'TraversableB'.
  , bttraverse
  , bttraverse1
  , bttraverse_
  , btfoldMap

   -- * Applicative
   -- | If @t@ is an 'ApplicativeT', the type of 'tpure' shows that its
   --   second argument must be a phantom-type, so there are really no
   --   interesting types that are both 'ApplicativeT' and 'ApplicativeB'.
   --   However, we can sometimes reconstruct a bi-applicative from an
   --   'ApplicativeB' and a 'FunctorT'.
  , btpure
  , btpure1
  , btprod

    -- * Wrappers
  , Flip(..)
  ) where


import Barbies.Internal.Trivial (Unit(..))
import Barbies.Internal.Writer (execWr, tell)
import Data.Functor.Barbie
import Data.Functor.Transformer

import Control.Applicative (Alternative(..))
import Control.Monad ((>=>))
import Data.Monoid (Alt(..))
import Data.Functor (void)
import Data.Functor.Const (Const(..))
import Data.Functor.Product (Product(..))

-- {{ Functor -----------------------------------------------------------------

-- | Map over both arguments at the same time.
btmap
  :: ( FunctorB (b f)
     , FunctorT b
     )
  => (forall a . f a -> f' a)
  -> (forall a . g a -> g' a)
  -> b f g
  -> b f' g'
btmap :: forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
(FunctorB (b f), FunctorT b) =>
(forall (a :: k). f a -> f' a)
-> (forall (a :: k). g a -> g' a) -> b f g -> b f' g'
btmap forall (a :: k). f a -> f' a
hf forall (a :: k). g a -> g' a
hg
  = forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap forall (a :: k). f a -> f' a
hf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
bmap forall (a :: k). g a -> g' a
hg
{-# INLINE btmap #-}

-- | A version of 'btmap' specialized to a single argument.
btmap1
  :: ( FunctorB (b f)
     , FunctorT b
     )
  => (forall a . f a -> g a)
  -> b f f
  -> b g g
btmap1 :: forall {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (g :: k -> *).
(FunctorB (b f), FunctorT b) =>
(forall (a :: k). f a -> g a) -> b f f -> b g g
btmap1 forall (a :: k). f a -> g a
h
  = forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
(FunctorB (b f), FunctorT b) =>
(forall (a :: k). f a -> f' a)
-> (forall (a :: k). g a -> g' a) -> b f g -> b f' g'
btmap forall (a :: k). f a -> g a
h forall (a :: k). f a -> g a
h
{-# INLINE btmap1 #-}

-- }} Functor -----------------------------------------------------------------


-- {{ Traversable -------------------------------------------------------------

-- | Traverse over both arguments, first over @f@, then over @g@..
bttraverse
  :: ( TraversableB (b f)
     , TraversableT b
     , Monad t
     )
  => (forall a . f a -> t (f' a))
  -> (forall a . g a -> t (g' a))
  -> b f g
  -> t (b f' g')
bttraverse :: forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (t :: * -> *) (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
(TraversableB (b f), TraversableT b, Monad t) =>
(forall (a :: k). f a -> t (f' a))
-> (forall (a :: k). g a -> t (g' a)) -> b f g -> t (b f' g')
bttraverse forall (a :: k). f a -> t (f' a)
hf forall (a :: k). g a -> t (g' a)
hg
  = forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse forall (a :: k). g a -> t (g' a)
hg forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall k k' (t :: (k -> *) -> k' -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *) (x :: k').
(TraversableT t, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
ttraverse forall (a :: k). f a -> t (f' a)
hf
{-# INLINE bttraverse #-}

-- | A version of 'bttraverse' specialized to a single argument.
bttraverse1
  :: ( TraversableB (b f)
     , TraversableT b
     , Monad t
     )
  => (forall a . f a -> t (g a))
  -> b f f
  -> t (b g g)
bttraverse1 :: forall {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (t :: * -> *) (g :: k -> *).
(TraversableB (b f), TraversableT b, Monad t) =>
(forall (a :: k). f a -> t (g a)) -> b f f -> t (b g g)
bttraverse1 forall (a :: k). f a -> t (g a)
h
  = forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (t :: * -> *) (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
(TraversableB (b f), TraversableT b, Monad t) =>
(forall (a :: k). f a -> t (f' a))
-> (forall (a :: k). g a -> t (g' a)) -> b f g -> t (b f' g')
bttraverse forall (a :: k). f a -> t (g a)
h forall (a :: k). f a -> t (g a)
h
{-# INLINE bttraverse1 #-}

-- | Map each element to an action, evaluate these actions from left to right
--   and ignore the results.
bttraverse_
  :: ( TraversableB (b f)
     , TraversableT b
     , Monad e
     )
  => (forall a. f a -> e c)
  -> (forall a. g a -> e d)
  -> b f g
  -> e ()
bttraverse_ :: forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (e :: * -> *) c (g :: k -> *) d.
(TraversableB (b f), TraversableT b, Monad e) =>
(forall (a :: k). f a -> e c)
-> (forall (a :: k). g a -> e d) -> b f g -> e ()
bttraverse_ forall (a :: k). f a -> e c
hf forall (a :: k). g a -> e d
hg
  = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (t :: * -> *) (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
(TraversableB (b f), TraversableT b, Monad t) =>
(forall (a :: k). f a -> t (f' a))
-> (forall (a :: k). g a -> t (g' a)) -> b f g -> t (b f' g')
bttraverse (forall {k} {a} {b :: k}. e a -> e (Const () b)
neuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> e c
hf) (forall {k} {a} {b :: k}. e a -> e (Const () b)
neuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). g a -> e d
hg)
  where
    neuter :: e a -> e (Const () b)
neuter
      = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> Const a b
Const ())

-- | Map each element to a monoid, and combine the results.
btfoldMap
  :: ( TraversableB (b f)
     , TraversableT b
     , Monoid m
     )
  => (forall a. f a -> m)
  -> (forall a. g a -> m)
  -> b f g -> m
btfoldMap :: forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *) m
       (g :: k -> *).
(TraversableB (b f), TraversableT b, Monoid m) =>
(forall (a :: k). f a -> m)
-> (forall (a :: k). g a -> m) -> b f g -> m
btfoldMap forall (a :: k). f a -> m
hf forall (a :: k). g a -> m
hg
  = forall w a. Monoid w => Wr w a -> w
execWr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (b :: (k -> *) -> (k -> *) -> *) (f :: k -> *)
       (e :: * -> *) c (g :: k -> *) d.
(TraversableB (b f), TraversableT b, Monad e) =>
(forall (a :: k). f a -> e c)
-> (forall (a :: k). g a -> e d) -> b f g -> e ()
bttraverse_ (forall w. Monoid w => w -> Wr w ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> m
hf) (forall w. Monoid w => w -> Wr w ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). g a -> m
hg)

-- }} Traversable -------------------------------------------------------------


-- {{ Applicative -------------------------------------------------------------
-- | Conceptually, this is like simultaneously using `bpure' and 'tpure'.
btpure
 :: ( ApplicativeB (b Unit)
    , FunctorT b
    )
 => (forall a . f a)
 -> (forall a . g a)
 -> b f g
btpure :: forall {k} {k} (b :: ((k -> *) -> *) -> (k -> *) -> *)
       (f :: (k -> *) -> *) (g :: k -> *).
(ApplicativeB (b Unit), FunctorT b) =>
(forall (a :: k -> *). f a) -> (forall (a :: k). g a) -> b f g
btpure forall (a :: k -> *). f a
fa forall (a :: k). g a
ga
  = forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap (\Unit a
Unit-> forall (a :: k -> *). f a
fa) (forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
bpure forall (a :: k). g a
ga)
{-# INLINE btpure #-}

-- | A version of 'btpure' specialized to a single argument.
btpure1
  :: ( ApplicativeB (b Unit)
     , FunctorT b
     )
  => (forall a . f a)
  -> b f f
btpure1 :: forall {k} (b :: ((k -> *) -> *) -> ((k -> *) -> *) -> *)
       (f :: (k -> *) -> *).
(ApplicativeB (b Unit), FunctorT b) =>
(forall (a :: k -> *). f a) -> b f f
btpure1 forall (a :: k -> *). f a
h
  = forall {k} {k} (b :: ((k -> *) -> *) -> (k -> *) -> *)
       (f :: (k -> *) -> *) (g :: k -> *).
(ApplicativeB (b Unit), FunctorT b) =>
(forall (a :: k -> *). f a) -> (forall (a :: k). g a) -> b f g
btpure forall (a :: k -> *). f a
h forall (a :: k -> *). f a
h
{-# INLINE btpure1 #-}

-- | Simultaneous product on both arguments.
btprod
  :: ( ApplicativeB (b (Alt (Product f f')))
     , FunctorT b
     , Alternative f
     , Alternative f'
     )
  => b f g
  -> b f' g'
  -> b (f `Product` f') (g `Product` g')
btprod :: forall {k} (b :: (* -> *) -> (k -> *) -> *) (f :: * -> *)
       (f' :: * -> *) (g :: k -> *) (g' :: k -> *).
(ApplicativeB (b (Alt (Product f f'))), FunctorT b, Alternative f,
 Alternative f') =>
b f g -> b f' g' -> b (Product f f') (Product g g')
btprod b f g
l b f' g'
r
  = forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt forall a b. (a -> b) -> a -> b
$ (forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap forall {g :: * -> *} {f :: * -> *} {a}.
Alternative g =>
f a -> Alt (Product f g) a
oneL b f g
l) forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
b f -> b g -> b (Product f g)
`bprod` (forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap forall {f :: * -> *} {g :: * -> *} {a}.
Alternative f =>
g a -> Alt (Product f g) a
oneR b f' g'
r)
  where
      oneL :: f a -> Alt (Product f g) a
oneL f a
la = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
la forall (f :: * -> *) a. Alternative f => f a
empty)
      oneR :: g a -> Alt (Product f g) a
oneR g a
ga = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a. Alternative f => f a
empty g a
ga)
{-# INLINE btprod #-}

-- }} Applicative -------------------------------------------------------------


-- | Convert a 'FunctorB' into a 'FunctorT' and vice-versa.
newtype Flip b l r
  = Flip { forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
Flip b l r -> b r l
runFlip :: b r l }
  deriving (Flip b l r -> Flip b l r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Eq (b r l) =>
Flip b l r -> Flip b l r -> Bool
/= :: Flip b l r -> Flip b l r -> Bool
$c/= :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Eq (b r l) =>
Flip b l r -> Flip b l r -> Bool
== :: Flip b l r -> Flip b l r -> Bool
$c== :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Eq (b r l) =>
Flip b l r -> Flip b l r -> Bool
Eq, Flip b l r -> Flip b l r -> Bool
Flip b l r -> Flip b l r -> Ordering
Flip b l r -> Flip b l r -> Flip b l r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {k} {b :: k -> k -> *} {l :: k} {r :: k}.
Ord (b r l) =>
Eq (Flip b l r)
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Bool
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Ordering
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Flip b l r
min :: Flip b l r -> Flip b l r -> Flip b l r
$cmin :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Flip b l r
max :: Flip b l r -> Flip b l r -> Flip b l r
$cmax :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Flip b l r
>= :: Flip b l r -> Flip b l r -> Bool
$c>= :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Bool
> :: Flip b l r -> Flip b l r -> Bool
$c> :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Bool
<= :: Flip b l r -> Flip b l r -> Bool
$c<= :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Bool
< :: Flip b l r -> Flip b l r -> Bool
$c< :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Bool
compare :: Flip b l r -> Flip b l r -> Ordering
$ccompare :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Flip b l r -> Flip b l r -> Ordering
Ord, ReadPrec [Flip b l r]
ReadPrec (Flip b l r)
ReadS [Flip b l r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadPrec [Flip b l r]
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadPrec (Flip b l r)
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
Int -> ReadS (Flip b l r)
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadS [Flip b l r]
readListPrec :: ReadPrec [Flip b l r]
$creadListPrec :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadPrec [Flip b l r]
readPrec :: ReadPrec (Flip b l r)
$creadPrec :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadPrec (Flip b l r)
readList :: ReadS [Flip b l r]
$creadList :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
ReadS [Flip b l r]
readsPrec :: Int -> ReadS (Flip b l r)
$creadsPrec :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Read (b r l) =>
Int -> ReadS (Flip b l r)
Read, Int -> Flip b l r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
Int -> Flip b l r -> ShowS
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
[Flip b l r] -> ShowS
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
Flip b l r -> String
showList :: [Flip b l r] -> ShowS
$cshowList :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
[Flip b l r] -> ShowS
show :: Flip b l r -> String
$cshow :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
Flip b l r -> String
showsPrec :: Int -> Flip b l r -> ShowS
$cshowsPrec :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Show (b r l) =>
Int -> Flip b l r -> ShowS
Show)


instance FunctorT b => FunctorB (Flip b f) where
  bmap :: forall (f :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> g a) -> Flip b f f -> Flip b f g
bmap forall (a :: k). f a -> g a
h (Flip b f f
bfx)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap forall (a :: k). f a -> g a
h b f f
bfx)
  {-# INLINE bmap #-}

instance DistributiveT b => DistributiveB (Flip b f) where
  bdistribute :: forall (f :: * -> *) (g :: * -> *).
Functor f =>
f (Flip b f g) -> Flip b f (Compose f g)
bdistribute = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
Flip b l r -> b r l
runFlip
  {-# INLINE bdistribute #-}

instance TraversableT b => TraversableB (Flip b f) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Flip b f f -> e (Flip b f g)
btraverse forall (a :: k). f a -> e (g a)
h (Flip b f f
bfx)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k k' (t :: (k -> *) -> k' -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *) (x :: k').
(TraversableT t, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
ttraverse forall (a :: k). f a -> e (g a)
h b f f
bfx
  {-# INLINE btraverse #-}


instance ApplicativeT b => ApplicativeB (Flip b f) where
  bpure :: forall (f :: k -> *). (forall (a :: k). f a) -> Flip b f f
bpure forall (a :: k). f a
fa
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (x :: k').
ApplicativeT t =>
(forall (a :: k). f a) -> t f x
tpure forall (a :: k). f a
fa)
  {-# INLINE bpure #-}

  bprod :: forall (f :: k -> *) (g :: k -> *).
Flip b f f -> Flip b f g -> Flip b f (Product f g)
bprod (Flip b f f
bfx) (Flip b g f
bgx)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (x :: k')
       (g :: k -> *).
ApplicativeT t =>
t f x -> t g x -> t (Product f g) x
tprod b f f
bfx b g f
bgx)
  {-# INLINE bprod #-}


#if __GLASGOW_HASKELL__ >= 806
-- ** The following instances require QuantifiedConstraints ** --

instance (forall f. FunctorB (b f)) => FunctorT (Flip b) where
  tmap :: forall (f :: k -> *) (g :: k -> *) (x :: k').
(forall (a :: k). f a -> g a) -> Flip b f x -> Flip b g x
tmap forall (a :: k). f a -> g a
h (Flip b x f
bxf)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
bmap forall (a :: k). f a -> g a
h b x f
bxf)
  {-# INLINE tmap #-}

instance (forall f. DistributiveB (b f)) => DistributiveT (Flip b) where
  tdistribute :: forall (f :: * -> *) (g :: * -> *) (x :: i).
Functor f =>
f (Flip b g x) -> Flip b (Compose f g) x
tdistribute = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (f :: * -> *) (g :: k -> *).
(DistributiveB b, Functor f) =>
f (b g) -> b (Compose f g)
bdistribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
Flip b l r -> b r l
runFlip
  {-# INLINE tdistribute #-}

instance (forall f. TraversableB (b f)) => TraversableT (Flip b) where
  ttraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *) (x :: k').
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Flip b f x -> e (Flip b g x)
ttraverse forall (a :: k). f a -> e (g a)
h (Flip b x f
bxf)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse forall (a :: k). f a -> e (g a)
h b x f
bxf
  {-# INLINE ttraverse #-}


instance (forall f. ApplicativeB (b f)) => ApplicativeT (Flip b) where
  tpure :: forall (f :: k -> *) (x :: k').
(forall (a :: k). f a) -> Flip b f x
tpure forall (a :: k). f a
fa
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
bpure forall (a :: k). f a
fa)
  {-# INLINE tpure #-}

  tprod :: forall (f :: k -> *) (x :: k') (g :: k -> *).
Flip b f x -> Flip b g x -> Flip b (Product f g) x
tprod (Flip b x f
bxf) (Flip b x g
bxg)
    = forall {k} {k} (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
b f -> b g -> b (Product f g)
bprod b x f
bxf b x g
bxg)
  {-# INLINE tprod #-}
#endif