{-# language CPP #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language Trustworthy #-}
{-# language TypeOperators #-}
#if !defined(HLINT) && MIN_VERSION_base(4,10,0) && __GLASGOW_HASKELL__ >= 708
{-# language LambdaCase #-}
{-# language EmptyCase #-}
#endif
-- |
-- Copyright :  (c) 2019 Edward Kmett, 2019 Oleg Grenrus
-- License   :  BSD-2-Clause OR Apache-2.0
-- Maintainer:  Oleg Grenrus <oleg.grenrus@iki.fi>
-- Stability :  experimental
-- Portability: non-portable
--
-- "Higher-Kinded Data" such as it is
module Data.HKD
(
-- * "Natural" transformation
   type (~>)
-- * Functor
, FFunctor(..)
-- * Contravariant
, FContravariant(..)
-- * Foldable
, FFoldable(..)
, flength
, ftraverse_
, ffor_
-- * Traversable
, FTraversable(..)
, ffmapDefault
, ffoldMapDefault
, ffor
, fsequence
-- ** Generic derivation
, gftraverse
-- * Zip & Repeat
, FZip (..)
, FRepeat (..)
-- ** Generic derivation
, gfzipWith
, gfrepeat
-- * Higher kinded data
-- | See also "Data.Some" in @some@ package. @hkd@ provides instances for it.
, Logarithm(..)
, Tab(..)
, indexLogarithm
, Element(..)
, NT(..)
, Limit(..)
) where

#if MIN_VERSION_base(4,9,0)
import Data.Kind (Type)
#else
#define Type *
#endif

import Control.Applicative
import qualified Data.Monoid as Monoid
import Data.Semigroup (Semigroup (..))
import Data.Proxy (Proxy (..))
import Data.Functor.Identity (Identity (..))
import Data.Monoid (Monoid (..))

import GHC.Generics
import Data.Functor.Confusing

-- In older base:s types aren't PolyKinded
#if MIN_VERSION_base(4,9,0)
import Data.Coerce (Coercible, coerce)
import Data.Functor.Compose (Compose (..))
import Data.Functor.Product (Product (..))
import Data.Functor.Sum (Sum (..))
#endif

import Data.Some.GADT (Some (..), mapSome, foldSome)
import qualified Data.Some.Newtype as N
import qualified Data.Some.Church as C

#if MIN_VERSION_base(4,9,0)
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce

(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# :: forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
(.#) b -> c
f a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce b -> c
f

infixr 9 #.
infixr 8 .#
#endif

-------------------------------------------------------------------------------
-- wiggly arrow
-------------------------------------------------------------------------------

type f ~> g = forall a. f a -> g a

-------------------------------------------------------------------------------
-- FFunctor
-------------------------------------------------------------------------------

class FFunctor (t :: (k -> Type) -> Type) where
  ffmap :: (f ~> g) -> t f -> t g

instance FFunctor Proxy where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Proxy f -> Proxy g
ffmap f ~> g
_ Proxy f
Proxy = forall {k} (t :: k). Proxy t
Proxy

#if MIN_VERSION_base(4,9,0)
instance FFunctor (Const a) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Const a f -> Const a g
ffmap f ~> g
_ (Const a
a) = forall {k} a (b :: k). a -> Const a b
Const a
a

instance (Functor f, FFunctor g) => FFunctor (Compose f g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Compose f g f -> Compose f g g
ffmap f ~> g
f = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (FFunctor f, FFunctor g) => FFunctor (Product f g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Product f g f -> Product f g g
ffmap f ~> g
f (Pair f f
g g f
h) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f f f
g) (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f g f
h)

instance (FFunctor f, FFunctor g) => FFunctor (Sum f g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Sum f g f -> Sum f g g
ffmap f ~> g
f (InL f f
g) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f f f
g)
  ffmap f ~> g
f (InR g f
h) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f g f
h)
#endif

#if MIN_VERSION_base(4,10,0)
instance FFunctor (K1 i a) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> K1 i a f -> K1 i a g
ffmap f ~> g
_ (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 a
a

instance FFunctor U1 where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> U1 f -> U1 g
ffmap f ~> g
_ U1 f
U1 = forall k (p :: k). U1 p
U1

instance FFunctor V1 where
#ifndef HLINT
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> V1 f -> V1 g
ffmap f ~> g
_ = V1 f -> V1 g
\case
#endif

instance (Functor f, FFunctor g) => FFunctor (f :.: g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:.:) f g f -> (:.:) f g g
ffmap f ~> g
f = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

instance (FFunctor f, FFunctor g) => FFunctor (f :*: g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:*:) f g f -> (:*:) f g g
ffmap f ~> g
f (f f
g :*: g f
h) = forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f f f
g forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f g f
h

instance (FFunctor f, FFunctor g) => FFunctor (f :+: g) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:+:) f g f -> (:+:) f g g
ffmap f ~> g
f (L1 f f
g) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f f f
g)
  ffmap f ~> g
f (R1 g f
h) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f g f
h)
#endif

-------------------------------------------------------------------------------
-- FFoldable
-------------------------------------------------------------------------------

class FFoldable (t :: (k -> Type) -> Type) where
  ffoldMap :: Monoid.Monoid m => (forall a. f a -> m) -> t f -> m

  flengthAcc :: Int -> t f -> Int
  flengthAcc Int
acc t f
t = Int
acc forall a. Num a => a -> a -> a
+ forall a. Sum a -> a
Monoid.getSum (forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap (\f a
_ -> forall a. a -> Sum a
Monoid.Sum Int
1) t f
t)

flength :: FFoldable t => t f -> Int
flength :: forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
t f -> Int
flength = forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
flengthAcc Int
0

ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m ()
ftraverse_ :: forall {k} (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *) b.
(FFoldable t, Applicative m) =>
(forall (a :: k). f a -> m b) -> t f -> m ()
ftraverse_ forall (a :: k). f a -> m b
k t f
tf = forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
N.withSome (forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap (forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
N.mkSome forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> m b
k) t f
tf) (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)

ffor_ :: (FFoldable t, Applicative m) => t f -> (forall a. f a -> m b) -> m ()
ffor_ :: forall {k} (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *) b.
(FFoldable t, Applicative m) =>
t f -> (forall (a :: k). f a -> m b) -> m ()
ffor_ t f
tf forall (a :: k). f a -> m b
k = forall {k} (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *) b.
(FFoldable t, Applicative m) =>
(forall (a :: k). f a -> m b) -> t f -> m ()
ftraverse_ forall (a :: k). f a -> m b
k t f
tf

instance FFoldable Proxy where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Proxy f -> m
ffoldMap forall (a :: k). f a -> m
_ = forall a. Monoid a => a
Data.Monoid.mempty
  flengthAcc :: forall (f :: k -> *). Int -> Proxy f -> Int
flengthAcc = forall a b. a -> b -> a
const

#if MIN_VERSION_base(4,9,0)
instance FFoldable (Const a) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Const a f -> m
ffoldMap forall (a :: k). f a -> m
_ = forall a. Monoid a => a
mempty
  flengthAcc :: forall (f :: k -> *). Int -> Const a f -> Int
flengthAcc = forall a b. a -> b -> a
const

instance (Foldable f, FFoldable g) => FFoldable (Compose f g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Compose f g f -> m
ffoldMap forall (a :: k). f a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (FFoldable f, FFoldable g) => FFoldable (Product f g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Product f g f -> m
ffoldMap forall (a :: k). f a -> m
f (Pair f f
g g f
h) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f f f
g forall a. Monoid a => a -> a -> a
`mappend` forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f g f
h
  flengthAcc :: forall (f :: k -> *). Int -> Product f g f -> Int
flengthAcc Int
f (Pair f f
g g f
h) = Int
f forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
`flengthAcc` f f
g forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
`flengthAcc` g f
h

instance (FFoldable f, FFoldable g) => FFoldable (Sum f g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Sum f g f -> m
ffoldMap forall (a :: k). f a -> m
f (InL f f
g) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f f f
g
  ffoldMap forall (a :: k). f a -> m
f (InR g f
h) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f g f
h
#endif

#if MIN_VERSION_base(4,10,0)
instance FFoldable V1 where
#ifndef HLINT
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> V1 f -> m
ffoldMap forall (a :: k). f a -> m
_ = V1 f -> m
\case
  flengthAcc :: forall (f :: k -> *). Int -> V1 f -> Int
flengthAcc Int
_ = V1 f -> Int
\case
#endif

instance FFoldable (K1 i a) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> K1 i a f -> m
ffoldMap forall (a :: k). f a -> m
_ = forall a. Monoid a => a
mempty
  flengthAcc :: forall (f :: k -> *). Int -> K1 i a f -> Int
flengthAcc = forall a b. a -> b -> a
const

instance FFoldable U1 where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> U1 f -> m
ffoldMap forall (a :: k). f a -> m
_ = forall a. Monoid a => a
mempty
  flengthAcc :: forall (f :: k -> *). Int -> U1 f -> Int
flengthAcc = forall a b. a -> b -> a
const

instance (Foldable f, FFoldable g) => FFoldable (f :.: g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> (:.:) f g f -> m
ffoldMap forall (a :: k). f a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

instance (FFoldable f, FFoldable g) => FFoldable (f :*: g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> (:*:) f g f -> m
ffoldMap forall (a :: k). f a -> m
f (f f
g :*: g f
h) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f f f
g forall a. Monoid a => a -> a -> a
`mappend` forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f g f
h
  flengthAcc :: forall (f :: k -> *). Int -> (:*:) f g f -> Int
flengthAcc Int
acc (f f
g :*: g f
h) = Int
acc forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
`flengthAcc` f f
g forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
`flengthAcc` g f
h

instance (FFoldable f, FFoldable g) => FFoldable (f :+: g) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> (:+:) f g f -> m
ffoldMap forall (a :: k). f a -> m
f (L1 f f
g) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f f f
g
  ffoldMap forall (a :: k). f a -> m
f (R1 g f
h) = forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap forall (a :: k). f a -> m
f g f
h
  flengthAcc :: forall (f :: k -> *). Int -> (:+:) f g f -> Int
flengthAcc Int
acc (L1 f f
g) = forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
flengthAcc Int
acc f f
g
  flengthAcc Int
acc (R1 g f
g) = forall k (t :: (k -> *) -> *) (f :: k -> *).
FFoldable t =>
Int -> t f -> Int
flengthAcc Int
acc g f
g
#endif

-------------------------------------------------------------------------------
-- FTraversable
-------------------------------------------------------------------------------

class (FFoldable t, FFunctor t) => FTraversable (t :: (k -> Type) -> Type) where
  ftraverse :: Applicative m => (forall a. f a -> m (g a)) -> t f -> m (t g)

ffmapDefault :: FTraversable t =>  (f ~> g) -> t f -> t g
ffmapDefault :: forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FTraversable t =>
(f ~> g) -> t f -> t g
ffmapDefault f ~> g
k = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
k)

ffoldMapDefault :: (FTraversable t, Monoid m) =>  (forall a. f a -> m) -> t f -> m
ffoldMapDefault :: forall {k} (t :: (k -> *) -> *) m (f :: k -> *).
(FTraversable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMapDefault forall (a :: k). f a -> m
k = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> m
k)

ffor :: (FTraversable t, Applicative m) => t f -> (forall a. f a -> m (g a)) -> m (t g)
ffor :: forall {k} (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
t f -> (forall (a :: k). f a -> m (g a)) -> m (t g)
ffor t f
tf forall (a :: k). f a -> m (g a)
k = forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
k t f
tf

fsequence :: (FTraversable t, Applicative f) => t f -> f (t Identity)
fsequence :: forall (t :: (* -> *) -> *) (f :: * -> *).
(FTraversable t, Applicative f) =>
t f -> f (t Identity)
fsequence = forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity)

instance FTraversable Proxy where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Proxy f -> m (Proxy g)
ftraverse forall (a :: k). f a -> m (g a)
_ Proxy f
Proxy = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (t :: k). Proxy t
Proxy

#if MIN_VERSION_base(4,9,0)
instance FTraversable (Const a) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Const a f -> m (Const a g)
ftraverse forall (a :: k). f a -> m (g a)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst)

instance (Traversable f, FTraversable g) => FTraversable (Compose f g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a))
-> Compose f g f -> m (Compose f g g)
ftraverse forall (a :: k). f a -> m (g a)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (FTraversable f, FTraversable g) => FTraversable (Product f g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a))
-> Product f g f -> m (Product f g g)
ftraverse forall (a :: k). f a -> m (g a)
f (Pair f f
g g f
h) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f f f
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f g f
h

instance (FTraversable f, FTraversable g) => FTraversable (Sum f g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Sum f g f -> m (Sum f g g)
ftraverse forall (a :: k). f a -> m (g a)
f (InL f f
g) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f f f
g
  ftraverse forall (a :: k). f a -> m (g a)
f (InR g f
h) = 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 k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f g f
h
#endif

#if MIN_VERSION_base(4,10,0)
instance FTraversable U1 where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> U1 f -> m (U1 g)
ftraverse forall (a :: k). f a -> m (g a)
_ U1 f
U1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1

instance FTraversable V1 where
#ifndef HLINT
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> V1 f -> m (V1 g)
ftraverse forall (a :: k). f a -> m (g a)
_ = V1 f -> m (V1 g)
\case
#endif

instance FTraversable (K1 i a) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> K1 i a f -> m (K1 i a g)
ftraverse forall (a :: k). f a -> m (g a)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# (forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1)

instance (Traversable f, FTraversable g) => FTraversable (f :.: g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> (:.:) f g f -> m ((:.:) f g g)
ftraverse forall (a :: k). f a -> m (g a)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

instance (FTraversable f, FTraversable g) => FTraversable (f :*: g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> (:*:) f g f -> m ((:*:) f g g)
ftraverse forall (a :: k). f a -> m (g a)
f (f f
g :*: g f
h) = 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 k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f f f
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f g f
h

instance (FTraversable f, FTraversable g) => FTraversable (f :+: g) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> (:+:) f g f -> m ((:+:) f g g)
ftraverse forall (a :: k). f a -> m (g a)
f (L1 f f
g) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f f f
g
  ftraverse forall (a :: k). f a -> m (g a)
f (R1 g f
h) = 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 k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
f g f
h
#endif

-------------------------------------------------------------------------------
-- FZip
-------------------------------------------------------------------------------

class FFunctor t => FZip t where
    fzipWith :: (forall x. f x -> g x -> h x) -> t f -> t g -> t h

class FZip t => FRepeat t where
    frepeat :: (forall x. f x) -> t f

instance FZip Proxy where
    fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Proxy f -> Proxy g -> Proxy h
fzipWith forall (x :: k). f x -> g x -> h x
_ Proxy f
_ Proxy g
_ = forall {k} (t :: k). Proxy t
Proxy

instance FRepeat Proxy where
    frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Proxy f
frepeat forall (x :: k). f x
_ = forall {k} (t :: k). Proxy t
Proxy

instance FZip (Element a) where
    fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Element a f -> Element a g -> Element a h
fzipWith forall (x :: k). f x -> g x -> h x
f (Element f a
x) (Element g a
y) = forall {k} (a :: k) (f :: k -> *). f a -> Element a f
Element (forall (x :: k). f x -> g x -> h x
f f a
x g a
y)

instance FRepeat (Element a) where
    frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Element a f
frepeat forall (x :: k). f x
x = forall {k} (a :: k) (f :: k -> *). f a -> Element a f
Element forall (x :: k). f x
x

instance FZip (NT f) where
    fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x) -> NT f f -> NT f g -> NT f h
fzipWith forall (x :: k). f x -> g x -> h x
f (NT f ~> f
g) (NT f ~> g
h) = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> NT f g
NT forall a b. (a -> b) -> a -> b
$ \f a
x -> forall (x :: k). f x -> g x -> h x
f (f ~> f
g f a
x) (f ~> g
h f a
x)

instance FRepeat (NT a) where
    frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> NT a f
frepeat forall (x :: k). f x
x = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> NT f g
NT forall a b. (a -> b) -> a -> b
$ \a a
_ -> forall (x :: k). f x
x

instance FZip Limit where
    fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Limit f -> Limit g -> Limit h
fzipWith forall (x :: k). f x -> g x -> h x
f (Limit forall (a :: k). f a
x) (Limit forall (a :: k). g a
y) = forall {k} (f :: k -> *). (forall (a :: k). f a) -> Limit f
Limit (forall (x :: k). f x -> g x -> h x
f forall (a :: k). f a
x forall (a :: k). g a
y)

instance FRepeat Limit where
    frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Limit f
frepeat forall (x :: k). f x
x = forall {k} (f :: k -> *). (forall (a :: k). f a) -> Limit f
Limit forall (x :: k). f x
x

#if MIN_VERSION_base(4,9,0)
instance Data.Semigroup.Semigroup a => FZip (Const a) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Const a f -> Const a g -> Const a h
fzipWith forall (x :: k). f x -> g x -> h x
_ (Const a
a) (Const a
b) = forall {k} a (b :: k). a -> Const a b
Const (a
a forall a. Semigroup a => a -> a -> a
<> a
b)

instance (Monoid a, Semigroup a) => FRepeat (Const a) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Const a f
frepeat forall (x :: k). f x
_ = forall {k} a (b :: k). a -> Const a b
Const forall a. Monoid a => a
mempty

instance (FZip f, FZip g) => FZip (Product f g) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Product f g f -> Product f g g -> Product f g h
fzipWith forall (x :: k). f x -> g x -> h x
f (Pair f f
x g f
y) (Pair f g
x' g g
y') = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f f f
x f g
x') (forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f g f
y g g
y')

instance (FRepeat f, FRepeat g) => FRepeat (Product f g) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Product f g f
frepeat forall (x :: k). f x
x = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x) (forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x)

-- | We only need an 'Apply' part of an 'Applicative'.
instance (Applicative f, FZip g) => FZip (Compose f g) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Compose f g f -> Compose f g g -> Compose f g h
fzipWith forall (x :: k). f x -> g x -> h x
f (Compose f (g f)
x) (Compose f (g g)
y) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f) f (g f)
x f (g g)
y)

instance (Applicative f, FRepeat g) => FRepeat (Compose f g) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> Compose f g f
frepeat forall (x :: k). f x
x = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x))
#endif

#if MIN_VERSION_base(4,10,0)
instance FZip U1 where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x) -> U1 f -> U1 g -> U1 h
fzipWith forall (x :: k). f x -> g x -> h x
_ U1 f
_ U1 g
_ =  forall k (p :: k). U1 p
U1

instance FRepeat U1 where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> U1 f
frepeat forall (x :: k). f x
_ = forall k (p :: k). U1 p
U1

instance FZip V1 where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x) -> V1 f -> V1 g -> V1 h
fzipWith forall (x :: k). f x -> g x -> h x
_ V1 f
x V1 g
_ = case V1 f
x of

instance Data.Semigroup.Semigroup a => FZip (K1 i a) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> K1 i a f -> K1 i a g -> K1 i a h
fzipWith forall (x :: k). f x -> g x -> h x
_ (K1 a
a) (K1 a
b) = forall k i c (p :: k). c -> K1 i c p
K1 (a
a forall a. Semigroup a => a -> a -> a
<> a
b)

instance (Monoid a, Semigroup a) => FRepeat (K1 i a) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> K1 i a f
frepeat forall (x :: k). f x
_ = forall k i c (p :: k). c -> K1 i c p
K1 forall a. Monoid a => a
mempty

instance (FZip f, FZip g) => FZip (f :*: g) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> (:*:) f g f -> (:*:) f g g -> (:*:) f g h
fzipWith forall (x :: k). f x -> g x -> h x
f (f f
x :*: g f
y) (f g
x' :*: g g
y') = forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f f f
x f g
x' forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f g f
y g g
y'

instance (FRepeat f, FRepeat g) => FRepeat (f :*: g) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> (:*:) f g f
frepeat forall (x :: k). f x
x = forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x

-- | We only need an 'Apply' part of an 'Applicative'.
instance (Applicative f, FZip g) => FZip (f :.: g) where
  fzipWith :: forall (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> (:.:) f g f -> (:.:) f g g -> (:.:) f g h
fzipWith forall (x :: k). f x -> g x -> h x
f (Comp1 f (g f)
x) (Comp1 f (g g)
y) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (x :: k). f x -> g x -> h x
f) f (g f)
x f (g g)
y)

instance (Applicative f, FRepeat g) => FRepeat (f :.: g) where
  frepeat :: forall (f :: k -> *). (forall (x :: k). f x) -> (:.:) f g f
frepeat forall (x :: k). f x
x = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: k). f x
x))
#endif


