-- |
-- Module      : Data.HFunctor.HTraversable
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides a "higher-order" version of 'Traversable' and 'Traversable1',
-- in the same way that 'HFunctor' is a higher-order version of 'Functor'.
--
-- Note that in theory we could have 'HFoldable' as well, in the hierarchy,
-- to represent something that does not have an 'HFunctor' instance.
-- But it is not clear exactly why it would be useful as an abstraction.
-- This may be added in the future if use cases pop up.  For the most part,
-- the things you would want to do with an 'HFoldable', you could do with
-- 'hfoldMap' or 'iget'; it could in theory be useful for things without
-- 'HTraversable' or 'Interpret' instances, but it isn't clear what those
-- instances might be.
--
-- For instances of 'Interpret', there is some overlap with the
-- functionality of 'iget', 'icollect', and 'icollect1'.
--
-- @since 0.3.6.0
module Data.HFunctor.HTraversable (
  -- * 'HTraversable'
    HTraversable(..)
  , hsequence, hfoldMap, htoList, hmapDefault, hfor
  -- * 'HTraversable1'
  , HTraversable1(..)
  , hsequence1, hfoldMap1, htoNonEmpty, hfor1
  ) where

import           Control.Applicative
import           Control.Applicative.Backwards
import           Control.Applicative.Free
import           Control.Applicative.Lift
import           Control.Applicative.ListF
import           Control.Applicative.Step
import           Control.Comonad.Trans.Env
import           Control.Monad.Trans.Compose
import           Control.Monad.Trans.Identity
import           Control.Monad.Trans.Maybe
import           Control.Natural
import           Data.Bifunctor.Joker
import           Data.Bitraversable
import           Data.Coerce
import           Data.Functor.Apply
import           Data.Functor.Coyoneda
import           Data.Functor.Day                    (Day(..))
import           Data.Functor.Identity
import           Data.Functor.Product
import           Data.Functor.Reverse
import           Data.Functor.Sum
import           Data.Functor.These
import           Data.HFunctor
import           Data.HFunctor.Internal
import           Data.HFunctor.Interpret
import           Data.List.NonEmpty                  (NonEmpty)
import           Data.Semigroup                      (Endo(..))
import           Data.Semigroup.Traversable
import           Data.Tagged
import           Data.Vinyl.CoRec
import           Data.Vinyl.Core                     (Rec)
import           Data.Vinyl.Recursive
import           GHC.Generics
import qualified Control.Alternative.Free            as Alt
import qualified Control.Applicative.Free            as Ap
import qualified Control.Applicative.Free.Fast       as FAF
import qualified Control.Applicative.Free.Final      as FA
import qualified Control.Applicative.Lift            as Lift
import qualified Data.Functor.Contravariant.Coyoneda as CCY
import qualified Data.Functor.Invariant.Day          as ID
import qualified Data.Functor.Invariant.Night        as IN
import qualified Data.SOP                            as SOP


-- | A higher-kinded version of 'Traversable1', in the same way that
-- 'HFunctor' is the higher-kinded version of 'Functor'.  Gives you an
-- "effectful" 'hmap', in the same way that 'traverse1' gives you an
-- effectful 'fmap', guaranteeing at least one item.
--
-- The typical analogues of 'Traversable1' laws apply.
--
-- @since 0.3.6.0
class HTraversable t => HTraversable1 t where
    -- | An "effectful" 'hmap', in the same way that 'traverse1' is an
    -- effectful 'fmap', guaranteeing at least one item.
    htraverse1 :: Apply h => (forall x. f x -> h (g x)) -> t f a -> h (t g a)

-- | A wrapper over a common pattern of "inverting" layers of a functor
-- combinator that always contains at least one @f@ item.
--
-- @since 0.3.6.0
hsequence1 :: (HTraversable1 t, Apply h) => t (h :.: f) a -> h (t f a)
hsequence1 :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
t (h :.: f) a -> h (t f a)
hsequence1 = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

-- | Collect all the @f x@s inside a @t f a@ into a semigroupoidal result
-- using a projecting function.
--
-- See 'iget'.
--
-- @since 0.3.6.0
hfoldMap1 :: (HTraversable1 t, Semigroup m) => (forall x. f x -> m) -> t f a -> m
hfoldMap1 :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) m (f :: k -> *)
       (a :: k1).
