{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}

{-|
Module      : Data.HKD.Records
Description : Make higher kinded records great again
Copyright   : (c) Kristof Bastiaensen, 2022
License     : BSD-3
Maintainer  : kristof@resonata.be
Stability   : stable
Portability : ghc

This module contains additions for the hkd package to making it easier
for working with higher kinded records.  In particular, it gives
access to the fieldNames of a records using the `fieldNames` function,
allows you to zip many records together using `fzipManyWith`, and
allows functions with constraints by using the `fdicts` function.
This makes it possible to implement many generic functions using these
functions rather than having to implement complicated typeclasses for
Generics.  As an example, here is a (poor mans) url encoding function:

@
zipShow :: (FFoldable t, FRepeat t, FieldNames t, FDicts Show t, FZip t) =>
            t Identity -> Text
zipShow t =
   Text.concat $
   intersperse "&" $
   ftoList $ 
   fzipManyWith
   (\(Identity y :> Const lbl :> Dict :> End) ->
       Const $ lbl <> "=" <> Text.pack (show y))
   (t :~> fieldNames :~> fdicts @Show :~> End)
@

-}

module Data.HKD.Records (
  FieldNames(..),
  Dict(..), FDicts(..),
  RecordCons(..), FieldCons(..), End,
  fzipManyWith, ftoList, Lens', FLens(..),
  FLenses(..)) where
import Data.HKD
import Data.Text (Text)
import Data.Functor.Const
import GHC.Generics
import GHC.TypeLits
import Data.Coerce
import qualified Data.Text as Text
import Data.Proxy
import Data.Monoid

class FieldNames t where
  -- | get the fieldNames from each field as a (Const Text).  Can be
  -- auto derived for records with a Generic instance.
  default fieldNames :: (Generic (t (Const Text)),
                       GFieldNames (Rep (t (Const Text)) ()))
                  => t (Const Text)
  fieldNames = Rep (t (Const Text)) () -> t (Const Text)
forall a x. Generic a => Rep a x -> a
to (Rep (t (Const Text)) ()
forall t. GFieldNames t => t
genFieldNames :: Rep (t (Const Text)) ())                  
  fieldNames :: t (Const Text)

class GFieldNames t where
  genFieldNames :: t
  
instance (GFieldNames (f ()), GFieldNames (g ())) => GFieldNames ((f :*: g) ()) where
  genFieldNames :: (:*:) f g ()
genFieldNames = f ()
forall t. GFieldNames t => t
genFieldNames f () -> g () -> (:*:) f g ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g ()
forall t. GFieldNames t => t
genFieldNames
  {-# INLINE genFieldNames #-}

instance KnownSymbol fieldName =>
         (GFieldNames (S1 ('MetaSel ('Just fieldName) _x _x2 _x3)
                    (Rec0 (Const Text b))
                    ())) where
  genFieldNames :: S1 ('MetaSel ('Just fieldName) _x _x2 _x3) (Rec0 (Const Text b)) ()
genFieldNames = K1 R (Const Text b) ()
-> S1
     ('MetaSel ('Just fieldName) _x _x2 _x3) (Rec0 (Const Text b)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (Const Text b) ()
 -> S1
      ('MetaSel ('Just fieldName) _x _x2 _x3) (Rec0 (Const Text b)) ())
-> K1 R (Const Text b) ()
-> S1
     ('MetaSel ('Just fieldName) _x _x2 _x3) (Rec0 (Const Text b)) ()
