{-# LANGUAGE PolyKinds    #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Barbies.Internal.TraversableB
  ( TraversableB(..)
  , btraverse_
  , bsequence
  , bsequence'
  , bfoldMap

  , CanDeriveTraversableB
  , gbtraverseDefault
  )

where

import Barbies.Generics.Traversable(GTraversable(..))
import Barbies.Internal.FunctorB(FunctorB (..))
import Barbies.Internal.Writer(execWr, tell)

import Data.Functor           (void)
import Data.Functor.Compose   (Compose (..))
import Data.Functor.Const     (Const (..))
import Data.Functor.Constant  (Constant (..))
import Data.Functor.Identity  (Identity (..))
import Data.Functor.Product   (Product (..))
import Data.Functor.Sum       (Sum (..))
import Data.Kind              (Type)
import Data.Generics.GenericN
import Data.Proxy             (Proxy (..))

-- | Barbie-types that can be traversed from left to right. Instances should
--   satisfy the following laws:
--
-- @
--  t . 'btraverse' f   = 'btraverse' (t . f)  -- naturality
-- 'btraverse' 'Data.Functor.Identity' = 'Data.Functor.Identity'           -- identity
-- 'btraverse' ('Compose' . 'fmap' g . f) = 'Compose' . 'fmap' ('btraverse' g) . 'btraverse' f -- composition
-- @
--
-- There is a default 'btraverse' implementation for 'Generic' types, so
-- instances can derived automatically.
class FunctorB b => TraversableB (b :: (k -> Type) -> Type) where
  btraverse :: Applicative e => (forall a . f a -> e (g a)) -> b f -> e (b g)

  default btraverse
    :: ( Applicative e, CanDeriveTraversableB b f g)
    => (forall a . f a -> e (g a))
    -> b f
    -> e (b g)
  btraverse = (forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
forall {k1} (b :: (k1 -> *) -> *) (f :: k1 -> *) (g :: k1 -> *)
       (e :: * -> *).
(Applicative e, CanDeriveTraversableB b f g) =>
(forall (a :: k1). f a -> e (g a)) -> b f -> e (b g)
gbtraverseDefault



-- | Map each element to an action, evaluate these actions from left to right,
--   and ignore the results.
btraverse_
  :: (TraversableB b, Applicative e)
  => (forall a. f a -> e c)
  -> b f
  -> e ()
btraverse_ :: forall {k} (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *) c.
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e c) -> b f -> e ()
btraverse_ forall (a :: k). f a -> e c
f
  = e (b (Const ())) -> e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (e (b (Const ())) -> e ())
-> (b f -> e (b (Const ()))) -> b f -> e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> e (Const () a)) -> b f -> e (b (Const ()))
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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse ((c -> Const () a) -> e c -> e (Const () a)
forall a b. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Const () a -> c -> Const () a
forall a b. a -> b -> a
const (Const () a -> c -> Const () a) -> Const () a -> c -> Const () a
forall a b. (a -> b) -> a -> b
$ () -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) (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
f)


-- | Evaluate each action in the structure from left to right,
--   and collect the results.
bsequence :: (Applicative e, TraversableB b) => b (Compose e f) -> e (b f)
bsequence :: forall {k} (e :: * -> *) (b :: (k -> *) -> *) (f :: k -> *).
(Applicative e, TraversableB b) =>
b (Compose e f) -> e (b f)
bsequence
  = (forall (a :: k). Compose e f a -> e (f a))
-> b (Compose e f) -> e (b f)
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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse Compose e f a -> e (f a)
forall (a :: k). Compose e f a -> e (f a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

-- | A version of 'bsequence' with @f@ specialized to 'Identity'.
bsequence' :: (Applicative e, TraversableB b) => b e -> e (b Identity)
bsequence' :: forall (e :: * -> *) (b :: (* -> *) -> *).
(Applicative e, TraversableB b) =>
b e -> e (b Identity)
bsequence'
  = (forall a. e a -> e (Identity a)) -> b e -> e (b Identity)
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)
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> b f -> e (b g)
btraverse ((a -> Identity a) -> e a -> e (Identity a)
forall a b. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity)


-- | Map each element to a monoid, and combine the results.
bfoldMap :: (TraversableB b, Monoid m) => (forall a. f a -> m) -> b f -> m
bfoldMap :: forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap forall (a :: k). f a -> m
f
  = Wr m () -> m
forall w a. Monoid w => Wr w a -> w
execWr (Wr m () -> m) -> (b f -> Wr m ()) -> b f -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> Wr m ()) -> b f -> Wr m ()
forall {k} (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *) c.
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e c) -> b f -> e ()
btraverse_ (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
f)


