{-# 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 k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *)
       (e :: * -> *) (x :: k).
(Applicative e, CanDeriveTraversableT t f g x) =>
(forall (a :: k). 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 (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)
ttraverse ((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.
tsequence
  :: (Applicative e, TraversableT t)
  => t (Compose e f) x
  -> e (t f x)
tsequence :: 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)
ttraverse 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 'tsequence' with @f@ specialized to 'Identity'.
tsequence'
  :: (Applicative e, TraversableT t)
  => t e x
  -> e (t Identity x)
tsequence' :: 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)
ttraverse ((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.
tfoldMap
  :: ( TraversableT t, Monoid m)
  => (forall a. f a -> m)
  -> t f x
  -> m
tfoldMap :: (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 (a :: k). f a -> e (g a)) -> t f x -> e (t g x)
ttraverseDefault forall (a :: k). 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 (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 :: Nat) a x. GenericP n a => Proxy n -> RepP n a x -> a
toP (Proxy 1
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 :: k). 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 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 1
forall k (t :: k). Proxy t
Proxy @1) forall (a :: k). 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 :: Nat) a x. GenericP n a => Proxy n -> a -> RepP n a x
fromP (Proxy 1
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 :: 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 (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)
ttraverse 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 i c k (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 p a k (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 :: 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 (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)
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)
ttraverse 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 i c k (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 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
   , 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 :: 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 (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)
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)
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)
ttraverse 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 i c k (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 p a k (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 (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)
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 (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 (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 (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 (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 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 (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 (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 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 (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 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 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 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 #-}