forall a b. (a -> b) -> a -> b
$ Const Text b -> K1 R (Const Text b) ()
forall k i c (p :: k). c -> K1 i c p
K1 (Const Text b -> K1 R (Const Text b) ())
-> Const Text b -> K1 R (Const Text b) ()
forall a b. (a -> b) -> a -> b
$ Text -> Const Text b
forall k a (b :: k). a -> Const a b
Const (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy fieldName
forall k (t :: k). Proxy t
Proxy @fieldName))
  {-# INLINE genFieldNames #-}
  
instance GFieldNames (b ()) => (GFieldNames ((D1 meta (C1 meta2 b)) ())) where
  genFieldNames :: D1 meta (C1 meta2 b) ()
genFieldNames = M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 b () -> D1 meta (C1 meta2 b) ())
-> M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall a b. (a -> b) -> a -> b
$ b () -> M1 C meta2 b ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b () -> M1 C meta2 b ()) -> b () -> M1 C meta2 b ()
forall a b. (a -> b) -> a -> b
$ b ()
forall t. GFieldNames t => t
genFieldNames
  {-# INLINE genFieldNames #-}

data Dict c (t :: k) where
  -- | reified type class dictionary. You can use the contained
  -- typeclass by putting the `Dict` constructor somewhere within
  -- scope. Can be auto derived with a Generic instance.
  Dict :: c t => Dict c t

class FDicts c t where
  -- | hkd record containing the reified type class dictionaries for
  -- each field.  This allows you to use functions with constraints by
  -- combining `fdicts` with `fzipWith` or `fzipManyWith`.  Can be
  -- auto derived with a Generic instance.
  default fdicts :: (Generic (t (Dict c)),
                     GFDicts (Rep (t (Dict c)) ()))
                 => t (Dict c)
  fdicts = Rep (t (Dict c)) () -> t (Dict c)
forall a x. Generic a => Rep a x -> a
to (Rep (t (Dict c)) ()
forall t. GFDicts t => t
genFdict :: Rep (t (Dict c)) ())
  fdicts :: t (Dict c)

class GFDicts t where
  genFdict :: t

instance (GFDicts (f ()), GFDicts (g ())) => GFDicts ((f :*: g) ()) where
  genFdict :: (:*:) f g ()
genFdict = f ()
forall t. GFDicts t => t
genFdict f () -> g () -> (:*:) f g ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g ()
forall t. GFDicts t => t
genFdict
  {-# INLINE genFdict #-}

instance c b =>
         GFDicts (S1 ('MetaSel _x1 _x2 _x3 _x4)
                   (Rec0 (Dict c b))
                   ()) where
  genFdict :: S1 ('MetaSel _x1 _x2 _x3 _x4) (Rec0 (Dict c b)) ()
genFdict = K1 R (Dict c b) ()
-> S1 ('MetaSel _x1 _x2 _x3 _x4) (Rec0 (Dict c b)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (Dict c b) ()
 -> S1 ('MetaSel _x1 _x2 _x3 _x4) (Rec0 (Dict c b)) ())
-> K1 R (Dict c b) ()
-> S1 ('MetaSel _x1 _x2 _x3 _x4) (Rec0 (Dict c b)) ()
forall a b. (a -> b) -> a -> b
$ Dict c b -> K1 R (Dict c b) ()
forall k i c (p :: k). c -> K1 i c p
K1 (Dict c b -> K1 R (Dict c b) ()) -> Dict c b -> K1 R (Dict c b) ()
forall a b. (a -> b) -> a -> b
$ Dict c b
forall k (c :: k -> Constraint) (t :: k). c t => Dict c t
Dict
  {-# INLINE genFdict #-}

instance GFDicts (b ()) => (GFDicts ((D1 meta (C1 meta2 b)) ())) where
  genFdict :: D1 meta (C1 meta2 b) ()
genFdict = M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 b () -> D1 meta (C1 meta2 b) ())
-> M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall a b. (a -> b) -> a -> b
$ b () -> M1 C meta2 b ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b () -> M1 C meta2 b ()) -> b () -> M1 C meta2 b ()
forall a b. (a -> b) -> a -> b
$ b ()
forall t. GFDicts t => t
genFdict
  {-# INLINE genFdict #-}

infixr 5 :>
infixr 5 :~>

-- | A heterogenous list of higher kinded records.  Use `:~>` to
-- separate the items, and `End` to terminate them.
data RecordCons (f :: a -> *) g t = t f :~> g t
-- | A heterogenous list of fields.  Use `:>` to separate the items,
-- and `End` to terminate them.
data FieldCons f g (x :: a) = f x :> g x
-- | The terminator.
data End (t :: k) = End

class GFTranspose x t (f :: a -> *) | x -> f where
  gftranspose :: x t -> t f

instance FRepeat t => GFTranspose End t End where
  gftranspose :: End t -> t End
gftranspose End t
End = (forall (x :: a). End x) -> t End
forall k (t :: (k -> *) -> *) (f :: k -> *).
FRepeat t =>
(forall (x :: k). f x) -> t f
frepeat forall (x :: a). End x
forall k (t :: k). End t
End

instance (FZip t, GFTranspose g t g') => 
  GFTranspose (RecordCons f g) t (FieldCons f g') where
  gftranspose :: RecordCons f g t -> t (FieldCons f g')
gftranspose (t f
tf :~> g t
tg) = (forall (x :: a). f x -> g' x -> FieldCons f g' x)
-> t f -> t g' -> t (FieldCons f g')
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 :: a). f x -> g' x -> FieldCons f g' x
forall a (f :: a -> *) (g :: a -> *) (x :: a).
f x -> g x -> FieldCons f g x
(:>) t f
tf (t g' -> t (FieldCons f g')) -> t g' -> t (FieldCons f g')
forall a b. (a -> b) -> a -> b
$ g t -> t g'
forall a (x :: ((a -> *) -> *) -> *) (t :: (a -> *) -> *)
       (f :: a -> *).
GFTranspose x t f =>
x t -> t f
gftranspose g t
tg

-- | zip over many arguments.  The function must take a heterogenous
-- list of fields, separated using `:>` and terminated by `End`,
-- while the argument must be a heterogenous list of records,
-- separated by `:~>`, end terminated by `End`.
--
-- For example:
--
-- @
--   fzipManyWith
--   (\(Identity y :> Const lbl :> Dict :> End) ->
--       Const $ lbl <> "=" <> Text.pack (show y))
--   (t :~> fieldNames :~> fdicts @Show :~> End)
-- @

fzipManyWith :: ( FFunctor t, GFTranspose x t f) =>
                 (forall a. f a -> i a) ->
                 (x t -> t i)
fzipManyWith :: (forall (a :: a). f a -> i a) -> x t -> t i
fzipManyWith forall (a :: a). f a -> i a
f x t
tuple = (forall (a :: a). f a -> i a) -> t f -> t i
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap forall (a :: a). f a -> i a
f (t f -> t i) -> t f -> t i
forall a b. (a -> b) -> a -> b
$ x t -> t f
forall a (x :: ((a -> *) -> *) -> *) (t :: (a -> *) -> *)
       (f :: a -> *).
GFTranspose x t f =>
x t -> t f
gftranspose x t
tuple

type Lens' a s = forall f . Functor f => (a -> f a) -> s -> f s

-- | A lens for targetting a field of a higher kinded structure.  This
-- must be a newtype in order to be partially applied.
newtype FLens g s a = FLens (Lens' (g a) (s g))

iso :: (a -> s) -> (s -> a) -> Lens' a s
iso :: (a -> s) -> (s -> a) -> Lens' a s
iso a -> s
wrap s -> a
unwrap a -> f a
f s
g =  a -> s
wrap (a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f (s -> a
unwrap s
g)
{-# INLINE iso #-}

compFLens :: Lens' (s g) (t g) -> FLens g s a -> FLens g t a
compFLens :: Lens' (s g) (t g) -> FLens g s a -> FLens g t a
compFLens Lens' (s g) (t g)
l (FLens Lens' (g a) (s g)
m) = Lens' (g a) (t g) -> FLens g t a
forall k (g :: k -> *) (s :: (k -> *) -> *) (a :: k).
Lens' (g a) (s g) -> FLens g s a
FLens ((s g -> f (s g)) -> t g -> f (t g)
Lens' (s g) (t g)
l ((s g -> f (s g)) -> t g -> f (t g))
-> ((g a -> f (g a)) -> s g -> f (s g))
-> (g a -> f (g a))
-> t g
-> f (t g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> f (g a)) -> s g -> f (s g)
Lens' (g a) (s g)
m)
{-# INLINE compFLens #-}

compIsoFLens :: (s g -> t g) -> (t g -> s g) -> FLens g s a -> FLens g t a
compIsoFLens :: (s g -> t g) -> (t g -> s g) -> FLens g s a -> FLens g t a
compIsoFLens s g -> t g
wrap t g -> s g
unwrap = Lens' (s g) (t g) -> FLens g s a -> FLens g t a
forall k (s :: (k -> *) -> *) (g :: k -> *) (t :: (k -> *) -> *)
       (a :: k).
Lens' (s g) (t g) -> FLens g s a -> FLens g t a
compFLens ((s g -> t g) -> (t g -> s g) -> Lens' (s g) (t g)
forall a s. (a -> s) -> (s -> a) -> Lens' a s
iso s g -> t g
wrap t g -> s g
unwrap)
{-# INLINE compIsoFLens #-}

class FLenses (t :: (k -> *) -> *) where
  -- A record of lenses into the record.  Can be auto derived with a
  -- Generic instance.
  default flenses :: forall r g . GFlensesMachinery k t r g
                  => t (FLens g t)
  flenses = (FLens g (Tupled r) ~> FLens g t)
-> t (FLens g (Tupled r)) -> t (FLens g t)
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap ((Tupled r g -> t g)
-> (t g -> Tupled r g) -> FLens g (Tupled r) a -> FLens g t a
forall k (s :: (k -> *) -> *) (g :: k -> *) (t :: (k -> *) -> *)
       (a :: k).
(s g -> t g) -> (t g -> s g) -> FLens g s a -> FLens g t a
compIsoFLens Tupled r g -> t g
forall k (t :: k -> *) (g :: k) (r :: k -> * -> *).
(Generic (t g), Coercible (r g ()) (Rep (t g) ())) =>
Tupled r g -> t g
toHkd t g -> Tupled r g
forall k (t :: k -> *) (g :: k) (r :: k -> * -> *).
(Generic (t g), Coercible (r g ()) (Rep (t g) ())) =>
t g -> Tupled r g
fromHkd) (t (FLens g (Tupled r)) -> t (FLens g t))
-> t (FLens g (Tupled r)) -> t (FLens g t)
forall a b. (a -> b) -> a -> b
$
            Tupled r (FLens g (Tupled r)) -> t (FLens g (Tupled r))
forall k (t :: k -> *) (g :: k) (r :: k -> * -> *).
(Generic (t g), Coercible (r g ()) (Rep (t g) ())) =>
Tupled r g -> t g
toHkd (forall (g :: k -> *).
GFLenses (Rep (t g)) k r g =>
Tupled r (FLens g (Tupled r))
forall (x :: * -> *) k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
genflenses @(Rep (t g)) @k @r)
  {-# INLINE flenses #-}
  flenses :: t (FLens g t)

-- newtype to get rid of the extra type variable
newtype Tupled f (a :: k) = Tupled {Tupled f a -> f a ()
unTupled :: f a ()}

-- these newtypes just rearrange the type variables so they 
newtype FunctorS1 fieldName _x _x2 _x3 a g k =
  FunctorS1 { FunctorS1 fieldName _x _x2 _x3 a g k
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) k
getFunctorS1 :: (S1 ('MetaSel fieldName _x _x2 _x3)
                               (Rec0 (g a))
                               k)}

newtype FunctorD1 meta meta2 f l k =
  FunctorD1 { FunctorD1 meta meta2 f l k -> D1 meta (C1 meta2 (f l)) k
getFunctorD1 ::D1 meta (C1 meta2 (f l)) k }

newtype FunctorProd f g a k = FunctorProd ((f a :*: g a) k)

instance FFunctor (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) where
  ffmap :: (f ~> g)
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) f
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
ffmap f ~> g
f (Tupled (FunctorS1 (M1 (K1 f a
x))))
    = FunctorS1 fieldName _x _x2 _x3 a g ()
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorS1 fieldName _x _x2 _x3 a g ()
 -> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
-> FunctorS1 fieldName _x _x2 _x3 a g ()
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
-> FunctorS1 fieldName _x _x2 _x3 a g ()
forall k k (fieldName :: Maybe Symbol) (_x :: SourceUnpackedness)
       (_x2 :: SourceStrictness) (_x3 :: DecidedStrictness) (a :: k)
       (g :: k -> *) (k :: k).
S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) k
-> FunctorS1 fieldName _x _x2 _x3 a g k
FunctorS1 (S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
 -> FunctorS1 fieldName _x _x2 _x3 a g ())
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
-> FunctorS1 fieldName _x _x2 _x3 a g ()
forall a b. (a -> b) -> a -> b
$ K1 R (g a) () -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (g a) ()
 -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ())
-> K1 R (g a) ()
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall a b. (a -> b) -> a -> b
$ g a -> K1 R (g a) ()
forall k i c (p :: k). c -> K1 i c p
K1 (g a -> K1 R (g a) ()) -> g a -> K1 R (g a) ()
forall a b. (a -> b) -> a -> b
$ f a -> g a
f ~> g
f f a
x
  {-# INLINE ffmap #-}

instance FFunctor (Tupled f)
         => FFunctor (Tupled (FunctorD1 meta meta2 f)) where
  ffmap :: (f ~> g)
-> Tupled (FunctorD1 meta meta2 f) f
-> Tupled (FunctorD1 meta meta2 f) g
ffmap f ~> g
f (Tupled (FunctorD1 (M1 (M1 f f ()
x)))) =
    FunctorD1 meta meta2 f g () -> Tupled (FunctorD1 meta meta2 f) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorD1 meta meta2 f g () -> Tupled (FunctorD1 meta meta2 f) g)
-> FunctorD1 meta meta2 f g () -> Tupled (FunctorD1 meta meta2 f) g
forall a b. (a -> b) -> a -> b
$ D1 meta (C1 meta2 (f g)) () -> FunctorD1 meta meta2 f g ()
forall k k (meta :: Meta) (meta2 :: Meta) (f :: k -> k -> *)
       (l :: k) (k :: k).
D1 meta (C1 meta2 (f l)) k -> FunctorD1 meta meta2 f l k
FunctorD1 (D1 meta (C1 meta2 (f g)) () -> FunctorD1 meta meta2 f g ())
-> D1 meta (C1 meta2 (f g)) () -> FunctorD1 meta meta2 f g ()
forall a b. (a -> b) -> a -> b
$ M1 C meta2 (f g) () -> D1 meta (C1 meta2 (f g)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 (f g) () -> D1 meta (C1 meta2 (f g)) ())
-> M1 C meta2 (f g) () -> D1 meta (C1 meta2 (f g)) ()
forall a b. (a -> b) -> a -> b
$ f g () -> M1 C meta2 (f g) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f g () -> M1 C meta2 (f g) ()) -> f g () -> M1 C meta2 (f g) ()
forall a b. (a -> b) -> a -> b
$ Tupled f g -> f g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled (Tupled f g -> f g ()) -> Tupled f g -> f g ()
forall a b. (a -> b) -> a -> b
$ (f ~> g) -> Tupled f f -> Tupled f g
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f (Tupled f f -> Tupled f g) -> Tupled f f -> Tupled f g
forall a b. (a -> b) -> a -> b
$ f f () -> Tupled f f
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled f f ()
x
  {-# INLINE ffmap #-}

instance ( FFunctor (Tupled f)
         , FFunctor (Tupled g)
         ) =>
         FFunctor (Tupled (FunctorProd f g)) where
  ffmap :: (f ~> g)
-> Tupled (FunctorProd f g) f -> Tupled (FunctorProd f g) g
ffmap f ~> g
f (Tupled (FunctorProd (f f ()
x :*: g f ()
y))) =
    FunctorProd f g g () -> Tupled (FunctorProd f g) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorProd f g g () -> Tupled (FunctorProd f g) g)
-> FunctorProd f g g () -> Tupled (FunctorProd f g) g
forall a b. (a -> b) -> a -> b
$ (:*:) (f g) (g g) () -> FunctorProd f g g ()
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (k :: k).
(:*:) (f a) (g a) k -> FunctorProd f g a k
FunctorProd ((:*:) (f g) (g g) () -> FunctorProd f g g ())
-> (:*:) (f g) (g g) () -> FunctorProd f g g ()
forall a b. (a -> b) -> a -> b
$
    Tupled f g -> f g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled ((f ~> g) -> Tupled f f -> Tupled f g
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f (f f () -> Tupled f f
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled f f ()
x)) f g () -> g g () -> (:*:) (f g) (g g) ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:
    Tupled g g -> g g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled ((f ~> g) -> Tupled g f -> Tupled g g
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap f ~> g
f (g f () -> Tupled g f
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled g f ()
y))
  {-# INLINE ffmap #-}

class Coercible (x ()) (Tupled r g) =>
  GFLenses (x :: * -> *) k (r :: (k -> *) -> * -> *) g | x -> k, x -> r where
  genflenses :: Tupled r (FLens g (Tupled r))
  
instance GFLenses ((S1 ('MetaSel fieldName _x _x2 _x3)
                    (Rec0 (g (a :: k))) :: * -> *))
                   k
                  (FunctorS1 fieldName _x _x2 _x3 a)
                  g where
  genflenses :: Tupled
  (FunctorS1 fieldName _x _x2 _x3 a)
  (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
genflenses = FunctorS1
  fieldName
  _x
  _x2
  _x3
  a
  (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
  ()
-> Tupled
     (FunctorS1 fieldName _x _x2 _x3 a)
     (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorS1
   fieldName
   _x
   _x2
   _x3
   a
   (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
   ()
 -> Tupled
      (FunctorS1 fieldName _x _x2 _x3 a)
      (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a))))
-> FunctorS1
     fieldName
     _x
     _x2
     _x3
     a
     (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
     ()
-> Tupled
     (FunctorS1 fieldName _x _x2 _x3 a)
     (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
forall a b. (a -> b) -> a -> b
$ S1
  ('MetaSel fieldName _x _x2 _x3)
  (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
  ()
-> FunctorS1
     fieldName
     _x
     _x2
     _x3
     a
     (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
     ()
forall k k (fieldName :: Maybe Symbol) (_x :: SourceUnpackedness)
       (_x2 :: SourceStrictness) (_x3 :: DecidedStrictness) (a :: k)
       (g :: k -> *) (k :: k).
S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) k
-> FunctorS1 fieldName _x _x2 _x3 a g k
FunctorS1 (S1
   ('MetaSel fieldName _x _x2 _x3)
   (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
   ()
 -> FunctorS1
      fieldName
      _x
      _x2
      _x3
      a
      (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
      ())
-> S1
     ('MetaSel fieldName _x _x2 _x3)
     (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
     ()
-> FunctorS1
     fieldName
     _x
     _x2
     _x3
     a
     (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)))
     ()
forall a b. (a -> b) -> a -> b
$ K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ()
-> S1
     ('MetaSel fieldName _x _x2 _x3)
     (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
     ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ()
 -> S1
      ('MetaSel fieldName _x _x2 _x3)
      (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
      ())
-> K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ()
-> S1
     ('MetaSel fieldName _x _x2 _x3)
     (Rec0 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a))
     ()
forall a b. (a -> b) -> a -> b
$ FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a
-> K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ()
forall k i c (p :: k). c -> K1 i c p
K1 (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a
 -> K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ())
-> FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a
-> K1 R (FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a) ()
forall a b. (a -> b) -> a -> b
$ Lens' (g a) (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
-> FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a
forall k (g :: k -> *) (s :: (k -> *) -> *) (a :: k).
Lens' (g a) (s g) -> FLens g s a
FLens (Lens' (g a) (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
 -> FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a)
-> Lens' (g a) (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
-> FLens g (Tupled (FunctorS1 fieldName _x _x2 _x3 a)) a
forall a b. (a -> b) -> a -> b
$ \g a -> f (g a)
f Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
g ->
    ( FunctorS1 fieldName _x _x2 _x3 a g ()
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorS1 fieldName _x _x2 _x3 a g ()
 -> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
-> (g a -> FunctorS1 fieldName _x _x2 _x3 a g ())
-> g a
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
-> FunctorS1 fieldName _x _x2 _x3 a g ()
forall k k (fieldName :: Maybe Symbol) (_x :: SourceUnpackedness)
       (_x2 :: SourceStrictness) (_x3 :: DecidedStrictness) (a :: k)
       (g :: k -> *) (k :: k).
S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) k
-> FunctorS1 fieldName _x _x2 _x3 a g k
FunctorS1  (S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
 -> FunctorS1 fieldName _x _x2 _x3 a g ())
-> (g a -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ())
-> g a
-> FunctorS1 fieldName _x _x2 _x3 a g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (g a) () -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (g a) ()
 -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ())
-> (g a -> K1 R (g a) ())
-> g a
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> K1 R (g a) ()
forall k i c (p :: k). c -> K1 i c p
K1 ) (g a -> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
-> f (g a) -> f (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    g a -> f (g a)
f (K1 R (g a) () -> g a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R (g a) () -> g a)
-> (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g -> K1 R (g a) ())
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
-> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) () -> K1 R (g a) ()
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
 -> K1 R (g a) ())
-> (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
    -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ())
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
-> K1 R (g a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctorS1 fieldName _x _x2 _x3 a g ()
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall (fieldName :: Maybe Symbol) (_x :: SourceUnpackedness)
       (_x2 :: SourceStrictness) (_x3 :: DecidedStrictness) k (a :: k)
       (g :: k -> *) k (k :: k).
FunctorS1 fieldName _x _x2 _x3 a g k
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) k
getFunctorS1 (FunctorS1 fieldName _x _x2 _x3 a g ()
 -> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ())
-> (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
    -> FunctorS1 fieldName _x _x2 _x3 a g ())
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
-> S1 ('MetaSel fieldName _x _x2 _x3) (Rec0 (g a)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
-> FunctorS1 fieldName _x _x2 _x3 a g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled (Tupled (FunctorS1 fieldName _x _x2 _x3 a) g -> g a)
-> Tupled (FunctorS1 fieldName _x _x2 _x3 a) g -> g a
forall a b. (a -> b) -> a -> b
$ Tupled (FunctorS1 fieldName _x _x2 _x3 a) g
g)
  {-# INLINE genflenses #-}

instance
  ( FFunctor (Tupled r)
  , GFLenses x k r g
  ) =>
  GFLenses (D1 meta (C1 meta2 x)) k (FunctorD1 meta meta2 r) g where
  genflenses :: Tupled
  (FunctorD1 meta meta2 r)
  (FLens g (Tupled (FunctorD1 meta meta2 r)))
genflenses = FunctorD1
  meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
-> Tupled
     (FunctorD1 meta meta2 r)
     (FLens g (Tupled (FunctorD1 meta meta2 r)))
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorD1
   meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
 -> Tupled
      (FunctorD1 meta meta2 r)
      (FLens g (Tupled (FunctorD1 meta meta2 r))))
-> FunctorD1
     meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
-> Tupled
     (FunctorD1 meta meta2 r)
     (FLens g (Tupled (FunctorD1 meta meta2 r)))
forall a b. (a -> b) -> a -> b
$ D1
  meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ()
-> FunctorD1
     meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
forall k k (meta :: Meta) (meta2 :: Meta) (f :: k -> k -> *)
       (l :: k) (k :: k).
D1 meta (C1 meta2 (f l)) k -> FunctorD1 meta meta2 f l k
FunctorD1 (D1
   meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ()
 -> FunctorD1
      meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ())
-> D1
     meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ()
-> FunctorD1
     meta meta2 r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
forall a b. (a -> b) -> a -> b
$ M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ()
-> D1
     meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ()
 -> D1
      meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ())
-> M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ()
-> D1
     meta (C1 meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r))))) ()
forall a b. (a -> b) -> a -> b
$ r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
-> M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
 -> M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ())
-> r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
-> M1 C meta2 (r (FLens g (Tupled (FunctorD1 meta meta2 r)))) ()
forall a b. (a -> b) -> a -> b
$
               Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r)))
-> r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled (Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r)))
 -> r (FLens g (Tupled (FunctorD1 meta meta2 r))) ())
-> Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r)))
-> r (FLens g (Tupled (FunctorD1 meta meta2 r))) ()
forall a b. (a -> b) -> a -> b
$
               (FLens g (Tupled r) ~> FLens g (Tupled (FunctorD1 meta meta2 r)))
-> Tupled r (FLens g (Tupled r))
-> Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r)))
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap ((Tupled r g -> Tupled (FunctorD1 meta meta2 r) g)
-> (Tupled (FunctorD1 meta meta2 r) g -> Tupled r g)
-> FLens g (Tupled r) a
-> FLens g (Tupled (FunctorD1 meta meta2 r)) a
forall k (s :: (k -> *) -> *) (g :: k -> *) (t :: (k -> *) -> *)
       (a :: k).
(s g -> t g) -> (t g -> s g) -> FLens g s a -> FLens g t a
compIsoFLens
                      (FunctorD1 meta meta2 r g () -> Tupled (FunctorD1 meta meta2 r) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorD1 meta meta2 r g () -> Tupled (FunctorD1 meta meta2 r) g)
-> (Tupled r g -> FunctorD1 meta meta2 r g ())
-> Tupled r g
-> Tupled (FunctorD1 meta meta2 r) g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 meta (C1 meta2 (r g)) () -> FunctorD1 meta meta2 r g ()
forall k k (meta :: Meta) (meta2 :: Meta) (f :: k -> k -> *)
       (l :: k) (k :: k).
D1 meta (C1 meta2 (f l)) k -> FunctorD1 meta meta2 f l k
FunctorD1 (D1 meta (C1 meta2 (r g)) () -> FunctorD1 meta meta2 r g ())
-> (Tupled r g -> D1 meta (C1 meta2 (r g)) ())
-> Tupled r g
-> FunctorD1 meta meta2 r g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C meta2 (r g) () -> D1 meta (C1 meta2 (r g)) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 (r g) () -> D1 meta (C1 meta2 (r g)) ())
-> (Tupled r g -> M1 C meta2 (r g) ())
-> Tupled r g
-> D1 meta (C1 meta2 (r g)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r g () -> M1 C meta2 (r g) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (r g () -> M1 C meta2 (r g) ())
-> (Tupled r g -> r g ()) -> Tupled r g -> M1 C meta2 (r g) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tupled r g -> r g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled)
                      (r g () -> Tupled r g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (r g () -> Tupled r g)
-> (Tupled (FunctorD1 meta meta2 r) g -> r g ())
-> Tupled (FunctorD1 meta meta2 r) g
-> Tupled r g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C meta2 (r g) () -> r g ()
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 C meta2 (r g) () -> r g ())
-> (Tupled (FunctorD1 meta meta2 r) g -> M1 C meta2 (r g) ())
-> Tupled (FunctorD1 meta meta2 r) g
-> r g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 meta (C1 meta2 (r g)) () -> M1 C meta2 (r g) ()
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (D1 meta (C1 meta2 (r g)) () -> M1 C meta2 (r g) ())
-> (Tupled (FunctorD1 meta meta2 r) g
    -> D1 meta (C1 meta2 (r g)) ())
-> Tupled (FunctorD1 meta meta2 r) g
-> M1 C meta2 (r g) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctorD1 meta meta2 r g () -> D1 meta (C1 meta2 (r g)) ()
forall (meta :: Meta) (meta2 :: Meta) k k (f :: k -> k -> *)
       (l :: k) (k :: k).
FunctorD1 meta meta2 f l k -> D1 meta (C1 meta2 (f l)) k
getFunctorD1 (FunctorD1 meta meta2 r g () -> D1 meta (C1 meta2 (r g)) ())
-> (Tupled (FunctorD1 meta meta2 r) g
    -> FunctorD1 meta meta2 r g ())
-> Tupled (FunctorD1 meta meta2 r) g
-> D1 meta (C1 meta2 (r g)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tupled (FunctorD1 meta meta2 r) g -> FunctorD1 meta meta2 r g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled)) (Tupled r (FLens g (Tupled r))
 -> Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r))))
