{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Optics.Internal.Generic
  ( generic
  , generic1
  , _V1
  , _U1
  , _Par1
  , _Rec1
  , _K1
  , _M1
  , _L1
  , _R1
  -- * Fields
  , GFieldImpl(..)
  , GSetFieldSum(..)
  , GSetFieldProd(..)
  , GAffineFieldImpl(..)
  , GAffineFieldSum(..)
  , GFieldProd(..)
  -- * Positions
  , GPositionImpl(..)
  , GPositionSum(..)
  -- * Constructors
  , GConstructorImpl(..)
  , GConstructorSum(..)
  , GConstructorTuple(..)
  -- * Types
  , GPlateImpl(..)
  , GPlateInner(..)
  -- * Re-export
  , module Optics.Internal.Generic.TypeLevel
  ) where

import Data.Type.Bool
import GHC.Generics
import GHC.Records
import GHC.TypeLits

import Optics.AffineTraversal
import Optics.Internal.Generic.TypeLevel
import Optics.Internal.Magic
import Optics.Internal.Optic
import Optics.Iso
import Optics.Lens
import Optics.Prism
import Optics.Traversal

----------------------------------------
-- GHC.Generics

-- | Convert from the data type to its representation (or back)
--
-- >>> view (generic % re generic) "hello" :: String
-- "hello"
--
generic :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b y)
generic :: Iso a b (Rep a x) (Rep b y)
generic = (a -> Rep a x) -> (Rep b y -> b) -> Iso a b (Rep a x) (Rep b y)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep b y -> b
forall a x. Generic a => Rep a x -> a
to

-- | Convert from the data type to its representation (or back)
generic1 :: (Generic1 f, Generic1 g) => Iso (f x) (g y) (Rep1 f x) (Rep1 g y)
generic1 :: Iso (f x) (g y) (Rep1 f x) (Rep1 g y)
generic1 = (f x -> Rep1 f x)
-> (Rep1 g y -> g y) -> Iso (f x) (g y) (Rep1 f x) (Rep1 g y)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso f x -> Rep1 f x
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 Rep1 g y -> g y
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1

_V1 :: Lens (V1 s) (V1 t) a b
_V1 :: Lens (V1 s) (V1 t) a b
_V1 = LensVL (V1 s) (V1 t) a b -> Lens (V1 s) (V1 t) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (\a -> f b
_ -> \case {})

_U1 :: Iso (U1 p) (U1 q) () ()
_U1 :: Iso (U1 p) (U1 q) () ()
_U1 = (U1 p -> ()) -> (() -> U1 q) -> Iso (U1 p) (U1 q) () ()
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (() -> U1 p -> ()
forall a b. a -> b -> a
const ()) (U1 q -> () -> U1 q
forall a b. a -> b -> a
const U1 q
forall k (p :: k). U1 p
U1)

_Par1 :: Iso (Par1 p) (Par1 q) p q
_Par1 :: Iso (Par1 p) (Par1 q) p q
_Par1 = Iso (Par1 p) (Par1 q) p q
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

_Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q)
_Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q)
_Rec1 = Iso (Rec1 f p) (Rec1 g q) (f p) (g q)
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

_K1 :: Iso (K1 i c p) (K1 j d q) c d
_K1 :: Iso (K1 i c p) (K1 j d q) c d
_K1 = Iso (K1 i c p) (K1 j d q) c d
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

_M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
_M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
_M1 = Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

_L1 :: Prism ((a :+: c) t) ((b :+: c) t) (a t) (b t)
_L1 :: Prism ((:+:) a c t) ((:+:) b c t) (a t) (b t)
_L1 = (b t -> (:+:) b c t)
-> ((:+:) a c t -> Either ((:+:) b c t) (a t))
-> Prism ((:+:) a c t) ((:+:) b c t) (a t) (b t)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b t -> (:+:) b c t
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (:+:) a c t -> Either ((:+:) b c t) (a t)
forall (f :: * -> *) (g :: * -> *) p (f :: * -> *).
(:+:) f g p -> Either ((:+:) f g p) (f p)
reviewer
  where
    reviewer :: (:+:) f g p -> Either ((:+:) f g p) (f p)
reviewer (L1 f p
v) = f p -> Either ((:+:) f g p) (f p)
forall a b. b -> Either a b
Right f p
v
    reviewer (R1 g p
v) = (:+:) f g p -> Either ((:+:) f g p) (f p)
forall a b. a -> Either a b
Left (g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
v)

_R1 :: Prism ((c :+: a) t) ((c :+: b) t) (a t) (b t)
_R1 :: Prism ((:+:) c a t) ((:+:) c b t) (a t) (b t)
_R1 = (b t -> (:+:) c b t)
-> ((:+:) c a t -> Either ((:+:) c b t) (a t))
-> Prism ((:+:) c a t) ((:+:) c b t) (a t) (b t)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b t -> (:+:) c b t
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (:+:) c a t -> Either ((:+:) c b t) (a t)
forall (f :: * -> *) (g :: * -> *) p (g :: * -> *).
(:+:) f g p -> Either ((:+:) f g p) (g p)
reviewer
  where
    reviewer :: (:+:) f g p -> Either ((:+:) f g p) (g p)
reviewer (R1 g p
v) = g p -> Either ((:+:) f g p) (g p)
forall a b. b -> Either a b
Right g p
v
    reviewer (L1 f p
v) = (:+:) f g p -> Either ((:+:) f g p) (g p)
forall a b. a -> Either a b
Left (f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
v)

----------------------------------------
-- Field

class GFieldImpl (name :: Symbol) s t a b | name s -> a
                                       {- These hold morally, but we can't prove it.
                                          , name t -> b
                                          , name s b -> t
                                          , name t a -> s -} where
  gfieldImpl :: Lens s t a b

instance
  ( Generic s
  , Generic t
  , path ~ GetFieldPaths s name (Rep s)
  , HasField name s a
  , GSetFieldSum path (Rep s) (Rep t) b
  ) => GFieldImpl name s t a b where
  gfieldImpl :: Lens s t a b