(HTraversable1 t, Semigroup m) =>
(forall (x :: k). f x -> m) -> t f a -> m
hfoldMap1 forall (x :: k). f x -> m
f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). f x -> m
f)

-- | Collect all the @f x@s inside a @t f a@ into a non-empty list, using
-- a projecting function.
--
-- See 'icollect1'.
--
-- @since 0.3.6.0
htoNonEmpty :: HTraversable1 t => (forall x. f x -> b) -> t f a -> NonEmpty b
htoNonEmpty :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (f :: k -> *) b
       (a :: k1).
HTraversable1 t =>
(forall (x :: k). f x -> b) -> t f a -> NonEmpty b
htoNonEmpty forall (x :: k). f x -> b
f = forall a. NDL a -> NonEmpty a
fromNDL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (t :: (k -> *) -> k1 -> *) m (f :: k -> *)
       (a :: k1).
(HTraversable1 t, Semigroup m) =>
(forall (x :: k). f x -> m) -> t f a -> m
hfoldMap1 (forall a. a -> NDL a
ndlSingleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). f x -> b
f)

-- | A flipped version of 'htraverse1'.
--
-- @since 0.4.0.0
hfor1 :: (HTraversable1 t, Apply h) => t f a -> (forall x. f x -> h (g x)) -> h (t g a)
hfor1 :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (a :: k1) (g :: k -> *).
(HTraversable1 t, Apply h) =>
t f a -> (forall (x :: k). f x -> h (g x)) -> h (t g a)
hfor1 t f a
x forall (x :: k). f x -> h (g x)
f = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 forall (x :: k). f x -> h (g x)
f t f a
x

-- | A higher-kinded version of 'Traversable', in the same way that
-- 'HFunctor' is the higher-kinded version of 'Functor'.  Gives you an
-- "effectful" 'hmap', in the same way that 'traverse' gives you an
-- effectful 'fmap'.
--
-- The typical analogues of 'Traversable' laws apply.
--
-- @since 0.3.6.0
class HFunctor t => HTraversable t where
    -- | An "effectful" 'hmap', in the same way that 'traverse' is an
    -- effectful 'fmap'.
    htraverse :: Applicative h => (forall x. f x -> h (g x)) -> t f a -> h (t g a)

-- | A wrapper over a common pattern of "inverting" layers of a functor
-- combinator.
--
-- @since 0.3.6.0
hsequence :: (HTraversable t, Applicative h) => t (h :.: f) a -> h (t f a)
hsequence :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
t (h :.: f) a -> h (t f a)
hsequence = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

-- | Collect all the @f x@s inside a @t f a@ into a monoidal result using
-- a projecting function.
--
-- See 'iget'.
--
-- @since 0.3.6.0
hfoldMap :: (HTraversable t, Monoid m) => (forall x. f x -> m) -> t f a -> m
hfoldMap :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) m (f :: k -> *)
       (a :: k1).
(HTraversable t, Monoid m) =>
(forall (x :: k). f x -> m) -> t f a -> m
hfoldMap forall (x :: k). f x -> m
f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). f x -> m
f)

-- | Collect all the @f x@s inside a @t f a@ into a list, using
-- a projecting function.
--
-- See 'icollect'.
--
-- @since 0.3.6.0
htoList :: HTraversable t => (forall x. f x -> b) -> t f a -> [b]
htoList :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (f :: k -> *) b
       (a :: k1).
HTraversable t =>
(forall (x :: k). f x -> b) -> t f a -> [b]
htoList forall (x :: k). f x -> b
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (t :: (k -> *) -> k1 -> *) m (f :: k -> *)
       (a :: k1).
(HTraversable t, Monoid m) =>
(forall (x :: k). f x -> m) -> t f a -> m
hfoldMap (forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: k). f x -> b
f)

-- | A flipped version of 'htraverse'.
--
-- @since 0.4.0.0
hfor :: (HTraversable t, Applicative h) => t f a -> (forall x. f x -> h (g x)) -> h (t g a)
hfor :: forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (a :: k1) (g :: k -> *).
(HTraversable t, Applicative h) =>
t f a -> (forall (x :: k). f x -> h (g x)) -> h (t g a)
hfor t f a
x forall (x :: k). f x -> h (g x)
f = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall (x :: k). f x -> h (g x)
f t f a
x

