{-# LANGUAGE PolyKinds    #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Barbies.Internal.TraversableT
  ( TraversableT(..)
  , ttraverse_
  , tsequence
  , tsequence'
  , tfoldMap

  , CanDeriveTraversableT
  , ttraverseDefault
  )

where

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

import Control.Applicative.Backwards(Backwards (..))
import Control.Applicative.Lift(Lift(..))
import Control.Monad.Trans.Except(ExceptT(..))
import Control.Monad.Trans.Identity(IdentityT(..))
import Control.Monad.Trans.Maybe(MaybeT(..))
import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..))
import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..))

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

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

  default ttraverse
    :: ( Applicative e, CanDeriveTraversableT t f g x)
    => (forall a . f a -> e (g a)) -> t f x -> e (t g x)
  ttraverse = (forall (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
forall {k1} {k} (t :: (k1 -> *) -> k -> *) (f :: k1 -> *)
       (g :: k1 -> *) (e :: * -> *) (x :: k).
(Applicative e, CanDeriveTraversableT t f g x) =>
(forall (a :: k1). f a -> e (g a)) -> t f x -> e (t g x)
ttraverseDefault



-- | Map each element to an action, evaluate these actions from left to right,
--   and ignore the results.
ttraverse_
  :: (TraversableT t, Applicative e)
  => (forall a. f a -> e c)
  -> t f x -> e ()
ttraverse_ :: forall {k} {k'} (t :: (k -> *) -> k' -> *) (e :: * -> *)
       (f :: k -> *) c (x :: k').
(TraversableT t, Applicative e) =>
(forall (a :: k). f a -> e c) -> t f x -> e ()
ttraverse_ forall (a :: k). f a -> e c
f
  = e (t (Const ()) x) -> e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (e (t (Const ()) x) -> e ())
-> (t f x -> e (t (Const ()) x)) -> t f x -> e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> e (Const () a))
-> t f x -> e (t (Const ()) x)
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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *) (x :: k').
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
ttraverse ((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.
tsequence
  :: (Applicative e, TraversableT t)
  => t (Compose e f) x
  -> e (t f x)
tsequence :: forall {k} {k'} (e :: * -> *) (t :: (k -> *) -> k' -> *)
       (f :: k -> *) (x :: k').
(Applicative e, TraversableT t) =>
t (Compose e f) x -> e (t f x)
tsequence
  = (forall (a :: k). Compose e f a -> e (f a))
-> t (Compose e f) x -> e (t f x)
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)
forall (e :: * -> *) (f :: k -> *) (g :: k -> *) (x :: k').
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
ttraverse 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 'tsequence' with @f@ specialized to 'Identity'.
tsequence'
  :: (Applicative e, TraversableT t)
  => t e x
  -> e (t Identity x)
tsequence' :: forall {k'} (e :: * -> *) (t :: (* -> *) -> k' -> *) (x :: k').
(Applicative e, TraversableT t) =>
t e x -> e (t Identity x)
tsequence'
  = (forall a. e a -> e (Identity a)) -> t e x -> e (t Identity x)
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)
forall (e :: * -> *) (f :: * -> *) (g :: * -> *) (x :: k').
Applicative e =>
(forall a. f a -> e (g a)) -> t f x -> e (t g x)
ttraverse ((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.
tfoldMap
  :: ( TraversableT t, Monoid m)
  => (forall a. f a -> m)
  -> t f x
  -> m
tfoldMap :: forall {k} {k'} (t :: (k -> *) -> k' -> *) m (f :: k -> *)
       (x :: k').
(TraversableT t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f x -> m
tfoldMap forall (a :: k). f a -> m
f
  = Wr m () -> m
forall w a. Monoid w => Wr w a -> w
execWr (Wr m () -> m) -> (t f x -> Wr m ()) -> t f x -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). f a -> Wr m ()) -> t f x -> Wr m ()
forall {k} {k'} (t :: (k -> *) -> k' -> *) (e :: * -> *)
       (f :: k -> *) c (x :: k').
(TraversableT t, Applicative e) =>
(forall (a :: k). f a -> e c) -> t f x -> e ()
ttraverse_ (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)


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

-- | Default implementation of 'ttraverse' based on 'Generic'.
ttraverseDefault
  :: forall t f g e x
  .  (Applicative e, CanDeriveTraversableT t f g x)
  => (forall a . f a -> e (g a))
  -> t f x -> e (t g x)
ttraverseDefault :: forall {k1} {k} (t :: (k1 -> *) -> k -> *) (f :: k1 -> *)
       (g :: k1 -> *) (e :: * -> *) (x :: k).
(Applicative e, CanDeriveTraversableT t f g x) =>
(forall (a :: k1). f a -> e (g a)) -> t f x -> e (t g x)
ttraverseDefault forall (a :: k1). f a -> e (g a)
h
  = (Zip
   (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) Any
 -> t g x)
-> e (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
        (Rep (t g x))
        Any)
-> e (t g x)
forall a b. (a -> b) -> e a -> e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy 1 -> RepP 1 (t g x) Any -> t g x
forall (n :: Natural) a x.
GenericP n a =>
Proxy n -> RepP n a x -> a
forall x. Proxy 1 -> RepP 1 (t g x) x -> t g x
toP (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @1)) (e (Zip
      (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
      (Rep (t g x))
      Any)
 -> e (t g x))
-> (t f x
    -> e (Zip
            (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
            (Rep (t g x))
            Any))
-> t f x
-> e (t g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy 1
-> (forall (a :: k1). f a -> e (g a))
-> Zip
     (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) Any
-> e (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
        (Rep (t g x))
        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 1
-> (forall (a :: k1). f a -> t (g a))
-> Zip
     (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) x
-> t (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) x)
gtraverse (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @1) f a -> e (g a)
forall (a :: k1). f a -> e (g a)
h (Zip
   (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) Any
 -> e (Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
         (Rep (t g x))
         Any))
-> (t f x
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x))
         (Rep (t f x))
         Any)
-> t f x
-> e (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
        (Rep (t g x))
        Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy 1 -> t f x -> RepP 1 (t f x) Any
forall (n :: Natural) a x.
GenericP n a =>
Proxy n -> a -> RepP n a x
forall x. Proxy 1 -> t f x -> RepP 1 (t f x) x
fromP (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @1)
{-# INLINE ttraverseDefault #-}


-- ------------------------------------------------------------
-- Generic derivation: Special cases for TraversableT
-- -----------------------------------------------------------

type P = Param

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

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


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

instance Traversable f => TraversableT (Compose f) where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a))
-> Compose f f x -> e (Compose f g x)
ttraverse forall (a :: k'). f a -> e (g a)
h (Compose f (f x)
fga)
    = f (g x) -> Compose f g x
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> Compose f g x) -> e (f (g x)) -> e (Compose f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f x -> e (g x)) -> f (f x) -> e (f (g x))
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 f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f (f x)
fga
  {-# INLINE ttraverse #-}

instance TraversableT (Product f) where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a))
-> Product f f x -> e (Product f g x)
ttraverse forall (a :: k'). f a -> e (g a)
h (Pair f x
fa f x
ga) = f x -> g x -> Product f g x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f x
fa (g x -> Product f g x) -> e (g x) -> e (Product f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f x
ga
  {-# INLINE ttraverse #-}

instance TraversableT (Sum f) where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a)) -> Sum f f x -> e (Sum f g x)
ttraverse forall (a :: k'). f a -> e (g a)
h = \case
    InL f x
fa -> Sum f g x -> e (Sum f g x)
forall a. a -> e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sum f g x -> e (Sum f g x)) -> Sum f g x -> e (Sum f g x)
forall a b. (a -> b) -> a -> b
$ f x -> Sum f g x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f x
fa
    InR f x
ga -> g x -> Sum f g x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g x -> Sum f g x) -> e (g x) -> e (Sum f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f x
ga
  {-# INLINE ttraverse #-}

-- -----------------------------------------------------------
-- Instances for transformers types
-- -----------------------------------------------------------

instance TraversableT Backwards where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a))
-> Backwards f x -> e (Backwards g x)
ttraverse forall (a :: k'). f a -> e (g a)
h (Backwards f x
fa)
    = g x -> Backwards g x
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (g x -> Backwards g x) -> e (g x) -> e (Backwards g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f x
fa
  {-# INLINE ttraverse #-}

instance TraversableT Lift where
  ttraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *) x.
Applicative e =>
(forall a. f a -> e (g a)) -> Lift f x -> e (Lift g x)
ttraverse forall a. f a -> e (g a)
h = \case
    Pure  x
a  -> Lift g x -> e (Lift g x)
forall a. a -> e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lift g x -> e (Lift g x)) -> Lift g x -> e (Lift g x)
forall a b. (a -> b) -> a -> b
$ x -> Lift g x
forall (f :: * -> *) a. a -> Lift f a
Pure x
a
    Other f x
fa -> g x -> Lift g x
forall (f :: * -> *) a. f a -> Lift f a
Other (g x -> Lift g x) -> e (g x) -> e (Lift g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall a. f a -> e (g a)
h f x
fa
  {-# INLINE ttraverse #-}

instance TraversableT Reverse where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a))
-> Reverse f x -> e (Reverse g x)
ttraverse forall (a :: k'). f a -> e (g a)
h (Reverse f x
fa) = g x -> Reverse g x
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (g x -> Reverse g x) -> e (g x) -> e (Reverse g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f x
fa
  {-# INLINE ttraverse #-}

instance TraversableT (ExceptT e) where
  ttraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *) x.
Applicative e =>
(forall a. f a -> e (g a)) -> ExceptT e f x -> e (ExceptT e g x)
ttraverse forall a. f a -> e (g a)
h (ExceptT f (Either e x)
mea)
    = g (Either e x) -> ExceptT e g x
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (g (Either e x) -> ExceptT e g x)
-> e (g (Either e x)) -> e (ExceptT e g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either e x) -> e (g (Either e x))
forall a. f a -> e (g a)
h f (Either e x)
mea
  {-# INLINE ttraverse #-}

instance TraversableT IdentityT where
  ttraverse :: forall (e :: * -> *) (f :: k' -> *) (g :: k' -> *) (x :: k').
Applicative e =>
(forall (a :: k'). f a -> e (g a))
-> IdentityT f x -> e (IdentityT g x)
ttraverse forall (a :: k'). f a -> e (g a)
h (IdentityT f x
ma)
    = g x -> IdentityT g x
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (g x -> IdentityT g x) -> e (g x) -> e (IdentityT g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> e (g x)
forall (a :: k'). f a -> e (g a)
h f x
ma
  {-# INLINE ttraverse #-}

instance TraversableT MaybeT where
  ttraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *) x.
Applicative e =>
(forall a. f a -> e (g a)) -> MaybeT f x -> e (MaybeT g x)
ttraverse forall a. f a -> e (g a)
h (MaybeT f (Maybe x)
mma)
    = g (Maybe x) -> MaybeT g x
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (g (Maybe x) -> MaybeT g x) -> e (g (Maybe x)) -> e (MaybeT g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe x) -> e (g (Maybe x))
forall a. f a -> e (g a)
h f (Maybe x)
mma
  {-# INLINE ttraverse #-}

instance TraversableT (Lazy.WriterT w) where
  ttraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *) x.
Applicative e =>
(forall a. f a -> e (g a)) -> WriterT w f x -> e (WriterT w g x)
ttraverse forall a. f a -> e (g a)
h (Lazy.WriterT f (x, w)
maw)
    = g (x, w) -> WriterT w g x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (g (x, w) -> WriterT w g x) -> e (g (x, w)) -> e (WriterT w g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (x, w) -> e (g (x, w))
forall a. f a -> e (g a)
h f (x, w)
maw
  {-# INLINE ttraverse #-}

instance TraversableT (Strict.WriterT w) where
  ttraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *) x.
Applicative e =>
(forall a. f a -> e (g a)) -> WriterT w f x -> e (WriterT w g x)
ttraverse forall a. f a -> e (g a)
h (Strict.WriterT f (x, w)
maw)
    = g (x, w) -> WriterT w g x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (g (x, w) -> WriterT w g x) -> e (g (x, w)) -> e (WriterT w g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (x, w) -> e (g (x, w))
forall a. f a -> e (g a)
h f (x, w)
maw
  {-# INLINE ttraverse #-}