-------------------------------------------------------------------------------
-- FContravariant
-------------------------------------------------------------------------------

class FContravariant (t :: (k -> Type) -> Type) where
  fcontramap :: (f ~> g) -> t g -> t f

instance FContravariant Proxy where
  fcontramap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Proxy g -> Proxy f
fcontramap f ~> g
_ Proxy g
Proxy = forall {k} (t :: k). Proxy t
Proxy

#if MIN_VERSION_base(4,9,0)
instance FContravariant (Const a) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Const a g -> Const a f
fcontramap f ~> g
_ (Const a
a) = forall {k} a (b :: k). a -> Const a b
Const a
a

instance (Functor f, FContravariant g) => FContravariant (Compose f g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Compose f g g -> Compose f g f
fcontramap f ~> g
f = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (FContravariant f, FContravariant g) => FContravariant (Product f g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Product f g g -> Product f g f
fcontramap f ~> g
f (Pair f g
g g g
h) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f f g
g) (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f g g
h)

instance (FContravariant f, FContravariant g) => FContravariant (Sum f g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Sum f g g -> Sum f g f
fcontramap f ~> g
f (InL f g
g) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f f g
g)
  fcontramap f ~> g
f (InR g g
h) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f g g
h)
#endif

#if MIN_VERSION_base(4,10,0)
instance FContravariant (K1 i a) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> K1 i a g -> K1 i a f
fcontramap f ~> g
_ (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 a
a


instance FContravariant U1 where
  fcontramap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> U1 g -> U1 f
fcontramap f ~> g
_ U1 g
U1 = forall k (p :: k). U1 p
U1

instance FContravariant V1 where
#ifndef HLINT
  fcontramap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> V1 g -> V1 f
fcontramap f ~> g
_ = V1 g -> V1 f
\case
#endif

instance (Functor f, FContravariant g) => FContravariant (f :.: g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:.:) f g g -> (:.:) f g f
fcontramap f ~> g
f = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f) forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

