{-# 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 (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 (a :: k). f a -> f' a) -> b f g' -> b f' g'
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 (b f g' -> b f' g') -> (b f g -> b f g') -> b f g -> b f' g'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). g a -> g' a) -> b f g -> b f g'
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 (a :: k). f a -> g a) -> b f f -> b g g
btmap1 forall (a :: k). f a -> g a
h
  = (forall (a :: k). f a -> g a)
-> (forall (a :: k). f a -> g a) -> b f f -> b g g
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 (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 (a :: k). g a -> t (g' a)) -> b f g -> t (b f g')
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 (b f g -> t (b f g'))
-> (b f g' -> t (b f' g')) -> b f g -> t (b f' g')
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall (a :: k). f a -> t (f' a)) -> b f g' -> t (b f' g')
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 (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 (a :: k). f a -> t (g a))
-> (forall (a :: k). f a -> t (g a)) -> b f f -> t (b g g)
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 (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
  = e (b (Const ()) (Const ())) -> e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (e (b (Const ()) (Const ())) -> e ())
-> (b f g -> e (b (Const ()) (Const ()))) -> b f g -> e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> e (Const () a))
-> (forall (a :: k). g a -> e (Const () a))
-> b f g
-> e (b (Const ()) (Const ()))
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 (e c -> e (Const () a)
forall k b (b :: k). e b -> e (Const () b)
neuter (e c -> e (Const () a)) -> (f a -> e c) -> f a -> e (Const () a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> e c
forall (a :: k). f a -> e c
hf) (e d -> e (Const () a)
forall k b (b :: k). e b -> e (Const () b)
neuter (e d -> e (Const () a)) -> (g a -> e d) -> g a -> e (Const () a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> e d
forall (a :: k). g a -> e d
hg)
  where
    neuter :: e b -> e (Const () b)
neuter
      = (b -> Const () b) -> e b -> e (Const () b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Const () b -> b -> Const () b
forall a b. a -> b -> a
const (Const () b -> b -> Const () b) -> Const () b -> b -> Const () b
forall a b. (a -> b) -> a -> b
$ () -> Const () 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 (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
  = Wr m () -> m
forall w a. Monoid w => Wr w a -> w
execWr (Wr m () -> m) -> (b f g -> Wr m ()) -> b f g -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> Wr m ())
-> (forall (a :: k). g a -> Wr m ()) -> b f g -> Wr m ()
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_ (m -> Wr m ()
forall w. Monoid w => w -> Wr w ()
tell (m -> Wr m ()) -> (f a -> m) -> f a -> Wr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> m
forall (a :: k). f a -> m
hf) (m -> Wr m ()
forall w. Monoid w => w -> Wr w ()
tell (m -> Wr m ()) -> (g a -> m) -> g a -> Wr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> m
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 (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 (a :: k -> *). Unit a -> f a) -> b Unit g -> b f g
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-> f a
forall (a :: k -> *). f a
fa) ((forall (a :: k). g a) -> b Unit g
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 (a :: k -> *). f a) -> b f f
btpure1 forall (a :: k -> *). f a
h
  = (forall (a :: k -> *). f a) -> (forall (a :: k -> *). f a) -> b f f
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 :: b f g -> b f' g' -> b (Product f f') (Product g g')
btprod b f g
l b f' g'
r
  = (forall a. Alt (Product f f') a -> Product f f' a)
-> b (Alt (Product f f')) (Product g g')
-> b (Product f f') (Product g g')
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. Alt (Product f f') a -> Product f f' a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (b (Alt (Product f f')) (Product g g')
 -> b (Product f f') (Product g g'))
-> b (Alt (Product f f')) (Product g g')
-> b (Product f f') (Product g g')
forall a b. (a -> b) -> a -> b
$ ((forall a. f a -> Alt (Product f f') a)
-> b f g -> b (Alt (Product f f')) g
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. f a -> Alt (Product f f') a
forall (g :: * -> *) (f :: * -> *) a.
Alternative g =>
f a -> Alt (Product f g) a
oneL b f g
l) b (Alt (Product f f')) g
-> b (Alt (Product f f')) g'
-> b (Alt (Product f f')) (Product g g')
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
b f -> b g -> b (Product f g)
`bprod` ((forall a. f' a -> Alt (Product f f') a)
-> b f' g' -> b (Alt (Product f f')) g'
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. f' a -> Alt (Product f f') a
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 = Product f g a -> Alt (Product f g) a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
la g a
forall (f :: * -> *) a. Alternative f => f a
empty)
      oneR :: g a -> Alt (Product f g) a
oneR g a
ga = Product f g a -> Alt (Product f g) a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
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 { Flip b l r -> b r l
runFlip :: b r l }
  deriving (Flip b l r -> Flip b l r -> Bool
(Flip b l r -> Flip b l r -> Bool)
-> (Flip b l r -> Flip b l r -> Bool) -> Eq (Flip b l r)
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, Eq (Flip b l r)
Eq (Flip b l r)
-> (Flip b l r -> Flip b l r -> Ordering)
-> (Flip b l r -> Flip b l r -> Bool)
-> (Flip b l r -> Flip b l r -> Bool)
-> (Flip b l r -> Flip b l r -> Bool)
-> (Flip b l r -> Flip b l r -> Bool)
-> (Flip b l r -> Flip b l r -> Flip b l r)
-> (Flip b l r -> Flip b l r -> Flip b l r)
-> Ord (Flip b l r)
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
$cp1Ord :: forall k k (b :: k -> k -> *) (l :: k) (r :: k).
Ord (b r l) =>
Eq (Flip b l r)
Ord, ReadPrec [Flip b l r]
ReadPrec (Flip b l r)
Int -> ReadS (Flip b l r)
ReadS [Flip b l r]
(Int -> ReadS (Flip b l r))
-> ReadS [Flip b l r]
-> ReadPrec (Flip b l r)
-> ReadPrec [Flip b l r]
-> Read (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
[Flip b l r] -> ShowS
Flip b l r -> String
(Int -> Flip b l r -> ShowS)
-> (Flip b l r -> String)
-> ([Flip b l r] -> ShowS)
-> Show (Flip b l r)
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 (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)
    = b g f -> Flip b f g
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip ((forall (a :: k). f a -> g a) -> b f f -> b g f
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 :: f (Flip b f g) -> Flip b f (Compose f g)
bdistribute = b (Compose f g) f -> Flip b f (Compose f g)
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b (Compose f g) f -> Flip b f (Compose f g))
-> (f (Flip b f g) -> b (Compose f g) f)
-> f (Flip b f g)
-> Flip b f (Compose f g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (b g f) -> b (Compose f g) f
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute (f (b g f) -> b (Compose f g) f)
-> (f (Flip b f g) -> f (b g f))
-> f (Flip b f g)
-> b (Compose f g) f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flip b f g -> b g f) -> f (Flip b f g) -> f (b g f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Flip b f g -> b g f
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 (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)
    = b g f -> Flip b f g
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b g f -> Flip b f g) -> e (b g f) -> e (Flip b f g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: k). f a -> e (g a)) -> b f f -> e (b g f)
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 (a :: k). f a) -> Flip b f f
bpure forall (a :: k). f a
fa
    = b f f -> Flip b f f
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip ((forall (a :: k). f a) -> b f f
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 :: 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)
    = b (Product f g) f -> Flip b f (Product f g)
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b f f -> b g f -> b (Product f g) f
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 (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)
    = b x g -> Flip b g x
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip ((forall (a :: k). f a -> g a) -> b x f -> b x g
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 :: f (Flip b g x) -> Flip b (Compose f g) x
tdistribute = b x (Compose f g) -> Flip b (Compose f g) x
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b x (Compose f g) -> Flip b (Compose f g) x)
-> (f (Flip b g x) -> b x (Compose f g))
-> f (Flip b g x)
-> Flip b (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (b x g) -> b x (Compose f g)
forall k (b :: (k -> *) -> *) (f :: * -> *) (g :: k -> *).
(DistributiveB b, Functor f) =>
f (b g) -> b (Compose f g)
bdistribute (f (b x g) -> b x (Compose f g))
-> (f (Flip b g x) -> f (b x g))
-> f (Flip b g x)
-> b x (Compose f g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flip b g x -> b x g) -> f (Flip b g x) -> f (b x g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Flip b g x -> b x g
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 (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)
    = b x g -> Flip b g x
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b x g -> Flip b g x) -> e (b x g) -> e (Flip b g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: k). f a -> e (g a)) -> b x f -> e (b x g)
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 (a :: k). f a) -> Flip b f x
tpure forall (a :: k). f a
fa
    = b x f -> Flip b f x
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip ((forall (a :: k). f a) -> b x f
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 :: 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)
    = b x (Product f g) -> Flip b (Product f g) x
forall k k (b :: k -> k -> *) (l :: k) (r :: k).
b r l -> Flip b l r
Flip (b x f -> b x g -> b x (Product f g)
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