-- | An implementation of 'hmap' defined using 'htraverse'.
--
-- @since 0.3.6.0
hmapDefault :: HTraversable t => (f ~> g) -> t f ~> t g
hmapDefault :: forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HTraversable t =>
(f ~> g) -> t f ~> t g
hmapDefault f ~> g
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
f)

instance HTraversable Coyoneda where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
htraverse forall x. f x -> h (g x)
f (Coyoneda b -> a
g f b
x) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x

instance HTraversable1 Coyoneda where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
htraverse1 forall x. f x -> h (g x)
f (Coyoneda b -> a
g f b
x) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x

instance HTraversable CCY.Coyoneda where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
htraverse forall x. f x -> h (g x)
f (CCY.Coyoneda a -> b
g f b
x) = forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
CCY.Coyoneda a -> b
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x

instance HTraversable1 CCY.Coyoneda where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
htraverse1 forall x. f x -> h (g x)
f (CCY.Coyoneda a -> b
g f b
x) = forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
CCY.Coyoneda a -> b
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x

instance HTraversable Ap where
    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> Ap f a -> h (Ap g a)
    htraverse :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Ap f a -> h (Ap g a)
htraverse forall x. f x -> h (g x)
f = forall b. Ap f b -> h (Ap g b)
go
      where
        go :: Ap f b -> h (Ap g b)
        go :: forall b. Ap f b -> h (Ap g b)
go = \case
          Ap.Pure b
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a (f :: * -> *). a -> Ap f a
Ap.Pure b
x)
          Ap.Ap f a1
x Ap f (a1 -> b)
xs -> forall (f :: * -> *) a1 a. f a1 -> Ap f (a1 -> a) -> Ap f a
Ap.Ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a1
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b. Ap f b -> h (Ap g b)
go Ap f (a1 -> b)
xs

instance HTraversable ListF where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> ListF f a -> h (ListF g a)
htraverse forall (x :: k1). f x -> h (g x)
f (ListF [f a]
xs) = forall {k} (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f [f a]
xs

instance HTraversable NonEmptyF where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> NonEmptyF f a -> h (NonEmptyF g a)
htraverse forall (x :: k1). f x -> h (g x)
f (NonEmptyF NonEmpty (f a)
xs) = forall {k} (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f NonEmpty (f a)
xs

instance HTraversable1 NonEmptyF where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> NonEmptyF f a -> h (NonEmptyF g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (NonEmptyF NonEmpty (f a)
xs) = forall {k} (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 forall (x :: k1). f x -> h (g x)
f NonEmpty (f a)
xs

instance HTraversable MaybeF where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> MaybeF f a -> h (MaybeF g a)
htraverse forall (x :: k1). f x -> h (g x)
f (MaybeF Maybe (f a)
xs) = forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> MaybeF f a
MaybeF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f Maybe (f a)
xs

instance HTraversable (MapF k) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> MapF k f a -> h (MapF k g a)
htraverse forall (x :: k1). f x -> h (g x)
f (MapF Map k (f a)
xs) = forall {k} k1 (f :: k -> *) (a :: k). Map k1 (f a) -> MapF k1 f a
MapF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f Map k (f a)
xs

instance HTraversable (NEMapF k) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> NEMapF k f a -> h (NEMapF k g a)
htraverse forall (x :: k1). f x -> h (g x)
f (NEMapF NEMap k (f a)
xs) = forall {k} k1 (f :: k -> *) (a :: k).
NEMap k1 (f a) -> NEMapF k1 f a
NEMapF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f NEMap k (f a)
xs

instance HTraversable1 (NEMapF k) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> NEMapF k f a -> h (NEMapF k g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (NEMapF NEMap k (f a)
xs) = forall {k} k1 (f :: k -> *) (a :: k).
NEMap k1 (f a) -> NEMapF k1 f a
NEMapF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 forall (x :: k1). f x -> h (g x)
f NEMap k (f a)
xs

instance HTraversable Alt.Alt where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Alt f a -> h (Alt g a)
htraverse forall x. f x -> h (g x)
f (Alt.Alt [AltF f a]
xs) = forall (f :: * -> *) a. [AltF f a] -> Alt f a
Alt.Alt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f) [AltF f a]
xs

instance HTraversable Alt.AltF where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> AltF f a -> h (AltF g a)
htraverse forall x. f x -> h (g x)
f = \case
      Alt.Ap f a1
x Alt f (a1 -> a)
xs -> forall (f :: * -> *) a1 a. f a1 -> Alt f (a1 -> a) -> AltF f a
Alt.Ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a1
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f Alt f (a1 -> a)
xs
      Alt.Pure a
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a (f :: * -> *). a -> AltF f a
Alt.Pure a
x)

instance HTraversable Step where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> Step f a -> h (Step g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Step Natural
n f a
x) = forall {k} (f :: k -> *) (a :: k). Natural -> f a -> Step f a
Step Natural
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable1 Step where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x)) -> Step f a -> h (Step g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Step Natural
n f a
x) = forall {k} (f :: k -> *) (a :: k). Natural -> f a -> Step f a
Step Natural
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable Steps where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> Steps f a -> h (Steps g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Steps NEMap Natural (f a)
x) = forall {k} (f :: k -> *) (a :: k). NEMap Natural (f a) -> Steps f a
Steps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f NEMap Natural (f a)
x

instance HTraversable1 Steps where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x)) -> Steps f a -> h (Steps g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Steps NEMap Natural (f a)
x) = forall {k} (f :: k -> *) (a :: k). NEMap Natural (f a) -> Steps f a
Steps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 forall (x :: k1). f x -> h (g x)
f NEMap Natural (f a)
x