instance (FContravariant f, FContravariant g) => FContravariant (f :*: g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:*:) f g g -> (:*:) f g f
fcontramap f ~> g
f (f g
g :*: g g
h) = forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f f g
g forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f g g
h

instance (FContravariant f, FContravariant g) => FContravariant (f :+: g) where
  fcontramap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (:+:) f g g -> (:+:) f g f
fcontramap f ~> g
f (L1 f g
g) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f f g
g)
  fcontramap f ~> g
f (R1 g g
h) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f g g
h)
#endif

-------------------------------------------------------------------------------
-- distributive utilities
-------------------------------------------------------------------------------

-- | A logarithm.
--
-- Recall that function arrow, @->@ is an exponential object. If we take @f = (->) r@, then
--
-- @
-- 'Logarithm' ((->) r) ≅ forall a. (r -> a) -> a ≅ r
-- @
--
-- and this works for all 'Distributive' / 'Representable' functors.
--
newtype Logarithm f = Logarithm { forall (f :: * -> *). Logarithm f -> forall a. f a -> a
runLogarithm :: forall a. f a -> a }

indexLogarithm :: f a -> Logarithm f -> a
indexLogarithm :: forall (f :: * -> *) a. f a -> Logarithm f -> a
indexLogarithm f a
fa (Logarithm forall a. f a -> a
fa2a) = forall a. f a -> a
fa2a f a
fa

