{-# 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 k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (e :: * -> *).
(Applicative e, CanDeriveTraversableB b f g) =>
(forall (a :: k). 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 (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)
btraverse ((c -> Const () a) -> e c -> e (Const () a)
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 :: 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)
btraverse forall (a :: k). Compose e f a -> e (f a)
forall k1 (f :: k1 -> *) k2 (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' :: 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)
btraverse ((a -> Identity a) -> e a -> e (Identity a)
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 (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 (a :: k). f a -> e (g a)) -> b f -> e (b g)
gbtraverseDefault forall (a :: k). 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy 0 -> RepP 0 (b g) Any -> b g
forall (n :: Nat) a x. GenericP n a => Proxy n -> RepP n a x -> a
toP (Proxy 0
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 :: k). 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 k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse (Proxy 0
forall k (t :: k). Proxy t
Proxy @0) forall (a :: k). 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 :: Nat) a x. GenericP n a => Proxy n -> a -> RepP n a x
fromP (Proxy 0
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 :: 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 (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)
btraverse 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 i c k (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 p a k (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 :: 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 (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)
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)
btraverse 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 i c k (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 p a k (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 :: 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 (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)
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)
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)
btraverse 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 i c k (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 p a k (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}


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

instance TraversableB Proxy where
  btraverse :: (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 (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 (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)
btraverse 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 (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)
btraverse 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 (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)
btraverse 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)
btraverse forall (a :: k). f a -> e (g a)
f b f
x
  {-# INLINE btraverse #-}

instance TraversableB (Const a) where
  btraverse :: (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 (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 (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)
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)
btraverse 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 (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 (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 #-}