instance HTraversable Flagged where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> Flagged f a -> h (Flagged g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Flagged Bool
b f a
x) = forall {k} (f :: k -> *) (a :: k). Bool -> f a -> Flagged f a
Flagged Bool
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable1 Flagged where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> Flagged f a -> h (Flagged g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Flagged Bool
b f a
x) = forall {k} (f :: k -> *) (a :: k). Bool -> f a -> Flagged f a
Flagged Bool
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable MaybeT where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> MaybeT f a -> h (MaybeT g a)
htraverse forall x. f x -> h (g x)
f (MaybeT f (Maybe a)
x) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f (Maybe a)
x

instance HTraversable1 MaybeT where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> MaybeT f a -> h (MaybeT g a)
htraverse1 forall x. f x -> h (g x)
f (MaybeT f (Maybe a)
x) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f (Maybe a)
x

instance HTraversable FAF.Ap where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Ap f a -> h (Ap g a)
htraverse = forall {k} (h :: * -> *) (t :: (k -> *) -> k -> *) (g :: k -> *)
       (f :: k -> *) (a :: k).
(Functor h, Interpret t (Comp h (t g))) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
itraverse

instance HTraversable FA.Ap where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Ap f a -> h (Ap g a)
htraverse = forall {k} (h :: * -> *) (t :: (k -> *) -> k -> *) (g :: k -> *)
       (f :: k -> *) (a :: k).
(Functor h, Interpret t (Comp h (t g))) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
itraverse

instance HTraversable IdentityT where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> IdentityT f a -> h (IdentityT g a)
htraverse forall (x :: k1). f x -> h (g x)
f (IdentityT f a
x) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable1 IdentityT where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> IdentityT f a -> h (IdentityT g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (IdentityT f a
x) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable Lift where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Lift f a -> h (Lift g a)
htraverse forall x. f x -> h (g x)
f = \case
      Lift.Pure  a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. a -> Lift f a
Lift.Pure a
x)
      Lift.Other f a
y -> forall (f :: * -> *) a. f a -> Lift f a
Lift.Other forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
y

instance HTraversable MaybeApply where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> MaybeApply f a -> h (MaybeApply g a)
htraverse forall x. f x -> h (g x)
f (MaybeApply Either (f a) a
x) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse forall x. f x -> h (g x)
f forall (f :: * -> *) a. Applicative f => a -> f a
pure Either (f a) a
x