instance FContravariant Logarithm where
  fcontramap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> Logarithm g -> Logarithm f
fcontramap f ~> g
f Logarithm g
g = forall (f :: * -> *). (forall a. f a -> a) -> Logarithm f
Logarithm (forall (f :: * -> *). Logarithm f -> forall a. f a -> a
runLogarithm Logarithm g
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
f)

-- | Tabulation.
newtype Tab a f = Tab { forall a (f :: * -> *). Tab a f -> Logarithm f -> a
runTab :: Logarithm f -> a }

instance FFunctor (Tab a) where
  ffmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Tab a f -> Tab a g
ffmap f ~> g
f Tab a f
g = forall a (f :: * -> *). (Logarithm f -> a) -> Tab a f
Tab (forall a (f :: * -> *). Tab a f -> Logarithm f -> a
runTab Tab a f
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FContravariant t =>
(f ~> g) -> t g -> t f
fcontramap f ~> g
f)

-------------------------------------------------------------------------------
-- Elements
-------------------------------------------------------------------------------

-- | Element in @f@
newtype Element a f = Element { forall {k} (a :: k) (f :: k -> *). Element a f -> f a
runElement :: f a }

instance FFunctor (Element a) where
  ffmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Element a f -> Element a g
ffmap f ~> g
f (Element f a
fa) = forall {k} (a :: k) (f :: k -> *). f a -> Element a f
Element (f ~> g
f f a
fa)