-- | @'CanDeriveTraversableB' B f g@ is in practice a predicate about @B@ only.
--   It is analogous to 'Barbies.Internal.FunctorB.CanDeriveFunctorB', so it
--   essentially requires the following to hold, for any arbitrary @f@:
--
--     * There is an instance of @'Generic' (B f)@.
--
--     * @B f@ can contain fields of type @b f@ as long as there exists a
--       @'TraversableB' b@ instance. In particular, recursive usages of @B f@
--       are allowed.
--
--     * @B f@ can also contain usages of @b f@ under a @'Traversable' h@.
--       For example, one could use @'Maybe' (B f)@ when defining @B f@.
type CanDeriveTraversableB b f g
  = ( GenericP 0 (b f)
    , GenericP 0 (b g)
    , GTraversable 0 f g (RepP 0 (b f)) (RepP 0 (b g))
    )

-- | Default implementation of 'btraverse' based on 'Generic'.
gbtraverseDefault
  :: forall b f g e
  .  (Applicative e, CanDeriveTraversableB b f g)
  => (forall a . f a -> e (g a))
  -> b f -> e (b g)
gbtraverseDefault :: forall {k1} (b :: (k1 -> *) -> *) (f :: k1 -> *) (g :: k1 -> *)
       (e :: * -> *).