instance HTraversable Backwards where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> Backwards f a -> h (Backwards g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Backwards f a
x) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable WrappedApplicative where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x))
-> WrappedApplicative f a -> h (WrappedApplicative g a)
htraverse forall x. f x -> h (g x)
f (WrapApplicative f a
x) = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
x

instance HTraversable Tagged where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) a.
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Tagged f a -> h (Tagged g a)
htraverse forall (x :: k). f x -> h (g x)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

instance HTraversable Reverse where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> Reverse f a -> h (Reverse g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Reverse f a
x) = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable1 Reverse where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> Reverse f a -> h (Reverse g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Reverse f a
x) = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance (HTraversable s, HTraversable t) => HTraversable (ComposeT s t) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x))
-> ComposeT s t f a -> h (ComposeT s t g a)
htraverse forall x. f x -> h (g x)
f (ComposeT s (t f) a
x) = forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
f (g m) a -> ComposeT f g m a
ComposeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse (forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f) s (t f) a
x

instance Traversable f => HTraversable ((:.:) f) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> (:.:) f f a -> h ((:.:) f g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Comp1 f (f a)
x) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (x :: k1). f x -> h (g x)
f f (f a)
x

instance Traversable1 f => HTraversable1 ((:.:) f) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> (:.:) f f a -> h ((:.:) f g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Comp1 f (f a)
x) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 forall (x :: k1). f x -> h (g x)
f f (f a)
x

instance HTraversable (M1 i c) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> M1 i c f a -> h (M1 i c g a)
htraverse forall (x :: k1). f x -> h (g x)
f (M1 f a
x) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable1 (M1 i c) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x)) -> M1 i c f a -> h (M1 i c g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (M1 f a
x) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x

instance HTraversable Void2 where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Void2 f a -> h (Void2 g a)
htraverse forall (x :: k). f x -> h (g x)
_ = \case {}

instance HTraversable1 Void2 where
    htraverse1 :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Apply h =>
(forall (x :: k). f x -> h (g x)) -> Void2 f a -> h (Void2 g a)
htraverse1 forall (x :: k). f x -> h (g x)
_ = \case {}

instance HTraversable (EnvT e) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> EnvT e f a -> h (EnvT e g a)
htraverse forall x. f x -> h (g x)
f (EnvT e
e f a
x) = forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
x

instance HTraversable1 (EnvT e) where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> EnvT e f a -> h (EnvT e g a)
htraverse1 forall x. f x -> h (g x)
f (EnvT e
e f a
x) = forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
x

instance HTraversable Rec where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: [k]).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Rec f a -> h (Rec g a)
htraverse = forall k (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: [k]).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Rec f a -> h (Rec g a)
rtraverse

instance HTraversable CoRec where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: [k]).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> CoRec f a -> h (CoRec g a)
htraverse forall (x :: k). f x -> h (g x)
f (CoRec f a1
x) = forall {k} (a1 :: k) (b :: [k]) (a :: k -> *).
RElem a1 b (RIndex a1 b) =>
a a1 -> CoRec a b
CoRec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). f x -> h (g x)
f f a1
x

instance HTraversable SOP.NP where
    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> SOP.NP f a -> h (SOP.NP g a)
    htraverse :: forall {k} (f :: k -> *) (g :: k -> *) (h :: * -> *) (a :: [k]).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> NP f a -> h (NP g a)
htraverse forall (x :: k). f x -> h (g x)
f = forall (b :: [k]). NP f b -> h (NP g b)
go
      where
        go :: SOP.NP f b -> h (SOP.NP g b)
        go :: forall (b :: [k]). NP f b -> h (NP g b)
go = \case
          NP f b
SOP.Nil     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (a :: k -> *). NP a '[]
SOP.Nil
          f x
x SOP.:* NP f xs
xs -> forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(SOP.:*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). f x -> h (g x)
f f x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (b :: [k]). NP f b -> h (NP g b)
go NP f xs
xs

instance HTraversable SOP.NS where
    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> SOP.NS f a -> h (SOP.NS g a)
    htraverse :: forall {k} (f :: k -> *) (g :: k -> *) (h :: * -> *) (a :: [k]).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> NS f a -> h (NS g a)