instance FFoldable (Element a) where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Element a f -> m
ffoldMap forall (a :: k). f a -> m
f (Element f a
fa) = forall (a :: k). f a -> m
f f a
fa
  flengthAcc :: forall (f :: k -> *). Int -> Element a f -> Int
flengthAcc Int
acc Element a f
_ = Int
acc forall a. Num a => a -> a -> a
+ Int
1

instance FTraversable (Element a) where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Element a f -> m (Element a g)
ftraverse forall (a :: k). f a -> m (g a)
f (Element f a
g) = forall {k} (a :: k) (f :: k -> *). f a -> Element a f
Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: k). f a -> m (g a)
f f a
g

-------------------------------------------------------------------------------
-- "natural" transformations via parametricity
-------------------------------------------------------------------------------

-- | Newtyped "natural" transformation
newtype NT f g = NT { forall {k} (f :: k -> *) (g :: k -> *). NT f g -> f ~> g
runNT :: f ~> g }

instance FFunctor (NT f) where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> NT f f -> NT f g
ffmap f ~> g
f (NT f ~> f
g) = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> NT f g
NT (f ~> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> f
g)

-------------------------------------------------------------------------------
-- Some
-------------------------------------------------------------------------------

instance FFunctor Some where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
ffmap = forall k (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
mapSome

instance FFoldable Some where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Some f -> m
ffoldMap = forall {k} (tag :: k -> *) b.
(forall (a :: k). tag a -> b) -> Some tag -> b
foldSome
  flengthAcc :: forall (f :: k -> *). Int -> Some f -> Int
flengthAcc Int
len Some f
_ = Int
len forall a. Num a => a -> a -> a
+ Int
1

instance FTraversable Some where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Some f -> m (Some g)
ftraverse forall (a :: k). f a -> m (g a)
f (Some f a
m) = forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: k). f a -> m (g a)
f f a
m

instance FFunctor N.Some where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
ffmap = forall k (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
N.mapSome

instance FFoldable N.Some where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Some f -> m
ffoldMap = forall {k} (tag :: k -> *) b.
(forall (a :: k). tag a -> b) -> Some tag -> b
N.foldSome
  flengthAcc :: forall (f :: k -> *). Int -> Some f -> Int
flengthAcc Int
len Some f
_ = Int
len forall a. Num a => a -> a -> a
+ Int
1

instance FTraversable N.Some where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Some f -> m (Some g)
ftraverse forall (a :: k). f a -> m (g a)
f Some f
x = forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
N.withSome Some f
x forall a b. (a -> b) -> a -> b
$ \f a
x' -> forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
N.mkSome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: k). f a -> m (g a)
f f a
x'

instance FFunctor C.Some where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
ffmap = forall k (f :: k -> *) (g :: k -> *). (f ~> g) -> Some f -> Some g
C.mapSome

instance FFoldable C.Some where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Some f -> m
ffoldMap = forall {k} (tag :: k -> *) b.
(forall (a :: k). tag a -> b) -> Some tag -> b
C.foldSome
  flengthAcc :: forall (f :: k -> *). Int -> Some f -> Int
flengthAcc Int
len Some f
_ = Int
len forall a. Num a => a -> a -> a
+ Int
1

instance FTraversable C.Some where
  ftraverse :: forall (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (a :: k). f a -> m (g a)) -> Some f -> m (Some g)