gfieldImpl = (s -> a) -> (s -> b -> t) -> Lens s t a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField name r a => r -> a
getField @name) (\s
s -> Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Rep t Any -> t) -> (b -> Rep t Any) -> b -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep s Any -> b -> Rep t Any
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) b x.
GSetFieldSum path g h b =>
g x -> b -> h x
gsetFieldSum @path (s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from s
s))
  {-# INLINE gfieldImpl #-}

----------------------------------------

class GSetFieldSum (path :: PathTree Symbol) g h b | path h -> b
                                                   , path g b -> h where
  gsetFieldSum :: g x -> b -> h x

instance
  ( GSetFieldSum path g h b
  ) => GSetFieldSum path (M1 D m g) (M1 D m h) b where
  gsetFieldSum :: M1 D m g x -> b -> M1 D m h x
gsetFieldSum (M1 g x
x) = h x -> M1 D m h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 D m h x) -> (b -> h x) -> b -> M1 D m h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> b -> h x
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) b x.
GSetFieldSum path g h b =>
g x -> b -> h x
gsetFieldSum @path g x
x

instance
  ( GSetFieldSum path1 g1 h1 b
  , GSetFieldSum path2 g2 h2 b
  ) => GSetFieldSum ('PathTree path1 path2) (g1 :+: g2) (h1 :+: h2) b where
  gsetFieldSum :: (:+:) g1 g2 x -> b -> (:+:) h1 h2 x
gsetFieldSum (L1 g1 x
x) = h1 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (h1 x -> (:+:) h1 h2 x) -> (b -> h1 x) -> b -> (:+:) h1 h2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g1 x -> b -> h1 x
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) b x.
GSetFieldSum path g h b =>
g x -> b -> h x
gsetFieldSum @path1 g1 x
x
  gsetFieldSum (R1 g2 x
y) = h2 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (h2 x -> (:+:) h1 h2 x) -> (b -> h2 x) -> b -> (:+:) h1 h2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g2 x -> b -> h2 x
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) b x.
GSetFieldSum path g h b =>
g x -> b -> h x
gsetFieldSum @path2 g2 x
y
  {-# INLINE gsetFieldSum #-}

instance
  ( path ~ GSetFieldPath con epath
  , When (IsLeft epath) (HideReps g h)
  , GSetFieldProd path g h b
  ) => GSetFieldSum ('PathLeaf epath) (M1 C ('MetaCons con fix hs) g)
                                      (M1 C ('MetaCons con fix hs) h) b where
  gsetFieldSum :: M1 C ('MetaCons con fix hs) g x
-> b -> M1 C ('MetaCons con fix hs) h x
gsetFieldSum (M1 g x
x) = h x -> M1 C ('MetaCons con fix hs) h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 C ('MetaCons con fix hs) h x)
-> (b -> h x) -> b -> M1 C ('MetaCons con fix hs) h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> b -> h x
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) b x.
GSetFieldProd path g h b =>
g x -> b -> h x
gsetFieldProd @path g x
x

type family GSetFieldPath (con :: Symbol) (e :: Either Symbol [Path]) :: [Path] where
  GSetFieldPath _   ('Right path) = path
  GSetFieldPath con ('Left name)  = TypeError
    ('Text "Data constructor " ':<>: QuoteSymbol con ':<>:
     'Text " doesn't have a field named " ':<>: QuoteSymbol name)

class GSetFieldProd (path :: [Path]) g h b | path h -> b
                                           , path g b -> h where
  gsetFieldProd :: g x -> b -> h x

-- fast path left
instance {-# OVERLAPPING #-}
  ( GSetFieldProd path g1 h1 b
  ) => GSetFieldProd ('PathLeft : path) (g1 :*: g2) (h1 :*: g2) b where
  gsetFieldProd :: (:*:) g1 g2 x -> b -> (:*:) h1 g2 x
gsetFieldProd (g1 x
x :*: g2 x
y) = (h1 x -> g2 x -> (:*:) h1 g2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g2 x
y) (h1 x -> (:*:) h1 g2 x) -> (b -> h1 x) -> b -> (:*:) h1 g2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g1 x -> b -> h1 x
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) b x.
GSetFieldProd path g h b =>
g x -> b -> h x
gsetFieldProd @path g1 x
x

-- slow path left
instance
  ( GSetFieldProd path g1 h1 b
  , g2 ~ h2
  ) => GSetFieldProd ('PathLeft : path) (g1 :*: g2) (h1 :*: h2) b where
  gsetFieldProd :: (:*:) g1 g2 x -> b -> (:*:) h1 h2 x
gsetFieldProd (g1 x
x :*: g2 x
y) = (h1 x -> g2 x -> (:*:) h1 g2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g2 x
y) (h1 x -> (:*:) h1 g2 x) -> (b -> h1 x) -> b -> (:*:) h1 g2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g1 x -> b -> h1 x
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) b x.
GSetFieldProd path g h b =>
g x -> b -> h x
gsetFieldProd @path g1 x
x

-- fast path right
instance {-# OVERLAPPING #-}
  ( GSetFieldProd path g2 h2 b
  ) => GSetFieldProd ('PathRight : path) (g1 :*: g2) (g1 :*: h2) b where
  gsetFieldProd :: (:*:) g1 g2 x -> b -> (:*:) g1 h2 x
gsetFieldProd (g1 x
x :*: g2 x
y) = (g1 x
x g1 x -> h2 x -> (:*:) g1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (h2 x -> (:*:) g1 h2 x) -> (b -> h2 x) -> b -> (:*:) g1 h2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g2 x -> b -> h2 x
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) b x.
GSetFieldProd path g h b =>
g x -> b -> h x
gsetFieldProd @path g2 x
y

-- slow path right
instance
  ( GSetFieldProd path g2 h2 b
  , g1 ~ h1
  ) => GSetFieldProd ('PathRight : path) (g1 :*: g2) (h1 :*: h2) b where
  gsetFieldProd :: (:*:) g1 g2 x -> b -> (:*:) h1 h2 x
gsetFieldProd (g1 x
x :*: g2 x
y) = (g1 x
x g1 x -> h2 x -> (:*:) g1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (h2 x -> (:*:) g1 h2 x) -> (b -> h2 x) -> b -> (:*:) g1 h2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g2 x -> b -> h2 x
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) b x.
GSetFieldProd path g h b =>
g x -> b -> h x
gsetFieldProd @path g2 x
y

instance
  ( r ~ b
  ) => GSetFieldProd '[] (M1 S m (Rec0 a)) (M1 S m (Rec0 b)) r where
  gsetFieldProd :: M1 S m (Rec0 a) x -> r -> M1 S m (Rec0 b) x
gsetFieldProd M1 S m (Rec0 a) x
_ = K1 R b x -> M1 S m (Rec0 b) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R b x -> M1 S m (Rec0 b) x)
-> (b -> K1 R b x) -> b -> M1 S m (Rec0 b) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> K1 R b x
forall k i c (p :: k). c -> K1 i c p
K1

----------------------------------------
-- Affine field

class GAffineFieldImpl (repDefined :: Bool)
                       (name :: Symbol) s t a b | name s -> a
                                             {- These hold morally, but we can't prove it.
                                                , name t -> b
                                                , name s b -> t
                                                , name t a -> s -} where

  gafieldImpl :: AffineTraversal s t a b

instance
  ( Generic s
  , Generic t
  , path ~ GetFieldPaths s name (Rep s)
  , HasField name s a -- require the field to be in scope
  , Unless (AnyHasPath path)
    (TypeError
      ('Text "Type " ':<>: QuoteType s ':<>:
       'Text " doesn't have a field named " ':<>: QuoteSymbol name))
  , GAffineFieldSum path (Rep s) (Rep t) a b
  ) => GAffineFieldImpl 'True name s t a b where
  gafieldImpl :: AffineTraversal s t a b
gafieldImpl = AffineTraversal s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b)
-> AffineTraversal s t a b
forall k (is :: IxList) s t a b r.
Is k An_AffineTraversal =>
Optic k is s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withAffineTraversal
    (AffineTraversalVL s t a b -> AffineTraversal s t a b
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (\forall r. r -> f r
point a -> f b
f s
s -> Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Rep t Any -> t) -> f (Rep t Any) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. r -> f r) -> (a -> f b) -> Rep s Any -> f (Rep t Any)
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) a b x.
GAffineFieldSum path g h a b =>
AffineTraversalVL (g x) (h x) a b
gafieldSum @path forall r. r -> f r
point a -> f b
f (s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from s
s)))
    (\s -> Either t a
match s -> b -> t
update -> AffineTraversalVL s t a b -> AffineTraversal s t a b
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (AffineTraversalVL s t a b -> AffineTraversal s t a b)
-> AffineTraversalVL s t a b -> AffineTraversal s t a b
forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point a -> f b
f s
s ->
        (t -> f t) -> (a -> f t) -> Either t a -> f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> f t
forall r. r -> f r
point ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> b -> t
update s
s) (f b -> f t) -> (a -> f b) -> a -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (s -> Either t a
match s
s))
  {-# INLINE gafieldImpl #-}

----------------------------------------

class GAffineFieldSum (path :: PathTree Symbol) g h a b where
  gafieldSum :: AffineTraversalVL (g x) (h x) a b

instance
  ( GAffineFieldSum path g h a b
  ) => GAffineFieldSum path (M1 D m g) (M1 D m h) a b where
  gafieldSum :: (forall r. r -> f r) -> (a -> f b) -> M1 D m g x -> f (M1 D m h x)
gafieldSum forall r. r -> f r
point a -> f b
f (M1 g x
x) = h x -> M1 D m h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 D m h x) -> f (h x) -> f (M1 D m h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. r -> f r) -> (a -> f b) -> g x -> f (h x)
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) a b x.
GAffineFieldSum path g h a b =>
AffineTraversalVL (g x) (h x) a b
gafieldSum @path forall r. r -> f r
point a -> f b
f g x
x

instance
  ( GAffineFieldSum path1 g1 h1 a b
  , GAffineFieldSum path2 g2 h2 a b
  ) => GAffineFieldSum ('PathTree path1 path2) (g1 :+: g2) (h1 :+: h2) a b where
  gafieldSum :: (forall r. r -> f r)
-> (a -> f b) -> (:+:) g1 g2 x -> f ((:+:) h1 h2 x)
gafieldSum forall r. r -> f r
point a -> f b
f (L1 g1 x
x) = h1 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (h1 x -> (:+:) h1 h2 x) -> f (h1 x) -> f ((:+:) h1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. r -> f r) -> (a -> f b) -> g1 x -> f (h1 x)
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) a b x.
GAffineFieldSum path g h a b =>
AffineTraversalVL (g x) (h x) a b
gafieldSum @path1 forall r. r -> f r
point a -> f b
f g1 x
x
  gafieldSum forall r. r -> f r
point a -> f b
f (R1 g2 x
y) = h2 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (h2 x -> (:+:) h1 h2 x) -> f (h2 x) -> f ((:+:) h1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. r -> f r) -> (a -> f b) -> g2 x -> f (h2 x)
forall (path :: PathTree Symbol) (g :: * -> *) (h :: * -> *) a b x.
GAffineFieldSum path g h a b =>
AffineTraversalVL (g x) (h x) a b
gafieldSum @path2 forall r. r -> f r
point a -> f b
f g2 x
y
  {-# INLINE gafieldSum #-}

instance
  ( GAffineFieldMaybe epath g h a b
  ) => GAffineFieldSum ('PathLeaf epath) (M1 C m g) (M1 C m h) a b where
  gafieldSum :: (forall r. r -> f r) -> (a -> f b) -> M1 C m g x -> f (M1 C m h x)
gafieldSum forall r. r -> f r
point a -> f b
f (M1 g x
x) = h x -> M1 C m h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 C m h x) -> f (h x) -> f (M1 C m h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. r -> f r) -> (a -> f b) -> g x -> f (h x)
forall (epath :: Either Symbol [Path]) (g :: * -> *) (h :: * -> *)
       a b x.
GAffineFieldMaybe epath g h a b =>
AffineTraversalVL (g x) (h x) a b
gafieldMaybe @epath forall r. r -> f r
point a -> f b
f g x
x

class GAffineFieldMaybe (epath :: Either Symbol [Path]) g h a b where
  gafieldMaybe :: AffineTraversalVL (g x) (h x) a b

instance
  ( g ~ h
  ) => GAffineFieldMaybe ('Left name) g h a b where
  gafieldMaybe :: (forall r. r -> f r) -> (a -> f b) -> g x -> f (h x)
gafieldMaybe forall r. r -> f r
point a -> f b
_ g x
g = g x -> f (g x)
forall r. r -> f r
point g x
g

instance
  ( GFieldProd prodPath g h a b
  ) => GAffineFieldMaybe ('Right prodPath) g h a b where
  gafieldMaybe :: (forall r. r -> f r) -> (a -> f b) -> g x -> f (h x)
gafieldMaybe forall r. r -> f r
_ a -> f b
f g x
g = (a -> f b) -> g x -> f (h x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @prodPath a -> f b
f g x
g

----------------------------------------

class GFieldProd (path :: [Path]) g h a b | path g -> a
                                          , path h -> b
                                          , path g b -> h
                                          , path h a -> g where
  gfieldProd :: LensVL (g x) (h x) a b

-- fast path left
instance {-# OVERLAPPING #-}
  ( GFieldProd path g1 h1 a b
  ) => GFieldProd ('PathLeft : path) (g1 :*: g2) (h1 :*: g2) a b where
  gfieldProd :: (a -> f b) -> (:*:) g1 g2 x -> f ((:*:) h1 g2 x)
gfieldProd a -> f b
f (g1 x
x :*: g2 x
y) = (h1 x -> g2 x -> (:*:) h1 g2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g2 x
y) (h1 x -> (:*:) h1 g2 x) -> f (h1 x) -> f ((:*:) h1 g2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g1 x -> f (h1 x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @path a -> f b
f g1 x
x

-- slow path left
instance
  ( GFieldProd path g1 h1 a b
  , g2 ~ h2
  ) => GFieldProd ('PathLeft : path) (g1 :*: g2) (h1 :*: h2) a b where
  gfieldProd :: (a -> f b) -> (:*:) g1 g2 x -> f ((:*:) h1 h2 x)
gfieldProd a -> f b
f (g1 x
x :*: g2 x
y) = (h1 x -> g2 x -> (:*:) h1 g2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g2 x
y) (h1 x -> (:*:) h1 g2 x) -> f (h1 x) -> f ((:*:) h1 g2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g1 x -> f (h1 x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @path a -> f b
f g1 x
x

-- fast path right
instance {-# OVERLAPPING #-}
  ( GFieldProd path g2 h2 a b
  ) => GFieldProd ('PathRight : path) (g1 :*: g2) (g1 :*: h2) a b where
  gfieldProd :: (a -> f b) -> (:*:) g1 g2 x -> f ((:*:) g1 h2 x)
gfieldProd a -> f b
f (g1 x
x :*: g2 x
y) = (g1 x
x g1 x -> h2 x -> (:*:) g1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (h2 x -> (:*:) g1 h2 x) -> f (h2 x) -> f ((:*:) g1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g2 x -> f (h2 x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @path a -> f b
f g2 x
y

-- slow path right
instance
  ( GFieldProd path g2 h2 a b
  , g1 ~ h1
  ) => GFieldProd ('PathRight : path) (g1 :*: g2) (h1 :*: h2) a b where
  gfieldProd :: (a -> f b) -> (:*:) g1 g2 x -> f ((:*:) h1 h2 x)
gfieldProd a -> f b
f (g1 x
x :*: g2 x
y) = (g1 x
x g1 x -> h2 x -> (:*:) g1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (h2 x -> (:*:) g1 h2 x) -> f (h2 x) -> f ((:*:) g1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g2 x -> f (h2 x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @path a -> f b
f g2 x
y

instance
  ( r ~ a
  , s ~ b
  ) => GFieldProd '[] (M1 S m (Rec0 a)) (M1 S m (Rec0 b)) r s where
  gfieldProd :: (r -> f s) -> M1 S m (Rec0 a) x -> f (M1 S m (Rec0 b) x)
gfieldProd r -> f s
f (M1 (K1 a
x)) = K1 R s x -> M1 S m (K1 R s) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R s x -> M1 S m (K1 R s) x)
-> (s -> K1 R s x) -> s -> M1 S m (K1 R s) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> K1 R s x
forall k i c (p :: k). c -> K1 i c p
K1 (s -> M1 S m (K1 R s) x) -> f s -> f (M1 S m (K1 R s) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> f s
f r
a
x

----------------------------------------
-- Position

class GPositionImpl (repDefined :: Bool)
                    (n :: Nat) s t a b | n s -> a
                                    {- These hold morally, but we can't prove it.
                                       , n t -> b
                                       , n s b -> t
                                       , n t a -> s -} where

  gpositionImpl :: Lens s t a b

instance
  ( Generic s
  , Generic t
  , path ~ If (n <=? 0)
              (TypeError ('Text "There is no 0th position"))
              (GetPositionPaths s n (Rep s))
  , When (n <=? 0) (HideReps (Rep s) (Rep t))
  , GPositionSum path (Rep s) (Rep t) a b
  ) => GPositionImpl 'True n s t a b where
  gpositionImpl :: Lens s t a b
gpositionImpl = Lens s t a b
-> ((s -> a) -> (s -> b -> t) -> Lens s t a b) -> Lens s t a b
forall k (is :: IxList) s t a b r.
Is k A_Lens =>
Optic k is s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
withLens
    (LensVL s t a b -> Lens s t a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (\a -> f b
f s
s -> Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Rep t Any -> t) -> f (Rep t Any) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Rep s Any -> f (Rep t Any)
forall (path :: PathTree (Nat, Nat)) (g :: * -> *) (h :: * -> *) a
       b x.
GPositionSum path g h a b =>
LensVL (g x) (h x) a b
gpositionSum @path a -> f b
f (s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from s
s)))
    (\s -> a
get s -> b -> t
set -> LensVL s t a b -> Lens s t a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL s t a b -> Lens s t a b) -> LensVL s t a b -> Lens s t a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f s
s -> s -> b -> t
set s
s (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f (s -> a
get s
s))
  {-# INLINE gpositionImpl #-}

----------------------------------------

class GPositionSum (path :: PathTree (Nat, Nat)) g h a b | path g -> a
                                                         , path h -> b
                                                         , path g b -> h
                                                         , path h a -> g where
  gpositionSum :: LensVL (g x) (h x) a b

instance
  ( GPositionSum path g h a b
  ) => GPositionSum path (M1 D m g) (M1 D m h) a b where
  gpositionSum :: (a -> f b) -> M1 D m g x -> f (M1 D m h x)
gpositionSum a -> f b
f (M1 g x
x) = h x -> M1 D m h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 D m h x) -> f (h x) -> f (M1 D m h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g x -> f (h x)
forall (path :: PathTree (Nat, Nat)) (g :: * -> *) (h :: * -> *) a
       b x.
GPositionSum path g h a b =>
LensVL (g x) (h x) a b
gpositionSum @path a -> f b
f g x
x

instance
  ( GPositionSum path1 g1 h1 a b
  , GPositionSum path2 g2 h2 a b
  ) => GPositionSum ('PathTree path1 path2) (g1 :+: g2) (h1 :+: h2) a b where
  gpositionSum :: (a -> f b) -> (:+:) g1 g2 x -> f ((:+:) h1 h2 x)
gpositionSum a -> f b
f (L1 g1 x
x) = h1 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (h1 x -> (:+:) h1 h2 x) -> f (h1 x) -> f ((:+:) h1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g1 x -> f (h1 x)
forall (path :: PathTree (Nat, Nat)) (g :: * -> *) (h :: * -> *) a
       b x.
GPositionSum path g h a b =>
LensVL (g x) (h x) a b
gpositionSum @path1 a -> f b
f g1 x
x
  gpositionSum a -> f b
f (R1 g2 x
y) = h2 x -> (:+:) h1 h2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (h2 x -> (:+:) h1 h2 x) -> f (h2 x) -> f ((:+:) h1 h2 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g2 x -> f (h2 x)
forall (path :: PathTree (Nat, Nat)) (g :: * -> *) (h :: * -> *) a
       b x.
GPositionSum path g h a b =>
LensVL (g x) (h x) a b
gpositionSum @path2 a -> f b
f g2 x
y
  {-# INLINE gpositionSum #-}

instance
  ( path ~ GPositionPath con epath
  , When (IsLeft epath) (HideReps g h)
  , GFieldProd path g h a b
  ) => GPositionSum ('PathLeaf epath) (M1 C ('MetaCons con fix hs) g)
                                      (M1 C ('MetaCons con fix hs) h) a b where
  gpositionSum :: (a -> f b)
-> M1 C ('MetaCons con fix hs) g x
-> f (M1 C ('MetaCons con fix hs) h x)
gpositionSum a -> f b
f (M1 g x
x) = h x -> M1 C ('MetaCons con fix hs) h x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (h x -> M1 C ('MetaCons con fix hs) h x)
-> f (h x) -> f (M1 C ('MetaCons con fix hs) h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g x -> f (h x)
forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GFieldProd path g h a b =>
LensVL (g x) (h x) a b
gfieldProd @path a -> f b
f g x
x

type family GPositionPath con (e :: Either (Nat, Nat) [Path]) :: [Path] where
  GPositionPath _   ('Right path)   = path
  GPositionPath con ('Left '(n, k)) = TypeError
    ('Text "Data constructor " ':<>: QuoteSymbol con ':<>:
     'Text " has " ':<>: ShowFieldNumber k ':<>: 'Text ", " ':<>:
     ToOrdinal n ':<>: 'Text " requested")

type family ShowFieldNumber (k :: Nat) :: ErrorMessage where
  ShowFieldNumber 0 = 'Text "no fields"
  ShowFieldNumber 1 = 'Text "1 field"
  ShowFieldNumber k = 'ShowType k ':<>: 'Text " fields"

----------------------------------------
-- Constructor

class GConstructorImpl (repDefined :: Bool)
                       (name :: Symbol) s t a b | name s -> a
                                             {- These hold morally, but we can't prove it.
                                                , name t -> b
                                                , name s b -> t
                                                , name t a -> s -} where

  gconstructorImpl :: Prism s t a b

instance
  ( Generic s
  , Generic t
  , epath ~ GetNamePath name (Rep s) '[]
  , path ~ FromRight
    (TypeError
      ('Text "Type " ':<>: QuoteType s ':<>:
       'Text " doesn't have a constructor named " ':<>: QuoteSymbol name))
    epath
  , When (IsLeft epath) (HideReps (Rep s) (Rep t))
  , GConstructorSum path (Rep s) (Rep t) a b
  ) => GConstructorImpl 'True name s t a b where
  gconstructorImpl :: Prism s t a b
gconstructorImpl = Prism s t a b
-> ((b -> t) -> (s -> Either t a) -> Prism s t a b)
-> Prism s t a b
forall k (is :: IxList) s t a b r.
Is k A_Prism =>
Optic k is s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism (Optic An_Iso NoIx s t (Rep s Any) (Rep t Any)
forall a b x y.
(Generic a, Generic b) =>
Iso a b (Rep a x) (Rep b y)
generic Optic An_Iso NoIx s t (Rep s Any) (Rep t Any)
-> Optic A_Prism NoIx (Rep s Any) (Rep t Any) a b -> Prism s t a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path) (b -> t) -> (s -> Either t a) -> Prism s t a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
  {-# INLINE gconstructorImpl #-}

----------------------------------------

class GConstructorSum (path :: [Path]) g h a b | path g -> a
                                               , path h -> b
                                               , path g b -> h
                                               , path h a -> g where
  gconstructorSum :: Prism (g x) (h x) a b

instance
  ( GConstructorSum path g h a b
  ) => GConstructorSum path (M1 D m g) (M1 D m h) a b where
  gconstructorSum :: Prism (M1 D m g x) (M1 D m h x) a b
gconstructorSum = Iso (M1 D m g x) (M1 D m h x) (g x) (h x)
forall i (c :: Meta) (f :: * -> *) p j (d :: Meta) (g :: * -> *) q.
Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
_M1 Iso (M1 D m g x) (M1 D m h x) (g x) (h x)
-> Optic A_Prism NoIx (g x) (h x) a b
-> Prism (M1 D m g x) (M1 D m h x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path

-- fast path left
instance {-# OVERLAPPING #-}
  ( GConstructorSum path g1 h1 a b
  ) => GConstructorSum ('PathLeft : path) (g1 :+: g2) (h1 :+: g2) a b where
  gconstructorSum :: Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) a b
gconstructorSum = Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) (g1 x) (h1 x)
forall (a :: * -> *) (c :: * -> *) t (b :: * -> *).
Prism ((:+:) a c t) ((:+:) b c t) (a t) (b t)
_L1 Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) (g1 x) (h1 x)
-> Optic A_Prism NoIx (g1 x) (h1 x) a b
-> Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path

-- slow path left
instance
  ( GConstructorSum path g1 h1 a b
  , g2 ~ h2
  ) => GConstructorSum ('PathLeft : path) (g1 :+: g2) (h1 :+: h2) a b where
  gconstructorSum :: Prism ((:+:) g1 g2 x) ((:+:) h1 h2 x) a b
gconstructorSum = Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) (g1 x) (h1 x)
forall (a :: * -> *) (c :: * -> *) t (b :: * -> *).
Prism ((:+:) a c t) ((:+:) b c t) (a t) (b t)
_L1 Prism ((:+:) g1 g2 x) ((:+:) h1 g2 x) (g1 x) (h1 x)
-> Optic A_Prism NoIx (g1 x) (h1 x) a b
-> Optic A_Prism NoIx ((:+:) g1 g2 x) ((:+:) h1 g2 x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path

-- fast path right
instance {-# OVERLAPPING #-}
  ( GConstructorSum path g2 h2 a b
  ) => GConstructorSum ('PathRight : path) (g1 :+: g2) (g1 :+: h2) a b where
  gconstructorSum :: Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) a b
gconstructorSum = Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) (g2 x) (h2 x)
forall (c :: * -> *) (a :: * -> *) t (b :: * -> *).
Prism ((:+:) c a t) ((:+:) c b t) (a t) (b t)
_R1 Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) (g2 x) (h2 x)
-> Optic A_Prism NoIx (g2 x) (h2 x) a b
-> Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path

-- slow path right
instance
  ( GConstructorSum path g2 h2 a b
  , g1 ~ h1
  ) => GConstructorSum ('PathRight : path) (g1 :+: g2) (h1 :+: h2) a b where
  gconstructorSum :: Prism ((:+:) g1 g2 x) ((:+:) h1 h2 x) a b
gconstructorSum = Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) (g2 x) (h2 x)
forall (c :: * -> *) (a :: * -> *) t (b :: * -> *).
Prism ((:+:) c a t) ((:+:) c b t) (a t) (b t)
_R1 Prism ((:+:) g1 g2 x) ((:+:) g1 h2 x) (g2 x) (h2 x)
-> Optic A_Prism NoIx (g2 x) (h2 x) a b
-> Optic A_Prism NoIx ((:+:) g1 g2 x) ((:+:) g1 h2 x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (path :: [Path]) (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorSum path g h a b =>
Prism (g x) (h x) a b
gconstructorSum @path

instance
  ( GConstructorTuple g h a b
  ) => GConstructorSum '[] (M1 C m g) (M1 C m h) a b where
  gconstructorSum :: Prism (M1 C m g x) (M1 C m h x) a b
gconstructorSum = Iso (M1 C m g x) (M1 C m h x) (g x) (h x)
forall i (c :: Meta) (f :: * -> *) p j (d :: Meta) (g :: * -> *) q.
Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
_M1 Iso (M1 C m g x) (M1 C m h x) (g x) (h x)
-> Optic A_Prism NoIx (g x) (h x) a b
-> Prism (M1 C m g x) (M1 C m h x) a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx (g x) (h x) a b
forall (g :: * -> *) (h :: * -> *) a b x.
GConstructorTuple g h a b =>
Prism (g x) (h x) a b
gconstructorTuple

class GConstructorTuple g h a b | g -> a
                                , h -> b
                                , g b -> h
                                , h a -> g where
  gconstructorTuple :: Prism (g x) (h x) a b

-- Fon uncluttering types in below instances a bit.
type F m a = M1 S m (Rec0 a)

instance {-# OVERLAPPABLE #-}
  ( Dysfunctional () () g h a b
  , TypeError
    ('Text "Generic based access supports constructors" ':$$:
     'Text "containing up to 5 fields. Please generate" ':$$:
     'Text "PrismS with Template Haskell if you need more.")
  ) => GConstructorTuple g h a b where
  gconstructorTuple :: Prism (g x) (h x) a b
gconstructorTuple = [Char] -> Prism (g x) (h x) a b
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

instance
  ( a ~ ()
  , b ~ ()
  ) => GConstructorTuple U1 U1 a b where
  gconstructorTuple :: Prism (U1 x) (U1 x) a b
gconstructorTuple = Optic An_Iso NoIx (U1 x) (U1 x) () ()
-> Optic A_Prism NoIx (U1 x) (U1 x) () ()
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx (U1 x) (U1 x) () ()
forall p q. Iso (U1 p) (U1 q) () ()
_U1
  {-# INLINE gconstructorTuple #-}

instance
  ( r ~ a
  , s ~ b
  ) => GConstructorTuple (F m a) (F m b) r s where
  gconstructorTuple :: Prism (F m a x) (F m b x) r s
gconstructorTuple = Optic An_Iso NoIx (F m a x) (F m b x) r s
-> Prism (F m a x) (F m b x) r s
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx (F m a x) (F m b x) r s
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
  {-# INLINE gconstructorTuple #-}

instance
  ( r ~ (a1, a2)
  , s ~ (b1, b2)
  ) => GConstructorTuple
         (F m1 a1 :*: F m2 a2)
         (F m1 b1 :*: F m2 b2) r s where
  gconstructorTuple :: Prism
  ((:*:) (F m1 a1) (F m2 a2) x) ((:*:) (F m1 b1) (F m2 b2) x) r s
gconstructorTuple = Optic
  An_Iso
  NoIx
  ((:*:) (F m1 a1) (F m2 a2) x)
  ((:*:) (F m1 b1) (F m2 b2) x)
  (a1, a2)
  (b1, b2)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1) (F m2 a2) x)
     ((:*:) (F m1 b1) (F m2 b2) x)
     (a1, a2)
     (b1, b2)
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic (Optic
   An_Iso
   NoIx
   ((:*:) (F m1 a1) (F m2 a2) x)
   ((:*:) (F m1 b1) (F m2 b2) x)
   (a1, a2)
   (b1, b2)
 -> Optic
      A_Prism
      NoIx
      ((:*:) (F m1 a1) (F m2 a2) x)
      ((:*:) (F m1 b1) (F m2 b2) x)
      (a1, a2)
      (b1, b2))
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1) (F m2 a2) x)
     ((:*:) (F m1 b1) (F m2 b2) x)
     (a1, a2)
     (b1, b2)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1) (F m2 a2) x)
     ((:*:) (F m1 b1) (F m2 b2) x)
     (a1, a2)
     (b1, b2)
forall a b. (a -> b) -> a -> b
$ ((:*:) (F m1 a1) (F m2 a2) x -> (a1, a2))
-> ((b1, b2) -> (:*:) (F m1 b1) (F m2 b2) x)
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1) (F m2 a2) x)
     ((:*:) (F m1 b1) (F m2 b2) x)
     (a1, a2)
     (b1, b2)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(M1 (K1 a1
a1) :*: M1 (K1 a2
a2)) -> (a1
a1, a2
a2))
    (\(b1
b1, b2
b2) -> K1 R b1 x -> M1 S m1 (K1 R b1) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b1 -> K1 R b1 x
forall k i c (p :: k). c -> K1 i c p
K1 b1
b1) M1 S m1 (K1 R b1) x
-> M1 S m2 (K1 R b2) x -> (:*:) (F m1 b1) (F m2 b2) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b2 x -> M1 S m2 (K1 R b2) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b2 -> K1 R b2 x
forall k i c (p :: k). c -> K1 i c p
K1 b2
b2))
  {-# INLINE gconstructorTuple #-}

-- | Only for a derived balanced representation.
instance
  ( r ~ (a1, a2, a3)
  , s ~ (b1, b2, b3)
  ) => GConstructorTuple
         (F m1 a1 :*: F m2 a2 :*: F m3 a3)
         (F m1 b1 :*: F m2 b2 :*: F m3 b3) r s where
  gconstructorTuple :: Prism
  ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
  ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
  r
  s
gconstructorTuple = Optic
  An_Iso
  NoIx
  ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
  ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
  (a1, a2, a3)
  (b1, b2, b3)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
     ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
     (a1, a2, a3)
     (b1, b2, b3)
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic (Optic
   An_Iso
   NoIx
   ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
   ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
   (a1, a2, a3)
   (b1, b2, b3)
 -> Optic
      A_Prism
      NoIx
      ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
      ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
      (a1, a2, a3)
      (b1, b2, b3))
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
     ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
     (a1, a2, a3)
     (b1, b2, b3)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
     ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
     (a1, a2, a3)
     (b1, b2, b3)
forall a b. (a -> b) -> a -> b
$ ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x -> (a1, a2, a3))
-> ((b1, b2, b3) -> (:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1) (F m2 a2 :*: F m3 a3) x)
     ((:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x)
     (a1, a2, a3)
     (b1, b2, b3)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(M1 (K1 a1
a1) :*: M1 (K1 a2
a2) :*: M1 (K1 a3
a3)) -> (a1
a1, a2
a2, a3
a3))
    (\(b1
b1, b2
b2, b3
b3) -> K1 R b1 x -> M1 S m1 (K1 R b1) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b1 -> K1 R b1 x
forall k i c (p :: k). c -> K1 i c p
K1 b1
b1) M1 S m1 (K1 R b1) x
-> (:*:) (F m2 b2) (F m3 b3) x
-> (:*:) (F m1 b1) (F m2 b2 :*: F m3 b3) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b2 x -> M1 S m2 (K1 R b2) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b2 -> K1 R b2 x
forall k i c (p :: k). c -> K1 i c p
K1 b2
b2) M1 S m2 (K1 R b2) x
-> M1 S m3 (K1 R b3) x -> (:*:) (F m2 b2) (F m3 b3) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b3 x -> M1 S m3 (K1 R b3) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b3 -> K1 R b3 x
forall k i c (p :: k). c -> K1 i c p
K1 b3
b3))
  {-# INLINE gconstructorTuple #-}

-- | Only for a derived balanced representation.
instance
  ( r ~ (a1, a2, a3, a4)
  , s ~ (b1, b2, b3, b4)
  ) => GConstructorTuple
         ((F m1 a1 :*: F m2 a2) :*: (F m3 a3 :*: F m4 a4))
         ((F m1 b1 :*: F m2 b2) :*: (F m3 b3 :*: F m4 b4)) r s where
  gconstructorTuple :: Prism
  ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
  ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
  r
  s
gconstructorTuple = Optic
  An_Iso
  NoIx
  ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
  ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
  (a1, a2, a3, a4)
  (b1, b2, b3, b4)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
     (a1, a2, a3, a4)
     (b1, b2, b3, b4)
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic (Optic
   An_Iso
   NoIx
   ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
   ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
   (a1, a2, a3, a4)
   (b1, b2, b3, b4)
 -> Optic
      A_Prism
      NoIx
      ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
      ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
      (a1, a2, a3, a4)
      (b1, b2, b3, b4))
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
     (a1, a2, a3, a4)
     (b1, b2, b3, b4)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
     (a1, a2, a3, a4)
     (b1, b2, b3, b4)
forall a b. (a -> b) -> a -> b
$ ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x
 -> (a1, a2, a3, a4))
-> ((b1, b2, b3, b4)
    -> (:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: F m4 a4) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x)
     (a1, a2, a3, a4)
     (b1, b2, b3, b4)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\((M1 (K1 a1
a1) :*: M1 (K1 a2
a2)) :*: (M1 (K1 a3
a3) :*: M1 (K1 a4
a4))) -> (a1
a1, a2
a2, a3
a3, a4
a4))
    (\(b1
b1, b2
b2, b3
b3, b4
b4) -> (K1 R b1 x -> M1 S m1 (K1 R b1) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b1 -> K1 R b1 x
forall k i c (p :: k). c -> K1 i c p
K1 b1
b1) M1 S m1 (K1 R b1) x
-> M1 S m2 (K1 R b2) x -> (:*:) (F m1 b1) (F m2 b2) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b2 x -> M1 S m2 (K1 R b2) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b2 -> K1 R b2 x
forall k i c (p :: k). c -> K1 i c p
K1 b2
b2)) (:*:) (F m1 b1) (F m2 b2) x
-> (:*:) (F m3 b3) (F m4 b4) x
-> (:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: F m4 b4) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (K1 R b3 x -> M1 S m3 (K1 R b3) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b3 -> K1 R b3 x
forall k i c (p :: k). c -> K1 i c p
K1 b3
b3) M1 S m3 (K1 R b3) x
-> M1 S m4 (K1 R b4) x -> (:*:) (F m3 b3) (F m4 b4) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b4 x -> M1 S m4 (K1 R b4) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b4 -> K1 R b4 x
forall k i c (p :: k). c -> K1 i c p
K1 b4
b4)))
  {-# INLINE gconstructorTuple #-}

-- | Only for a derived balanced representation.
instance
  ( r ~ (a1, a2, a3, a4, a5)
  , s ~ (b1, b2, b3, b4, b5)
  ) => GConstructorTuple
         ((F m1 a1 :*: F m2 a2) :*: (F m3 a3 :*: F m4 a4 :*: F m5 a5))
         ((F m1 b1 :*: F m2 b2) :*: (F m3 b3 :*: F m4 b4 :*: F m5 b5)) r s where
  gconstructorTuple :: Prism
  ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
  ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
  r
  s
gconstructorTuple = Optic
  An_Iso
  NoIx
  ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
  ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
  (a1, a2, a3, a4, a5)
  (b1, b2, b3, b4, b5)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
     (a1, a2, a3, a4, a5)
     (b1, b2, b3, b4, b5)
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic (Optic
   An_Iso
   NoIx
   ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
   ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
   (a1, a2, a3, a4, a5)
   (b1, b2, b3, b4, b5)
 -> Optic
      A_Prism
      NoIx
      ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
      ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
      (a1, a2, a3, a4, a5)
      (b1, b2, b3, b4, b5))
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
     (a1, a2, a3, a4, a5)
     (b1, b2, b3, b4, b5)
-> Optic
     A_Prism
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
     (a1, a2, a3, a4, a5)
     (b1, b2, b3, b4, b5)
forall a b. (a -> b) -> a -> b
$ ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x
 -> (a1, a2, a3, a4, a5))
-> ((b1, b2, b3, b4, b5)
    -> (:*:)
         (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
-> Optic
     An_Iso
     NoIx
     ((:*:) (F m1 a1 :*: F m2 a2) (F m3 a3 :*: (F m4 a4 :*: F m5 a5)) x)
     ((:*:) (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x)
     (a1, a2, a3, a4, a5)
     (b1, b2, b3, b4, b5)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\((M1 (K1 a1
a1) :*: M1 (K1 a2
a2)) :*: (M1 (K1 a3
a3) :*: M1 (K1 a4
a4) :*: M1 (K1 a5
a5))) ->
       (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5))
    (\(b1
b1, b2
b2, b3
b3, b4
b4, b5
b5) ->
       (K1 R b1 x -> M1 S m1 (K1 R b1) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b1 -> K1 R b1 x
forall k i c (p :: k). c -> K1 i c p
K1 b1
b1) M1 S m1 (K1 R b1) x
-> M1 S m2 (K1 R b2) x -> (:*:) (F m1 b1) (F m2 b2) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b2 x -> M1 S m2 (K1 R b2) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b2 -> K1 R b2 x
forall k i c (p :: k). c -> K1 i c p
K1 b2
b2)) (:*:) (F m1 b1) (F m2 b2) x
-> (:*:) (F m3 b3) (F m4 b4 :*: F m5 b5) x
-> (:*:)
     (F m1 b1 :*: F m2 b2) (F m3 b3 :*: (F m4 b4 :*: F m5 b5)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (K1 R b3 x -> M1 S m3 (K1 R b3) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b3 -> K1 R b3 x
forall k i c (p :: k). c -> K1 i c p
K1 b3
b3) M1 S m3 (K1 R b3) x
-> (:*:) (F m4 b4) (F m5 b5) x
-> (:*:) (F m3 b3) (F m4 b4 :*: F m5 b5) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b4 x -> M1 S m4 (K1 R b4) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b4 -> K1 R b4 x
forall k i c (p :: k). c -> K1 i c p
K1 b4
b4) M1 S m4 (K1 R b4) x
-> M1 S m5 (K1 R b5) x -> (:*:) (F m4 b4) (F m5 b5) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: K1 R b5 x -> M1 S m5 (K1 R b5) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b5 -> K1 R b5 x
forall k i c (p :: k). c -> K1 i c p
K1 b5
b5)))
  {-# INLINE gconstructorTuple #-}

----------------------------------------
-- Types

class GPlateImpl g a where
  gplateImpl :: TraversalVL' (g x) a

instance GPlateImpl f a => GPlateImpl (M1 i c f) a where
  gplateImpl :: (a -> f a) -> M1 i c f x -> f (M1 i c f x)
gplateImpl a -> f a
f (M1 f x
x) = f x -> M1 i c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> M1 i c f x) -> f (f x) -> f (M1 i c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> f x -> f (f x)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f f x
x

instance (GPlateImpl f a, GPlateImpl g a) => GPlateImpl (f :+: g) a where
  gplateImpl :: (a -> f a) -> (:+:) f g x -> f ((:+:) f g x)
gplateImpl a -> f a
f (L1 f x
x) = f x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f x -> (:+:) f g x) -> f (f x) -> f ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> f x -> f (f x)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f f x
x
  gplateImpl a -> f a
f (R1 g x
x) = g x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g x -> (:+:) f g x) -> f (g x) -> f ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> g x -> f (g x)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f g x
x

instance (GPlateImpl f a, GPlateImpl g a) => GPlateImpl (f :*: g) a where
  gplateImpl :: (a -> f a) -> (:*:) f g x -> f ((:*:) f g x)
gplateImpl a -> f a
f (f x
x :*: g x
y) = f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f x -> g x -> (:*:) f g x) -> f (f x) -> f (g x -> (:*:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> f x -> f (f x)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f f x
x f (g x -> (:*:) f g x) -> f (g x) -> f ((:*:) f g x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f a) -> g x -> f (g x)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f g x
y
  {-# INLINE gplateImpl #-}

-- | Matching type.
instance {-# OVERLAPPING #-} GPlateImpl (K1 i a) a where
  gplateImpl :: (a -> f a) -> K1 i a x -> f (K1 i a x)
gplateImpl a -> f a
f (K1 a
a) = a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a x) -> f a -> f (K1 i a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a

-- | Recurse into the inner type if it has a 'Generic' instance.
instance GPlateInner (Defined (Rep b)) b a => GPlateImpl (K1 i b) a where
  gplateImpl :: (a -> f a) -> K1 i b x -> f (K1 i b x)
gplateImpl a -> f a
f (K1 b
b) = b -> K1 i b x
forall k i c (p :: k). c -> K1 i c p
K1 (b -> K1 i b x) -> f b -> f (K1 i b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> b -> f b
forall (repDefined :: Bool) s a.
GPlateInner repDefined s a =>
TraversalVL' s a
gplateInner @(Defined (Rep b)) a -> f a
f b
b

instance GPlateImpl U1 a where
  gplateImpl :: (a -> f a) -> U1 x -> f (U1 x)
gplateImpl a -> f a
_ = U1 x -> f (U1 x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance GPlateImpl V1 a where
  gplateImpl :: (a -> f a) -> V1 x -> f (V1 x)
gplateImpl a -> f a
_ = \case {}

instance GPlateImpl (URec b) a where
  gplateImpl :: (a -> f a) -> URec b x -> f (URec b x)
gplateImpl a -> f a
_ = URec b x -> f (URec b x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

class GPlateInner (repDefined :: Bool) s a where
  gplateInner :: TraversalVL' s a

instance (Generic s, GPlateImpl (Rep s) a) => GPlateInner 'True s a where
  gplateInner :: (a -> f a) -> s -> f s
gplateInner a -> f a
f = (Rep s Any -> s) -> f (Rep s Any) -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep s Any -> s
forall a x. Generic a => Rep a x -> a
to (f (Rep s Any) -> f s) -> (s -> f (Rep s Any)) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> Rep s Any -> f (Rep s Any)
forall (g :: * -> *) a x. GPlateImpl g a => TraversalVL' (g x) a
gplateImpl a -> f a
f (Rep s Any -> f (Rep s Any))
-> (s -> Rep s Any) -> s -> f (Rep s Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from

instance {-# INCOHERENT #-} GPlateInner repNotDefined s a where
  gplateInner :: (a -> f a) -> s -> f s
gplateInner a -> f a
_ = s -> f s
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- $setup
-- >>> import Optics.Core