htraverse forall (x :: k). f x -> h (g x)
f = forall (b :: [k]). NS f b -> h (NS g b)
go
      where
        go :: SOP.NS f b -> h (SOP.NS g b)
        go :: forall (b :: [k]). NS f b -> h (NS g b)
go = \case
          SOP.Z f x
x  -> forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
SOP.Z forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). f x -> h (g x)
f f x
x
          SOP.S NS f xs
xs -> forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
SOP.S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: [k]). NS f b -> h (NS g b)
go NS f xs
xs

instance HTraversable1 SOP.NS where
    htraverse1
        :: forall f g h a. Apply h
        => (forall x. f x -> h (g x))
        -> SOP.NS f a
        -> h (SOP.NS g a)
    htraverse1 :: forall {k} (f :: k -> *) (g :: k -> *) (h :: * -> *) (a :: [k]).
Apply h =>
(forall (x :: k). f x -> h (g x)) -> NS f a -> h (NS g a)
htraverse1 forall (x :: k). f x -> h (g x)
f = forall (b :: [k]). NS f b -> h (NS g b)
go
      where
        go :: SOP.NS f b -> h (SOP.NS g b)
        go :: forall (b :: [k]). NS f b -> h (NS g b)
go = \case
          SOP.Z f x
x  -> forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
SOP.Z forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). f x -> h (g x)
f f x
x
          SOP.S NS f xs
xs -> forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
SOP.S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: [k]). NS f b -> h (NS g b)
go NS f xs
xs

instance HTraversable (Day f) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Day f f a -> h (Day f g a)
htraverse forall x. f x -> h (g x)
f (Day f b
x f c
y b -> c -> a
g) = (\g c
y' -> forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day f b
x g c
y' b -> c -> a
g) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c
y

instance HTraversable1 (Day f) where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Day f f a -> h (Day f g a)
htraverse1 forall x. f x -> h (g x)
f (Day f b
x f c
y b -> c -> a
g) = (\g c
y' -> forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day f b
x g c
y' b -> c -> a
g) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c
y

instance HTraversable (ID.Day f) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Day f f a -> h (Day f g a)
htraverse forall x. f x -> h (g x)
f (ID.Day f b
x f c
y b -> c -> a
g a -> (b, c)
h) = (\g c
y' -> forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day f b
x g c
y' b -> c -> a
g a -> (b, c)
h) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c
y

instance HTraversable1 (ID.Day f) where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Day f f a -> h (Day f g a)
htraverse1 forall x. f x -> h (g x)
f (ID.Day f b
x f c
y b -> c -> a
g a -> (b, c)
h) = (\g c
y' -> forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day f b
x g c
y' b -> c -> a
g a -> (b, c)
h) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c
y

instance HTraversable (IN.Night f) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Night f f a -> h (Night f g a)
htraverse forall x. f x -> h (g x)
f (IN.Night f b1
x f c1
y b1 -> a
g c1 -> a
h a -> Either b1 c1
j) = (\g c1
y' -> forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night f b1
x g c1
y' b1 -> a
g c1 -> a
h a -> Either b1 c1
j) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c1
y

instance HTraversable1 (IN.Night f) where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Night f f a -> h (Night f g a)
htraverse1 forall x. f x -> h (g x)
f (IN.Night f b1
x f c1
y b1 -> a
g c1 -> a
h a -> Either b1 c1
j) = (\g c1
y' -> forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night f b1
x g c1
y' b1 -> a
g c1 -> a
h a -> Either b1 c1
j) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f c1
y