ftraverse forall (a :: k). f a -> m (g a)
f Some f
x = forall k (tag :: k -> *).
Some tag -> forall r. (forall (a :: k). tag a -> r) -> r
C.withSome Some f
x forall a b. (a -> b) -> a -> b
$ \f a
x' -> forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
C.mkSome forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: k). f a -> m (g a)
f f a
x'

-------------------------------------------------------------------------------
-- Limit
-------------------------------------------------------------------------------

newtype Limit f = Limit { forall {k} (f :: k -> *). Limit f -> forall (a :: k). f a
runLimit :: forall a. f a }

instance FFunctor Limit where
  ffmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Limit f -> Limit g
ffmap f ~> g
f (Limit forall (a :: k). f a
g) = forall {k} (f :: k -> *). (forall (a :: k). f a) -> Limit f
Limit (f ~> g
f forall (a :: k). f a
g)

instance FFoldable Limit where
  ffoldMap :: forall m (f :: k -> *).
Monoid m =>
(forall (a :: k). f a -> m) -> Limit f -> m
ffoldMap forall (a :: k). f a -> m
f (Limit forall (a :: k). f a
g) = forall (a :: k). f a -> m
f forall (a :: k). f a
g
  flengthAcc :: forall (f :: k -> *). Int -> Limit f -> Int
flengthAcc Int
len Limit f
_ = Int
len forall a. Num a => a -> a -> a
+ Int
1

-------------------------------------------------------------------------------
-- Generic ftraverse
-------------------------------------------------------------------------------

-- | Generically derive 'ftraverse'.
--
-- Simple usage:
--
-- @
-- data Record f = Record
--     { fieldInt    :: f Int
--     , fieldString :: f String
--     , fieldSome   :: 'Some' f
--     }
--   deriving ('Generic')
--
-- instance 'FFunctor'     Record where 'ffmap'     = 'ffmapDefault'
-- instance 'FFoldable'    Record where 'ffoldMap'  = 'ffoldMapDefault'
-- instance 'FTraversable' Record where 'ftraverse' = 'gftraverse'
-- @

gftraverse
  :: forall t f g m. (Applicative m, Generic (t f), Generic (t g), GFTraversable (Curried (Yoneda m)) f g (Rep (t f)) (Rep (t g)))
  => (forall a. f a -> m (g a))
  -> t f
  -> m (t g)
gftraverse :: forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(Applicative m, Generic (t f), Generic (t g),
 GFTraversable (Curried (Yoneda m)) f g (Rep (t f)) (Rep (t g))) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
gftraverse = forall {k} (f :: * -> *) s t (a :: k -> *) (b :: k -> *).
Applicative f =>
FLensLike (Curried (Yoneda f)) s t a b -> FLensLike f s t a b
fconfusing FLensLike (Curried (Yoneda m)) (t f) (t g) f g
impl
  where
  impl :: FLensLike (Curried (Yoneda m)) (t f) (t g) f g
  impl :: FLensLike (Curried (Yoneda m)) (t f) (t g) f g
impl forall (x :: k). f x -> Curried (Yoneda m) (g x)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse0 forall (x :: k). f x -> Curried (Yoneda m) (g x)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
{-# INLINE gftraverse #-}

class GFTraversable m f g tf tg where
  gftraverse0 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())