(Applicative e, CanDeriveTraversableB b f g) =>
(forall (a :: k1). f a -> e (g a)) -> b f -> e (b g)
gbtraverseDefault forall (a :: k1). f a -> e (g a)
h
  = (Zip
   (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any
 -> b g)
-> e (Zip
        (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any)
-> e (b g)
forall a b. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy 0 -> RepP 0 (b g) Any -> b g
forall (n :: Natural) a x.
GenericP n a =>
Proxy n -> RepP n a x -> a
forall x. Proxy 0 -> RepP 0 (b g) x -> b g
toP (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @0)) (e (Zip
      (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any)
 -> e (b g))
-> (b f
    -> e (Zip
            (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any))
-> b f
-> e (b g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy 0
-> (forall (a :: k1). f a -> e (g a))
-> Zip
     (Rep (FilterIndex 0 (Indexed b 1) (Param 0 f))) (Rep (b f)) Any
-> e (Zip
        (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any)
forall {k} {k1} {k2} (n :: k) (f :: k1 -> *) (g :: k1 -> *)
       (repbf :: k2 -> *) (repbg :: k2 -> *) (t :: * -> *) (x :: k2).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k1). f a -> t (g a)) -> repbf x -> t (repbg x)
forall (t :: * -> *) x.
Applicative t =>
Proxy 0
-> (forall (a :: k1). f a -> t (g a))
-> Zip
     (Rep (FilterIndex 0 (Indexed b 1) (Param 0 f))) (Rep (b f)) x
-> t (Zip
        (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) x)
gtraverse (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @0) f a -> e (g a)
forall (a :: k1). f a -> e (g a)
h (Zip
   (Rep (FilterIndex 0 (Indexed b 1) (Param 0 f))) (Rep (b f)) Any
 -> e (Zip
         (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any))
-> (b f
    -> Zip
         (Rep (FilterIndex 0 (Indexed b 1) (Param 0 f))) (Rep (b f)) Any)
-> b f
-> e (Zip
        (Rep (FilterIndex 0 (Indexed b 1) (Param 0 g))) (Rep (b g)) Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy 0 -> b f -> RepP 0 (b f) Any
forall (n :: Natural) a x.
GenericP n a =>
Proxy n -> a -> RepP n a x
forall x. Proxy 0 -> b f -> RepP 0 (b f) x
fromP (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @0)
{-# INLINE gbtraverseDefault #-}


-- ------------------------------------------------------------
-- Generic derivation: Special cases for TraversableB
-- -----------------------------------------------------------

type P = Param

instance
  ( TraversableB b
  ) => GTraversable 0 f g (Rec (b (P 0 f)) (b f))
                          (Rec (b (P 0 g)) (b g))
  where
  gtraverse :: forall (t :: * -> *) (x :: k2).
Applicative t =>
Proxy 0
-> (forall (a :: k). f a -> t (g a))
-> Rec (b (P 0 f)) (b f) x
-> t (Rec (b (P 0 g)) (b g) x)
gtraverse Proxy 0
_ forall (a :: k). f a -> t (g a)
h
    = (b g -> Rec (b (P 0 g)) (b g) x)
-> t (b g) -> t (Rec (b (P 0 g)) (b g) x)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (b g) x -> Rec (b (P 0 g)) (b g) x
forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (b g) x -> Rec (b (P 0 g)) (b g) x)
-> (b g -> K1 R (b g) x) -> b g -> Rec (b (P 0 g)) (b g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b g -> K1 R (b g) x
forall k i c (p :: k). c -> K1 i c p
K1) (t (b g) -> t (Rec (b (P 0 g)) (b g) x))
-> (Rec (b (P 0 f)) (b f) x -> t (b g))
-> Rec (b (P 0 f)) (b f) x
-> t (Rec (b (P 0 g)) (b g) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> t (g a)) -> b f -> t (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> t (g a)
forall (a :: k). f a -> t (g a)
h (b f -> t (b g))
-> (Rec (b (P 0 f)) (b f) x -> b f)
-> Rec (b (P 0 f)) (b f) x
-> t (b g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (b f) x -> b f
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (b f) x -> b f)
-> (Rec (b (P 0 f)) (b f) x -> K1 R (b f) x)
-> Rec (b (P 0 f)) (b f) x
-> b f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (b (P 0 f)) (b f) x -> K1 R (b f) x
forall {k} p a (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}

instance
   ( Traversable h
   , TraversableB b
   ) => GTraversable 0 f g (Rec (h (b (P 0 f))) (h (b f)))
                           (Rec (h (b (P 0 g))) (h (b g)))
  where
  gtraverse :: forall (t :: * -> *) (x :: k2).
Applicative t =>
Proxy 0
-> (forall (a :: k). f a -> t (g a))
-> Rec (h (b (P 0 f))) (h (b f)) x
-> t (Rec (h (b (P 0 g))) (h (b g)) x)
gtraverse Proxy 0
_ forall (a :: k). f a -> t (g a)
h
    = (h (b g) -> Rec (h (b (P 0 g))) (h (b g)) x)
-> t (h (b g)) -> t (Rec (h (b (P 0 g))) (h (b g)) x)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (h (b g)) x -> Rec (h (b (P 0 g))) (h (b g)) x
forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (h (b g)) x -> Rec (h (b (P 0 g))) (h (b g)) x)
-> (h (b g) -> K1 R (h (b g)) x)
-> h (b g)
-> Rec (h (b (P 0 g))) (h (b g)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (b g) -> K1 R (h (b g)) x
forall k i c (p :: k). c -> K1 i c p
K1) (t (h (b g)) -> t (Rec (h (b (P 0 g))) (h (b g)) x))
-> (Rec (h (b (P 0 f))) (h (b f)) x -> t (h (b g)))
-> Rec (h (b (P 0 f))) (h (b f)) x
-> t (Rec (h (b (P 0 g))) (h (b g)) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b f -> t (b g)) -> h (b f) -> t (h (b g))
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) -> h a -> f (h b)
traverse ((forall (a :: k). f a -> t (g a)) -> b f -> t (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> t (g a)
forall (a :: k). f a -> t (g a)
h) (h (b f) -> t (h (b g)))
-> (Rec (h (b (P 0 f))) (h (b f)) x -> h (b f))
-> Rec (h (b (P 0 f))) (h (b f)) x
-> t (h (b g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (h (b f)) x -> h (b f)
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (h (b f)) x -> h (b f))
-> (Rec (h (b (P 0 f))) (h (b f)) x -> K1 R (h (b f)) x)
-> Rec (h (b (P 0 f))) (h (b f)) x
-> h (b f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (h (b (P 0 f))) (h (b f)) x -> K1 R (h (b f)) x
forall {k} p a (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}

-- This instance is the same as the previous instance but for nested
-- Traversables.
instance
   ( Traversable h
   , Traversable m
   , TraversableB b
   ) => GTraversable 0 f g (Rec (m (h (b (P 0 f)))) (m (h (b f))))
                           (Rec (m (h (b (P 0 g)))) (m (h (b g))))
  where
  gtraverse :: forall (t :: * -> *) (x :: k2).
Applicative t =>
Proxy 0
-> (forall (a :: k). f a -> t (g a))
-> Rec (m (h (b (P 0 f)))) (m (h (b f))) x
-> t (Rec (m (h (b (P 0 g)))) (m (h (b g))) x)
gtraverse Proxy 0
_ forall (a :: k). f a -> t (g a)
h
    = (m (h (b g)) -> Rec (m (h (b (P 0 g)))) (m (h (b g))) x)
-> t (m (h (b g))) -> t (Rec (m (h (b (P 0 g)))) (m (h (b g))) x)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (m (h (b g))) x -> Rec (m (h (b (P 0 g)))) (m (h (b g))) x
forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (m (h (b g))) x -> Rec (m (h (b (P 0 g)))) (m (h (b g))) x)
-> (m (h (b g)) -> K1 R (m (h (b g))) x)
-> m (h (b g))
-> Rec (m (h (b (P 0 g)))) (m (h (b g))) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (h (b g)) -> K1 R (m (h (b g))) x
forall k i c (p :: k). c -> K1 i c p
K1) (t (m (h (b g))) -> t (Rec (m (h (b (P 0 g)))) (m (h (b g))) x))
-> (Rec (m (h (b (P 0 f)))) (m (h (b f))) x -> t (m (h (b g))))
-> Rec (m (h (b (P 0 f)))) (m (h (b f))) x
-> t (Rec (m (h (b (P 0 g)))) (m (h (b g))) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h (b f) -> t (h (b g))) -> m (h (b f)) -> t (m (h (b g)))
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) -> m a -> f (m b)
traverse ((b f -> t (b g)) -> h (b f) -> t (h (b g))
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) -> h a -> f (h b)
traverse ((forall (a :: k). f a -> t (g a)) -> b f -> t (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> t (g a)
forall (a :: k). f a -> t (g a)
h)) (m (h (b f)) -> t (m (h (b g))))
-> (Rec (m (h (b (P 0 f)))) (m (h (b f))) x -> m (h (b f)))
-> Rec (m (h (b (P 0 f)))) (m (h (b f))) x
-> t (m (h (b g)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (m (h (b f))) x -> m (h (b f))
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R (m (h (b f))) x -> m (h (b f)))
-> (Rec (m (h (b (P 0 f)))) (m (h (b f))) x
    -> K1 R (m (h (b f))) x)
-> Rec (m (h (b (P 0 f)))) (m (h (b f))) x
-> m (h (b f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (m (h (b (P 0 f)))) (m (h (b f))) x -> K1 R (m (h (b f))) x
forall {k} p a (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}


-- -----------------------------------------------------------
-- Instances for base types
-- -----------------------------------------------------------

instance TraversableB Proxy where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Proxy f -> e (Proxy g)
btraverse forall (a :: k). f a -> e (g a)
_ Proxy f
_ = Proxy g -> e (Proxy g)
forall a. a -> e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proxy g
forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE btraverse #-}

instance (TraversableB a, TraversableB b) => TraversableB (Product a b) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a))
-> Product a b f -> e (Product a b g)
btraverse forall (a :: k). f a -> e (g a)
f (Pair a f
x b f
y) = a g -> b g -> Product a b g
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (a g -> b g -> Product a b g)
-> e (a g) -> e (b g -> Product a b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: k). f a -> e (g a)) -> a f -> e (a 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> a f -> e (a g)
btraverse f a -> e (g a)
forall (a :: k). f a -> e (g a)
f a f
x e (b g -> Product a b g) -> e (b g) -> e (Product a b g)
forall a b. e (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (a :: k). f a -> e (g a)) -> b f -> e (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> e (g a)
forall (a :: k). f a -> e (g a)
f b f
y
  {-# INLINE btraverse #-}

instance (TraversableB a, TraversableB b) => TraversableB (Sum a b) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Sum a b f -> e (Sum a b g)
btraverse forall (a :: k). f a -> e (g a)
f (InL a f
x) = a g -> Sum a b g
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (a g -> Sum a b g) -> e (a g) -> e (Sum a b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: k). f a -> e (g a)) -> a f -> e (a 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> a f -> e (a g)
btraverse f a -> e (g a)
forall (a :: k). f a -> e (g a)
f a f
x
  btraverse forall (a :: k). f a -> e (g a)
f (InR b f
x) = b g -> Sum a b g
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (b g -> Sum a b g) -> e (b g) -> e (Sum a b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: k). f a -> e (g a)) -> b f -> e (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> e (g a)
forall (a :: k). f a -> e (g a)
f b f
x
  {-# INLINE btraverse #-}

instance TraversableB (Const a) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Const a f -> e (Const a g)
btraverse forall (a :: k). f a -> e (g a)
_ (Const a
x) = Const a g -> e (Const a g)
forall a. a -> e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Const a g
forall {k} a (b :: k). a -> Const a b
Const a
x)
  {-# INLINE btraverse #-}

instance (Traversable f, TraversableB b) => TraversableB (f `Compose` b) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a))
-> Compose f b f -> e (Compose f b g)
btraverse forall (a :: k). f a -> e (g a)
h (Compose f (b f)
x)
    = f (b g) -> Compose f b g
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (b g) -> Compose f b g) -> e (f (b g)) -> e (Compose f b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b f -> e (b g)) -> f (b f) -> e (f (b g))
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) -> f a -> f (f b)
traverse ((forall (a :: k). f a -> e (g a)) -> b f -> e (b 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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse f a -> e (g a)
forall (a :: k). f a -> e (g a)
h) f (b f)
x
  {-# INLINE btraverse #-}

-- -----------------------------------------------------------
-- Instances for transformer types
-- -----------------------------------------------------------

instance TraversableB (Constant a) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a))
-> Constant a f -> e (Constant a g)
btraverse forall (a :: k). f a -> e (g a)
_ (Constant a
x) = Constant a g -> e (Constant a g)
forall a. a -> e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Constant a g
forall {k} a (b :: k). a -> Constant a b
Constant a
x)
  {-# INLINE btraverse #-}