-> Tupled r (FLens g (Tupled r))
-> Tupled r (FLens g (Tupled (FunctorD1 meta meta2 r)))
forall a b. (a -> b) -> a -> b
$
               (forall k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
forall (x :: * -> *) k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
genflenses @x)
  {-# INLINE genflenses #-}

instance ( FFunctor (Tupled r1)
         , FFunctor (Tupled r2)
         , Coercible ((x :*: y) ())  (Tupled (FunctorProd r1 r2) g)
         , GFLenses x k r1 g
         , GFLenses y k r2 g
         ) =>
         GFLenses (x :*: y) k (FunctorProd r1 r2) g
         where
  genflenses :: Tupled (FunctorProd r1 r2) (FLens g (Tupled (FunctorProd r1 r2)))
genflenses = FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
-> Tupled
     (FunctorProd r1 r2) (FLens g (Tupled (FunctorProd r1 r2)))
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
 -> Tupled
      (FunctorProd r1 r2) (FLens g (Tupled (FunctorProd r1 r2))))
-> FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
-> Tupled
     (FunctorProd r1 r2) (FLens g (Tupled (FunctorProd r1 r2)))
forall a b. (a -> b) -> a -> b
$ (:*:)
  (r1 (FLens g (Tupled (FunctorProd r1 r2))))
  (r2 (FLens g (Tupled (FunctorProd r1 r2))))
  ()
-> FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (k :: k).
(:*:) (f a) (g a) k -> FunctorProd f g a k
FunctorProd ((:*:)
   (r1 (FLens g (Tupled (FunctorProd r1 r2))))
   (r2 (FLens g (Tupled (FunctorProd r1 r2))))
   ()
 -> FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ())
-> (:*:)
     (r1 (FLens g (Tupled (FunctorProd r1 r2))))
     (r2 (FLens g (Tupled (FunctorProd r1 r2))))
     ()
-> FunctorProd r1 r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
forall a b. (a -> b) -> a -> b
$
               Tupled r1 (FLens g (Tupled (FunctorProd r1 r2)))
-> r1 (FLens g (Tupled (FunctorProd r1 r2))) ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled ((FLens g (Tupled r1) ~> FLens g (Tupled (FunctorProd r1 r2)))
-> Tupled r1 (FLens g (Tupled r1))
-> Tupled r1 (FLens g (Tupled (FunctorProd r1 r2)))
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap (Lens' (Tupled r1 g) (Tupled (FunctorProd r1 r2) g)
-> FLens g (Tupled r1) a -> FLens g (Tupled (FunctorProd r1 r2)) a
forall k (s :: (k -> *) -> *) (g :: k -> *) (t :: (k -> *) -> *)
       (a :: k).
Lens' (s g) (t g) -> FLens g s a -> FLens g t a
compFLens (Lens' (Tupled r1 g) (Tupled (FunctorProd r1 r2) g)
 -> FLens g (Tupled r1) a -> FLens g (Tupled (FunctorProd r1 r2)) a)
-> Lens' (Tupled r1 g) (Tupled (FunctorProd r1 r2) g)
-> FLens g (Tupled r1) a
-> FLens g (Tupled (FunctorProd r1 r2)) a
forall a b. (a -> b) -> a -> b
$
                                \Tupled r1 g -> f (Tupled r1 g)
f (Tupled (FunctorProd (a :*: b))) ->
                                  (FunctorProd r1 r2 g () -> Tupled (FunctorProd r1 r2) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorProd r1 r2 g () -> Tupled (FunctorProd r1 r2) g)
-> (Tupled r1 g -> FunctorProd r1 r2 g ())
-> Tupled r1 g
-> Tupled (FunctorProd r1 r2) g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:*:) (r1 g) (r2 g) () -> FunctorProd r1 r2 g ()
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (k :: k).
(:*:) (f a) (g a) k -> FunctorProd f g a k
FunctorProd ((:*:) (r1 g) (r2 g) () -> FunctorProd r1 r2 g ())
-> (Tupled r1 g -> (:*:) (r1 g) (r2 g) ())
-> Tupled r1 g
-> FunctorProd r1 r2 g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r1 g () -> r2 g () -> (:*:) (r1 g) (r2 g) ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: r2 g ()
b) (r1 g () -> (:*:) (r1 g) (r2 g) ())
-> (Tupled r1 g -> r1 g ())
-> Tupled r1 g
-> (:*:) (r1 g) (r2 g) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tupled r1 g -> r1 g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled)
                                  (Tupled r1 g -> Tupled (FunctorProd r1 r2) g)