instance (i ~ D, i' ~ D, Functor m, GFTraversable1 m f g h h') => GFTraversable m f g (M1 i c h) (M1 i' c' h') where
  gftraverse0 :: (forall (a :: k). f a -> m (g a))
-> M1 i c h () -> m (M1 i' c' h' ())
gftraverse0 forall (a :: k). f a -> m (g a)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable1 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse1 forall (a :: k). f a -> m (g a)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE gftraverse0 #-}

class GFTraversable1 m f g tf tg where
  gftraverse1 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())

instance GFTraversable1 m f g V1 V1 where
  gftraverse1 :: (forall (a :: k). f a -> m (g a)) -> V1 () -> m (V1 ())
gftraverse1 forall (a :: k). f a -> m (g a)
_ V1 ()
x = V1 ()
x seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"Void is conjured"
  {-# INLINE gftraverse1 #-}

instance (Applicative m, GFTraversable1 m f g x x', GFTraversable1 m f g y y') => GFTraversable1 m f g (x :+: y) (x' :+: y') where
  gftraverse1 :: (forall (a :: k). f a -> m (g a))
-> (:+:) x y () -> m ((:+:) x' y' ())
gftraverse1 forall (a :: k). f a -> m (g a)
nt (L1 x ()
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable1 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse1 forall (a :: k). f a -> m (g a)
nt x ()
x)
  gftraverse1 forall (a :: k). f a -> m (g a)
nt (R1 y ()
y) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable1 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse1 forall (a :: k). f a -> m (g a)
nt y ()
y)
  {-# INLINE gftraverse1 #-}

instance (i ~ C, i' ~ C, Functor m, GFTraversable2 m f g h h') => GFTraversable1 m f g (M1 i c h) (M1 i' c' h') where
  gftraverse1 :: (forall (a :: k). f a -> m (g a))
-> M1 i c h () -> m (M1 i' c' h' ())
gftraverse1 forall (a :: k). f a -> m (g a)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable2 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE gftraverse1 #-}

class GFTraversable2 m f g tf tg where
  gftraverse2 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())

instance Applicative m  => GFTraversable2 m f g U1 U1 where
  gftraverse2 :: (forall (a :: k). f a -> m (g a)) -> U1 () -> m (U1 ())
gftraverse2 forall (a :: k). f a -> m (g a)
_ U1 ()
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1
  {-# INLINE gftraverse2 #-}

instance (i ~ S, i' ~ S, Functor m, GFTraversable2 m f g h h') => GFTraversable2 m f g (M1 i c h) (M1 i' c' h') where
  gftraverse2 :: (forall (a :: k). f a -> m (g a))
-> M1 i c h () -> m (M1 i' c' h' ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable2 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE gftraverse2 #-}

instance (Applicative m, GFTraversable2 m f g x x', GFTraversable2 m f g y y') => GFTraversable2 m f g (x :*: y) (x' :*: y') where
  gftraverse2 :: (forall (a :: k). f a -> m (g a))
-> (:*:) x y () -> m ((:*:) x' y' ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt (x ()
x :*: y ()
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable2 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt x ()
x) (forall {k} {k} (m :: k -> *) (f :: k -> *) (g :: k -> k)
       (tf :: * -> *) (tg :: * -> k).
GFTraversable2 m f g tf tg =>
(forall (a :: k). f a -> m (g a)) -> tf () -> m (tg ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt y ()
y)
  {-# INLINE gftraverse2 #-}

instance (f ~ f', g ~ g', x ~ x', i ~ R, i' ~ R, Functor m) => GFTraversable2 m f g (K1 i (f' x)) (K1 i' (g' x')) where
  gftraverse2 :: (forall (a :: k). f a -> m (g a))
-> K1 i (f' x) () -> m (K1 i' (g' x') ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> m (g a)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE gftraverse2 #-}

instance (f ~ f', g ~ g', t ~ t', i ~ R, i' ~ R, Applicative m, FTraversable t) => GFTraversable2 m f g (K1 i (t f')) (K1 i' (t' g')) where
  gftraverse2 :: (forall (a :: k). f a -> m (g a))
-> K1 i (t f') () -> m (K1 i' (t' g') ())
gftraverse2 forall (a :: k). f a -> m (g a)
nt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> *) (m :: * -> *) (f :: k -> *)
       (g :: k -> *).
(FTraversable t, Applicative m) =>
(forall (a :: k). f a -> m (g a)) -> t f -> m (t g)
ftraverse forall (a :: k). f a -> m (g a)
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE gftraverse2 #-}


-------------------------------------------------------------------------------
-- Generic fzipWith
-------------------------------------------------------------------------------

-- | Generically derive 'fzipWith'.
--
-- Simple usage:
--
-- @
-- data Record f = Record
--     { fieldInt    :: f Int
--     , fieldString :: f String
--     }
--   deriving ('Generic')
--
-- instance 'FZip'    Record where 'fzipWith' = 'gfzipWith'
-- instance 'FRepeat' Record where 'frepeat'  = 'gfrepeat'
-- @

gfzipWith
  :: forall t f g h. (Generic (t f), Generic (t g), Generic (t h), GFZip f g h (Rep (t f)) (Rep (t g)) (Rep (t h)))
  => (forall a. f a -> g a -> h a)
  -> t f
  -> t g
  -> t h
gfzipWith :: forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
(Generic (t f), Generic (t g), Generic (t h),
 GFZip f g h (Rep (t f)) (Rep (t g)) (Rep (t h))) =>
(forall (a :: k). f a -> g a -> h a) -> t f -> t g -> t h
gfzipWith forall (a :: k). f a -> g a -> h a
nt t f
x t g
y = forall a x. Generic a => Rep a x -> a
to (forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith0 forall (a :: k). f a -> g a -> h a
nt (forall a x. Generic a => a -> Rep a x
from t f
x) (forall a x. Generic a => a -> Rep a x
from t g
y))
{-# INLINE gfzipWith #-}

class GFZip f g h tf tg th where
  gfzipWith0 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()

instance (i0 ~ D, i1 ~ D, i2 ~ D, GFZip1 f g h t0 t1 t2) => GFZip f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where
  gfzipWith0 :: (forall (a :: k). f a -> g a -> h a)
-> M1 i0 c0 t0 () -> M1 i1 c1 t1 () -> M1 i2 c2 t2 ()
gfzipWith0 forall (a :: k). f a -> g a -> h a
nt M1 i0 c0 t0 ()
x M1 i1 c1 t1 ()
y = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip1 f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith1 forall (a :: k). f a -> g a -> h a
nt (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i0 c0 t0 ()
x) (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i1 c1 t1 ()
y))
  {-# INLINE gfzipWith0 #-}

class GFZip1 f g h tf tg th where
  gfzipWith1 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()

instance GFZip1 f g h V1 V1 V1 where
  gfzipWith1 :: (forall (a :: k). f a -> g a -> h a) -> V1 () -> V1 () -> V1 ()
gfzipWith1 forall (a :: k). f a -> g a -> h a
_ V1 ()
x V1 ()
_ = V1 ()
x seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"Void is conjured"

instance (i0 ~ C, i1 ~ C, i2 ~ C, GFZip2 f g h t0 t1 t2) => GFZip1 f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where
  gfzipWith1 :: (forall (a :: k). f a -> g a -> h a)
-> M1 i0 c0 t0 () -> M1 i1 c1 t1 () -> M1 i2 c2 t2 ()
gfzipWith1 forall (a :: k). f a -> g a -> h a
nt M1 i0 c0 t0 ()
x M1 i1 c1 t1 ()
y = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip2 f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i0 c0 t0 ()
x) (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i1 c1 t1 ()
y))
  {-# INLINE gfzipWith1 #-}

class GFZip2 f g h tf tg th where
  gfzipWith2 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()

instance GFZip2 f g h U1 U1 U1 where
  gfzipWith2 :: (forall (a :: k). f a -> g a -> h a) -> U1 () -> U1 () -> U1 ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
_ U1 ()
_ U1 ()
_ = forall k (p :: k). U1 p
U1

instance (GFZip2 f g h tf tg th, GFZip2 f g h sf sg sh) => GFZip2 f g h (tf :*: sf) (tg :*: sg) (th :*: sh) where
  gfzipWith2 :: (forall (a :: k). f a -> g a -> h a)
-> (:*:) tf sf () -> (:*:) tg sg () -> (:*:) th sh ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt (tf ()
x :*: sf ()
y) (tg ()
x' :*: sg ()
y') = forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip2 f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt tf ()
x tg ()
x' forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip2 f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt sf ()
y sg ()
y'
  {-# INLINE gfzipWith2 #-}

instance (i0 ~ S, i1 ~ S, i2 ~ S, GFZip2 f g h t0 t1 t2) => GFZip2 f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where
  gfzipWith2 :: (forall (a :: k). f a -> g a -> h a)
-> M1 i0 c0 t0 () -> M1 i1 c1 t1 () -> M1 i2 c2 t2 ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt M1 i0 c0 t0 ()
x M1 i1 c1 t1 ()
y = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (tf :: * -> *)
       (tg :: * -> *) (th :: * -> *).
GFZip2 f g h tf tg th =>
(forall (a :: k). f a -> g a -> h a) -> tf () -> tg () -> th ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i0 c0 t0 ()
x) (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i1 c1 t1 ()
y))
  {-# INLINE gfzipWith2 #-}

instance (f ~ f', g ~ g', h ~ h', x0 ~ x1, x1 ~ x2, i0 ~ R, i1 ~ R, i2 ~ R) => GFZip2 f g h (K1 i0 (f' x0)) (K1 i1 (g' x1)) (K1 i2 (h' x2)) where
  gfzipWith2 :: (forall (a :: k). f a -> g a -> h a)
-> K1 i0 (f' x0) () -> K1 i1 (g' x1) () -> K1 i2 (h' x2) ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt (K1 f' x0
x) (K1 g' x1
y) = forall k i c (p :: k). c -> K1 i c p
K1 (forall (a :: k). f a -> g a -> h a
nt f' x0
x g' x1
y)

instance (f ~ f', g ~ g', h ~ h', t0 ~ t1, t1 ~ t2, i0 ~ R, i1 ~ R, i2 ~ R, FZip t0) => GFZip2 f g h (K1 i0 (t0 f')) (K1 i1 (t1 g')) (K1 i2 (t2 h')) where
  gfzipWith2 :: (forall (a :: k). f a -> g a -> h a)
-> K1 i0 (t0 f') () -> K1 i1 (t1 g') () -> K1 i2 (t2 h') ()
gfzipWith2 forall (a :: k). f a -> g a -> h a
nt (K1 t0 f'
x) (K1 t1 g'
y) = forall k i c (p :: k). c -> K1 i c p
K1 (forall {k} (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
FZip t =>
(forall (x :: k). f x -> g x -> h x) -> t f -> t g -> t h
fzipWith forall (a :: k). f a -> g a -> h a
nt t0 f'
x t1 g'
y)

-------------------------------------------------------------------------------
-- Generic frepeat
-------------------------------------------------------------------------------

gfrepeat
  :: forall t f. (Generic (t f), GFRepeat f (Rep (t f)))
  => (forall x. f x)
  -> t f
gfrepeat :: forall {k} (t :: (k -> *) -> *) (f :: k -> *).
(Generic (t f), GFRepeat f (Rep (t f))) =>
(forall (x :: k). f x) -> t f
gfrepeat forall (x :: k). f x
x = forall a x. Generic a => Rep a x -> a
to (forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat0 forall (x :: k). f x
x)

class GFRepeat f tf where
  gfrepeat0 :: (forall a. f a) -> tf ()

instance (i ~ D, GFRepeat1 g f) => GFRepeat g (M1 i c f) where
  gfrepeat0 :: (forall (a :: k). g a) -> M1 i c f ()
gfrepeat0 forall (a :: k). g a
x = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat1 f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat1 forall (a :: k). g a
x)

class GFRepeat1 f tf where
  gfrepeat1 :: (forall a. f a) -> tf ()

instance (i ~ C, GFRepeat2 g f) => GFRepeat1 g (M1 i c f) where
  gfrepeat1 :: (forall (a :: k). g a) -> M1 i c f ()
gfrepeat1 forall (a :: k). g a
x = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat2 f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat2 forall (a :: k). g a
x)

class GFRepeat2 f tf where
  gfrepeat2 :: (forall a. f a) -> tf ()

instance (i ~ S, GFRepeat2 g f) => GFRepeat2 g (M1 i c f) where
  gfrepeat2 :: (forall (a :: k). g a) -> M1 i c f ()
gfrepeat2 forall (a :: k). g a
x = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat2 f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat2 forall (a :: k). g a
x)

instance (GFRepeat2 f x, GFRepeat2 f y) => GFRepeat2 f (x :*: y) where
  gfrepeat2 :: (forall (a :: k). f a) -> (:*:) x y ()
gfrepeat2 forall (a :: k). f a
x = forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat2 f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat2 forall (a :: k). f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) (tf :: * -> *).
GFRepeat2 f tf =>
(forall (a :: k). f a) -> tf ()
gfrepeat2 forall (a :: k). f a
x

instance GFRepeat2 f U1 where
  gfrepeat2 :: (forall (a :: k). f a) -> U1 ()
gfrepeat2 forall (a :: k). f a
_ = forall k (p :: k). U1 p
U1

instance (i ~ R, f ~ f') => GFRepeat2 f (K1 i (f' x)) where
  gfrepeat2 :: (forall (a :: k). f a) -> K1 i (f' x) ()
gfrepeat2 forall (a :: k). f a
x = forall k i c (p :: k). c -> K1 i c p
K1 forall (a :: k). f a
x

instance (i ~ R, f ~ f', FRepeat t) => GFRepeat2 f (K1 i (t f')) where
  gfrepeat2 :: (forall (a :: k). f a) -> K1 i (t f') ()
gfrepeat2 forall (a :: k). f a
x = forall k i c (p :: k). c -> K1 i c p
K1 (forall {k} (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (a :: k). f a
x)