instance HTraversable ((:*:) f) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> (:*:) f f a -> h ((:*:) f g a)
htraverse forall (x :: k1). f x -> h (g x)
f (f a
x :*: f a
y) = (f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable1 ((:*:) f) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> (:*:) f f a -> h ((:*:) f g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (f a
x :*: f a
y) = (f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable ((:+:) f) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> (:+:) f f a -> h ((:+:) f g a)
htraverse forall (x :: k1). f x -> h (g x)
f = \case
      L1 f a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f a
x)
      R1 f a
y -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable (Product f) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> Product f f a -> h (Product f g a)
htraverse forall (x :: k1). f x -> h (g x)
f (Pair f a
x f a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable1 (Product f) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> Product f f a -> h (Product f g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f (Pair f a
x f a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable (Sum f) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x)) -> Sum f f a -> h (Sum f g a)
htraverse forall (x :: k1). f x -> h (g x)
f = \case
      InL f a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f a
x)
      InR f a
y -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
y

instance HTraversable (Joker f) where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Joker f f a -> h (Joker f g a)
htraverse forall (x :: k). f x -> h (g x)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

instance HTraversable (These1 f) where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> These1 f f a -> h (These1 f g a)
htraverse forall x. f x -> h (g x)
f = \case
      This1  f a
x   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a. f a -> These1 f g a
This1 f a
x
      That1    f a
y -> forall (f :: * -> *) (g :: * -> *) a. g a -> These1 f g a
That1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
y
      These1 f a
x f a
y -> forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> These1 f g a
These1 f a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f a
y

instance HTraversable (Void3 f) where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> Void3 f f a -> h (Void3 f g a)
htraverse forall (x :: k). f x -> h (g x)
_ = \case {}

instance HTraversable ProxyF where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Applicative h =>
(forall (x :: k). f x -> h (g x)) -> ProxyF f a -> h (ProxyF g a)
htraverse forall (x :: k). f x -> h (g x)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

instance HTraversable (ConstF e) where
    htraverse :: forall (h :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k1).
Applicative h =>
(forall (x :: k). f x -> h (g x))
-> ConstF e f a -> h (ConstF e g a)
htraverse forall (x :: k). f x -> h (g x)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

instance HTraversable t => HTraversable (HLift t) where
    htraverse :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> HLift t f a -> h (HLift t g a)
htraverse forall (x :: k1). f x -> h (g x)
f = \case
      HPure  f a
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
f a -> HLift t f a
HPure  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x
      HOther t f a
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
t f a -> HLift t f a
HOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall (x :: k1). f x -> h (g x)
f t f a
x

instance HTraversable1 t => HTraversable1 (HLift t) where
    htraverse1 :: forall (h :: * -> *) (f :: k1 -> *) (g :: k1 -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> HLift t f a -> h (HLift t g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f = \case
      HPure  f a
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
f a -> HLift t f a
HPure  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f a
x
      HOther t f a
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
t f a -> HLift t f a
HOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f t f a
x

instance HTraversable t => HTraversable (HFree t) where
    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> HFree t f a -> h (HFree t g a)
    htraverse :: forall (f :: k1 -> *) (g :: k1 -> *) (h :: * -> *) (a :: k1).
Applicative h =>
(forall (x :: k1). f x -> h (g x))
-> HFree t f a -> h (HFree t g a)
htraverse forall (x :: k1). f x -> h (g x)
f = forall (b :: k1). HFree t f b -> h (HFree t g b)
go
      where
        go :: HFree t f b -> h (HFree t g b)
        go :: forall (b :: k1). HFree t f b -> h (HFree t g b)
go = \case
          HReturn f b
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
f a -> HFree t f a
HReturn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f b
x
          HJoin   t (HFree t f) b
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
t (HFree t f) a -> HFree t f a
HJoin   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall (b :: k1). HFree t f b -> h (HFree t g b)
go t (HFree t f) b
x

instance HTraversable1 t => HTraversable1 (HFree t) where
    htraverse1 :: forall f g h a. Apply h => (forall x. f x -> h (g x)) -> HFree t f a -> h (HFree t g a)
    htraverse1 :: forall (f :: k1 -> *) (g :: k1 -> *) (h :: * -> *) (a :: k1).
Apply h =>
(forall (x :: k1). f x -> h (g x))
-> HFree t f a -> h (HFree t g a)
htraverse1 forall (x :: k1). f x -> h (g x)
f = forall (b :: k1). HFree t f b -> h (HFree t g b)
go
      where
        go :: HFree t f b -> h (HFree t g b)
        go :: forall (b :: k1). HFree t f b -> h (HFree t g b)
go = \case
          HReturn f b
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
f a -> HFree t f a
HReturn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k1). f x -> h (g x)
f f b
x
          HJoin   t (HFree t f) b
x -> forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (a :: k).
t (HFree t f) a -> HFree t f a
HJoin   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 forall (b :: k1). HFree t f b -> h (HFree t g b)
go t (HFree t f) b
x