-> f (Tupled r1 g) -> f (Tupled (FunctorProd r1 r2) g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tupled r1 g -> f (Tupled r1 g)
f (r1 g () -> Tupled r1 g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled r1 g ()
a))
                         (forall k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
forall (x :: * -> *) k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
genflenses @x)) r1 (FLens g (Tupled (FunctorProd r1 r2))) ()
-> r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
-> (:*:)
     (r1 (FLens g (Tupled (FunctorProd r1 r2))))
     (r2 (FLens g (Tupled (FunctorProd r1 r2))))
     ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:
               Tupled r2 (FLens g (Tupled (FunctorProd r1 r2)))
-> r2 (FLens g (Tupled (FunctorProd r1 r2))) ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled ((FLens g (Tupled r2) ~> FLens g (Tupled (FunctorProd r1 r2)))
-> Tupled r2 (FLens g (Tupled r2))
-> Tupled r2 (FLens g (Tupled (FunctorProd r1 r2)))
forall k (t :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FFunctor t =>
(f ~> g) -> t f -> t g
ffmap (Lens' (Tupled r2 g) (Tupled (FunctorProd r1 r2) g)
-> FLens g (Tupled r2) a -> FLens g (Tupled (FunctorProd r1 r2)) a
forall k (s :: (k -> *) -> *) (g :: k -> *) (t :: (k -> *) -> *)
       (a :: k).
Lens' (s g) (t g) -> FLens g s a -> FLens g t a
compFLens (Lens' (Tupled r2 g) (Tupled (FunctorProd r1 r2) g)
 -> FLens g (Tupled r2) a -> FLens g (Tupled (FunctorProd r1 r2)) a)
-> Lens' (Tupled r2 g) (Tupled (FunctorProd r1 r2) g)
-> FLens g (Tupled r2) a
-> FLens g (Tupled (FunctorProd r1 r2)) a
forall a b. (a -> b) -> a -> b
$
                                \Tupled r2 g -> f (Tupled r2 g)
f (Tupled (FunctorProd (a :*: b))) ->
                                  (FunctorProd r1 r2 g () -> Tupled (FunctorProd r1 r2) g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled (FunctorProd r1 r2 g () -> Tupled (FunctorProd r1 r2) g)
-> (Tupled r2 g -> FunctorProd r1 r2 g ())
-> Tupled r2 g
-> Tupled (FunctorProd r1 r2) g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:*:) (r1 g) (r2 g) () -> FunctorProd r1 r2 g ()
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (k :: k).
(:*:) (f a) (g a) k -> FunctorProd f g a k
FunctorProd ((:*:) (r1 g) (r2 g) () -> FunctorProd r1 r2 g ())
-> (Tupled r2 g -> (:*:) (r1 g) (r2 g) ())
-> Tupled r2 g
-> FunctorProd r1 r2 g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r1 g ()
a r1 g () -> r2 g () -> (:*:) (r1 g) (r2 g) ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (r2 g () -> (:*:) (r1 g) (r2 g) ())
-> (Tupled r2 g -> r2 g ())
-> Tupled r2 g
-> (:*:) (r1 g) (r2 g) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tupled r2 g -> r2 g ()
forall k (f :: k -> * -> *) (a :: k). Tupled f a -> f a ()
unTupled)
                                  (Tupled r2 g -> Tupled (FunctorProd r1 r2) g)
-> f (Tupled r2 g) -> f (Tupled (FunctorProd r1 r2) g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tupled r2 g -> f (Tupled r2 g)
f (r2 g () -> Tupled r2 g
forall k (f :: k -> * -> *) (a :: k). f a () -> Tupled f a
Tupled r2 g ()
b))
                         (forall k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses y k r g =>
Tupled r (FLens g (Tupled r))
forall (x :: * -> *) k (r :: (k -> *) -> * -> *) (g :: k -> *).
GFLenses x k r g =>
Tupled r (FLens g (Tupled r))
genflenses @y))
        
  {-# INLINE genflenses #-}

type GFlensesMachinery k t r g =
  ( Generic (t g)
  , Generic (t (FLens g (Tupled r)))
  , Coercible (r (FLens g (Tupled r)) ())
    (Rep (t (FLens g (Tupled r))) ())
  , FFunctor (t :: (k -> *) -> *)
  , FFunctor (Tupled r)
  , GFLenses (Rep (t g)) k (r :: (k -> *) -> * -> *) g
  )

toHkd :: forall t g r.
         ( Generic (t g)
         , Coercible (r g ()) (Rep (t g) ())
         ) =>
         Tupled r g -> t g
toHkd :: Tupled r g -> t g
toHkd Tupled r g
t = Rep (t g) () -> t g
forall a x. Generic a => Rep a x -> a
to (Tupled r g -> Rep (t g) ()
coerce Tupled r g
t :: Rep (t g) ())
{-# INLINE toHkd #-}          

fromHkd :: forall t g r.
         ( Generic (t g)
         , Coercible (r g ()) (Rep (t g) ())
         ) =>
         t g -> Tupled r g
fromHkd :: t g -> Tupled r g
fromHkd t g
r = Rep (t g) () -> Tupled r g
coerce (t g -> Rep (t g) ()
forall a x. Generic a => a -> Rep a x
from t g
r :: Rep (t g) ())
{-# INLINE fromHkd #-}

-- | collect `Const` elements into a list efficiently.
ftoList :: FFoldable t => t (Const a) -> [a]
ftoList :: t (Const a) -> [a]
ftoList = (Endo [a] -> [a] -> [a]) -> [a] -> Endo [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [a] -> [a] -> [a]
forall a. Endo a -> a -> a
appEndo [] (Endo [a] -> [a])
-> (t (Const a) -> Endo [a]) -> t (Const a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). Const a a -> Endo [a]) -> t (Const a) -> Endo [a]
forall k (t :: (k -> *) -> *) m (f :: k -> *).
(FFoldable t, Monoid m) =>
(forall (a :: k). f a -> m) -> t f -> m
ffoldMap (([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (([a] -> [a]) -> Endo [a])
-> (Const a a -> [a] -> [a]) -> Const a a -> Endo [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (a -> [a] -> [a]) -> (Const a a -> a) -> Const a a -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a a -> a
forall a k (b :: k). Const a b -> a
getConst)