{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-missing-methods #-}

-- | 
-- This module provides the general mechanism for defining field and branch
-- aliases for algebraic datatypes.
-- 
-- Aliases can be defined for multiple contexts (json serialization, orms...).
-- Each of those contexts is termed a Rubric, basically a marker datakind used
-- to namespace the aliases.
-- 
-- This module should only be imported if you want to define your own adapter
-- package for some new 'Rubric'. See "ByOtherNamesH.Aeson" for a concrete
-- example.
-- 
-- This module provides a more versatile, but also more verbose, version of the
-- functionality provided by "ByOtherNames". If you plan to use both
-- "ByOtherNames" and "ByOtherNamesH", import this module qualified to avoid
-- name collisions:
--
-- > import qualified ByOthernamesH as H
--
module ByOtherNamesH (
  -- * Aliases 
  Aliases,
  AliasList,
  aliasListBegin,
  alias,
  aliasListEnd,
  SlotList,
  singleSlot,
  slot,
  slotListEnd,
  -- * Rubrics
  Rubric (..),
  Aliased (..),
  -- * Generic helpers
  GRecord(..),
  -- * Re-exports
  Symbol,
) where

import Control.Applicative
import Data.Kind
import Data.Proxy
import GHC.Generics
import GHC.TypeLits
import Data.Functor.Identity

-- | This datatype carries the field/branch aliases, along with a value wrapped in @h@
-- for each field in the original datatype. 
--
-- It matches the shape of the generic 'Rep'.
type Aliases :: (Type -> Type) -> Type -> (Type -> Type) -> Type
data Aliases rep a (h :: Type -> Type) where
  Field :: 
    KnownSymbol fieldName => 
    a ->
    h v -> 
    Aliases (S1 ('MetaSel ('Just fieldName) unpackedness strictness laziness) (Rec0 v)) a h
  Branch :: 
    KnownSymbol branchName => 
    a -> 
    BranchFields v h ->
    Aliases (C1 ('MetaCons branchName fixity sels) v) a h
  EmptyBranch ::
    KnownSymbol branchName => 
    a -> 
    Aliases (C1 ('MetaCons branchName fixity sels) U1) a h
  FieldTree ::
    Aliases left a h ->
    Aliases right a h ->
    Aliases (left :*: right) a h
  BranchTree ::
    Aliases left a h ->
    Aliases right a h ->
    Aliases (left :+: right) a h
  -- | We force the sum to contain at least two branches.
  Sum ::
    Aliases (left :+: right) a h ->
    Aliases (D1 x (left :+: right)) a h
  Record ::
    Aliases fields a h ->
    Aliases (D1 x (C1 y fields)) a h

type BranchFields :: (Type -> Type) -> (Type -> Type) -> Type
data BranchFields rep h where
  BranchFieldTree :: 
    BranchFields left h ->  
    BranchFields right h -> 
    BranchFields (left :*: right) h
  BranchField ::
    h v ->
    BranchFields (S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v)) h

-- | A list of slots associated an alias. Indexed by the types of each slot
-- and a type constructor that wraps each slot value.
-- 
-- For records, each field alias will have one and only one slot: the
-- corresponding record field. See 'singleSlot'.
-- 
-- For sum types, each branch alias might have zero or more slots, depending on
-- the structure of the datatype. See 'slot' and 'slotListEnd'.
data SlotList :: [Type] -> (Type -> Type) -> Type where
  EmptyTuple  :: SlotList '[] h
  ConsTuple :: h x -> SlotList xs h -> SlotList (x ': xs) h

-- | An intermediate helper datatype for specifying the aliases.  
--
-- Indexed by a list of names accompanied by field types.
--
-- See 'aliasListBegin', 'alias' and 'aliasListEnd'.
type AliasList :: [(Symbol, [Type])] -> Type -> (Type -> Type) -> Type
data AliasList (names_slots :: [(Symbol, [Type])]) a (h :: Type -> Type) where
  EmptyAliasList :: AliasList '[] a h
  ConsAliasList :: 
    Proxy name -> 
    a -> 
    SlotList slots h -> 
    AliasList prev a h -> AliasList ('(name,slots) : prev) a h

type ToAliases :: [(Symbol, [Type])] -> (Type -> Type) -> [(Symbol, [Type])] -> Constraint
-- | The second functional dependency is needed for type inference to work. 
class ToAliases before rep after | before rep -> after, after rep -> before where
  parseAliasTree :: AliasList before a h -> (Aliases rep a h, AliasList after a h)

type ToBranchFields :: [Type] -> (Type -> Type) -> [Type] -> Constraint 
-- | The second functional dependency is needed for type inference to work. 
class ToBranchFields before rep after | before rep -> after, after rep -> before where
  parseBranchFields :: SlotList before h -> (BranchFields rep h, SlotList after h)

instance (ToBranchFields before left middle, 
          ToBranchFields middle right end) 
  =>  ToBranchFields before (left :*: right) end where
  parseBranchFields :: forall (h :: * -> *).
SlotList before h
-> (BranchFields (left :*: right) h, SlotList end h)
parseBranchFields SlotList before h
t0 = do
    let (BranchFields left h
leftResult, SlotList middle h
leftLeftover) = forall (before :: [*]) (rep :: * -> *) (after :: [*])
       (h :: * -> *).
ToBranchFields before rep after =>
SlotList before h -> (BranchFields rep h, SlotList after h)
parseBranchFields @before SlotList before h
t0
        (BranchFields right h
rightResult, SlotList end h
rightLeftover) = forall (before :: [*]) (rep :: * -> *) (after :: [*])
       (h :: * -> *).
ToBranchFields before rep after =>
SlotList before h -> (BranchFields rep h, SlotList after h)
parseBranchFields @middle SlotList middle h
leftLeftover
    (forall (x :: * -> *) (h :: * -> *) (xs :: * -> *).
BranchFields x h -> BranchFields xs h -> BranchFields (x :*: xs) h
BranchFieldTree BranchFields left h
leftResult BranchFields right h
rightResult, SlotList end h
rightLeftover)

instance ToBranchFields (v ': vs) (S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v)) vs where
  parseBranchFields :: forall (h :: * -> *).
SlotList (v : vs) h
-> (BranchFields
      (S1 ('MetaSel 'Nothing unpackedness strictness laziness) (Rec0 v))
      h,
    SlotList vs h)
parseBranchFields (ConsTuple h x
hv SlotList xs h
rest) = (forall (h :: * -> *) x (xs :: SourceUnpackedness)
       (prev :: SourceStrictness) (sels :: DecidedStrictness).
h x
-> BranchFields (S1 ('MetaSel 'Nothing xs prev sels) (Rec0 x)) h
BranchField h x
hv, SlotList xs h
rest) 

instance ToAliases before tree '[] => ToAliases before (D1 x (C1 y tree)) '[] where
  parseAliasTree :: forall a (h :: * -> *).
AliasList before a h
-> (Aliases (D1 x (C1 y tree)) a h, AliasList '[] a h)
parseAliasTree AliasList before a h
as =
    let (Aliases tree a h
aliases', AliasList '[] a h
as') = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree AliasList before a h
as
     in (forall (x :: * -> *) a (h :: * -> *) (xs :: Meta) (prev :: Meta).
Aliases x a h -> Aliases (D1 xs (C1 prev x)) a h
Record Aliases tree a h
aliases', AliasList '[] a h
as')

instance (ToAliases before left middle, ToAliases middle right end) 
  => ToAliases before (left :*: right) end where
  parseAliasTree :: forall a (h :: * -> *).
AliasList before a h
-> (Aliases (left :*: right) a h, AliasList end a h)
parseAliasTree AliasList before a h
as =
    let (Aliases left a h
left, AliasList middle a h
middle) = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree @before AliasList before a h
as
        (Aliases right a h
right, AliasList end a h
end) = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree @middle AliasList middle a h
middle
     in (forall (x :: * -> *) a (h :: * -> *) (xs :: * -> *).
Aliases x a h -> Aliases xs a h -> Aliases (x :*: xs) a h
FieldTree Aliases left a h
left Aliases right a h
right, AliasList end a h
end)

instance  KnownSymbol name 
  => ToAliases ('(name, '[v]) : rest) (S1 ('MetaSel (Just name) x y z) (Rec0 v)) rest where
  parseAliasTree :: forall a (h :: * -> *).
AliasList ('(name, '[v]) : rest) a h
-> (Aliases (S1 ('MetaSel ('Just name) x y z) (Rec0 v)) a h,
    AliasList rest a h)
parseAliasTree (ConsAliasList Proxy name
_ a
a (ConsTuple h x
hv SlotList xs h
EmptyTuple) AliasList prev a h
rest) = (forall (x :: Symbol) a (h :: * -> *) xs
       (prev :: SourceUnpackedness) (sels :: SourceStrictness)
       (laziness :: DecidedStrictness).
KnownSymbol x =>
a
-> h xs
-> Aliases
     (S1 ('MetaSel ('Just x) prev sels laziness) (Rec0 xs)) a h
Field a
a h x
hv, AliasList prev a h
rest)

instance ToAliases before (left :+: right) '[] => ToAliases before (D1 x (left :+: right)) '[] where
  parseAliasTree :: forall a (h :: * -> *).
AliasList before a h
-> (Aliases (D1 x (left :+: right)) a h, AliasList '[] a h)
parseAliasTree AliasList before a h
as =
    let (Aliases (left :+: right) a h
aliases', AliasList '[] a h
as') = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree AliasList before a h
as
     in (forall (x :: * -> *) (xs :: * -> *) a (h :: * -> *) (prev :: Meta).
Aliases (x :+: xs) a h -> Aliases (D1 prev (x :+: xs)) a h
Sum Aliases (left :+: right) a h
aliases', AliasList '[] a h
as')

instance (ToAliases before left middle, ToAliases middle right end) => ToAliases before (left :+: right) end where
  parseAliasTree :: forall a (h :: * -> *).
AliasList before a h
-> (Aliases (left :+: right) a h, AliasList end a h)
parseAliasTree AliasList before a h
as =
    let (Aliases left a h
left, AliasList middle a h
middle) = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree @before AliasList before a h
as
        (Aliases right a h
right, AliasList end a h
end) = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree @middle AliasList middle a h
middle
     in (forall (x :: * -> *) a (h :: * -> *) (xs :: * -> *).
Aliases x a h -> Aliases xs a h -> Aliases (x :+: xs) a h
BranchTree Aliases left a h
left Aliases right a h
right, AliasList end a h
end)

instance (KnownSymbol name,
          ToBranchFields vs (S1 u v) '[]) =>
  ToAliases ('(name, vs) : rest) (C1 ('MetaCons name fixity False) (S1 u v)) rest where
    parseAliasTree :: forall a (h :: * -> *).
AliasList ('(name, vs) : rest) a h
-> (Aliases (C1 ('MetaCons name fixity 'False) (S1 u v)) a h,
    AliasList rest a h)
parseAliasTree (ConsAliasList Proxy name
_ a
a SlotList slots h
branchFields AliasList prev a h
rest) = do
        let (BranchFields (S1 u v) h
theBranchFields, SlotList '[] h
EmptyTuple) = forall (before :: [*]) (rep :: * -> *) (after :: [*])
       (h :: * -> *).
ToBranchFields before rep after =>
SlotList before h -> (BranchFields rep h, SlotList after h)
parseBranchFields @vs SlotList slots h
branchFields
        (forall (x :: Symbol) a (xs :: * -> *) (h :: * -> *)
       (prev :: FixityI) (sels :: Bool).
KnownSymbol x =>
a
-> BranchFields xs h -> Aliases (C1 ('MetaCons x prev sels) xs) a h
Branch a
a BranchFields (S1 u v) h
theBranchFields, AliasList prev a h
rest)

instance (KnownSymbol name,
          ToBranchFields vs (left :*: right) '[]) =>
  ToAliases ('(name, vs) : rest) (C1 ('MetaCons name fixity False) (left :*: right)) rest where
    parseAliasTree :: forall a (h :: * -> *).
AliasList ('(name, vs) : rest) a h
-> (Aliases
      (C1 ('MetaCons name fixity 'False) (left :*: right)) a h,
    AliasList rest a h)
parseAliasTree (ConsAliasList Proxy name
_ a
a SlotList slots h
branchFields AliasList prev a h
rest) = do
        let (BranchFields (left :*: right) h
theBranchFields, SlotList '[] h
EmptyTuple) = forall (before :: [*]) (rep :: * -> *) (after :: [*])
       (h :: * -> *).
ToBranchFields before rep after =>
SlotList before h -> (BranchFields rep h, SlotList after h)
parseBranchFields @vs SlotList slots h
branchFields
        (forall (x :: Symbol) a (xs :: * -> *) (h :: * -> *)
       (prev :: FixityI) (sels :: Bool).
KnownSymbol x =>
a
-> BranchFields xs h -> Aliases (C1 ('MetaCons x prev sels) xs) a h
Branch a
a BranchFields (left :*: right) h
theBranchFields, AliasList prev a h
rest)

instance KnownSymbol name =>
  ToAliases ('(name, '[]) : rest) (C1 ('MetaCons name fixity False) U1) rest where
    parseAliasTree :: forall a (h :: * -> *).
AliasList ('(name, '[]) : rest) a h
-> (Aliases (C1 ('MetaCons name fixity 'False) U1) a h,
    AliasList rest a h)
parseAliasTree (ConsAliasList Proxy name
_ a
a  SlotList slots h
EmptyTuple AliasList prev a h
rest) = do
        (forall (x :: Symbol) a (xs :: FixityI) (prev :: Bool)
       (h :: * -> *).
KnownSymbol x =>
a -> Aliases (C1 ('MetaCons x xs prev) U1) a h
EmptyBranch a
a, AliasList prev a h
rest)

--
--

type Aliased :: k -> Type -> Constraint
class (Rubric k, Generic r) => Aliased k r where
  aliases :: Aliases (Rep r) (AliasType k) (WrapperType k)

type Rubric :: k -> Constraint
class Rubric k where
  type AliasType k :: Type
  type WrapperType k :: Type -> Type

aliasListBegin :: forall names_slots a h rep. (ToAliases names_slots rep '[]) 
  => AliasList names_slots a h -- ^ indexed by a list of alias names / slots types
  -> Aliases rep a h -- ^ indexed by a generic 'Rep' 
aliasListBegin :: forall (names_slots :: [(Symbol, [*])]) a (h :: * -> *)
       (rep :: * -> *).
ToAliases names_slots rep '[] =>
AliasList names_slots a h -> Aliases rep a h
aliasListBegin AliasList names_slots a h
names =
  let (Aliases rep a h
aliases, AliasList '[] a h
EmptyAliasList) = forall (before :: [(Symbol, [*])]) (rep :: * -> *)
       (after :: [(Symbol, [*])]) a (h :: * -> *).
ToAliases before rep after =>
AliasList before a h -> (Aliases rep a h, AliasList after a h)
parseAliasTree @names_slots @rep AliasList names_slots a h
names
   in Aliases rep a h
aliases

-- | The empty 'AliasList'.
aliasListEnd :: AliasList '[] a h
aliasListEnd :: forall a (h :: * -> *). AliasList '[] a h
aliasListEnd = forall a (h :: * -> *). AliasList '[] a h
EmptyAliasList

alias :: forall name slots a h names_slots. 
  -- | The alias value
  a -> 
  -- | \"wrapped\" values for each slot of the alias
  SlotList slots h ->
  AliasList names_slots a h -> 
  AliasList ('(name, slots) : names_slots) a h
alias :: forall (name :: Symbol) (slots :: [*]) a (h :: * -> *)
       (names_slots :: [(Symbol, [*])]).
a
-> SlotList slots h
-> AliasList names_slots a h
-> AliasList ('(name, slots) : names_slots) a h
alias = forall (x :: Symbol) a (xs :: [*]) (h :: * -> *)
       (prev :: [(Symbol, [*])]).
Proxy x
-> a
-> SlotList xs h
-> AliasList prev a h
-> AliasList ('(x, xs) : prev) a h
ConsAliasList (forall {k} (t :: k). Proxy t
Proxy @name)

-- | The empty 'SlotList'.
slotListEnd :: SlotList '[] h 
slotListEnd :: forall (h :: * -> *). SlotList '[] h
slotListEnd = forall (h :: * -> *). SlotList '[] h
EmptyTuple

singleSlot :: h v -> SlotList '[v] h 
singleSlot :: forall (h :: * -> *) v. h v -> SlotList '[v] h
singleSlot h v
hv = forall (h :: * -> *) x (xs :: [*]).
h x -> SlotList xs h -> SlotList (x : xs) h
ConsTuple h v
hv forall (h :: * -> *). SlotList '[] h
EmptyTuple

slot :: h v -> SlotList rest h  -> SlotList (v ': rest) h
slot :: forall (h :: * -> *) x (xs :: [*]).
h x -> SlotList xs h -> SlotList (x : xs) h
slot h v
hv = forall (h :: * -> *) x (xs :: [*]).
h x -> SlotList xs h -> SlotList (x : xs) h
ConsTuple h v
hv 

class GRecord rep where
  -- | Builds a parser for the entire generic 'Rep' out of parsers for each field.
  gToRecord ::
    Applicative g =>
    -- | Field aliases.
    Aliases rep a h ->
    (forall v. a -> h v -> g v) ->
    g (rep z)
  gFromRecord ::
    -- | Record representation.
    rep z ->
    Aliases rep String Identity
  gBiliftA2RecordAliases ::
    -- | Combine aliases
    (a1 -> a2 -> ar) -> 
    -- | Combine slots
    (forall v. h1 v -> h2 v -> hr v) ->
    Aliases rep a1 h1 ->
    Aliases rep a2 h2 ->
    Aliases rep ar hr

instance GRecord prod => GRecord (D1 x (C1 y prod)) where
  gToRecord :: forall (g :: * -> *) a (h :: * -> *) z.
Applicative g =>
Aliases (D1 x (C1 y prod)) a h
-> (forall v. a -> h v -> g v) -> g (D1 x (C1 y prod) z)
gToRecord (Record Aliases fields a h
as) forall v. a -> h v -> g v
parseField =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rep :: * -> *) (g :: * -> *) a (h :: * -> *) z.
(GRecord rep, Applicative g) =>
Aliases rep a h -> (forall v. a -> h v -> g v) -> g (rep z)
gToRecord Aliases fields a h
as forall v. a -> h v -> g v
parseField
  gFromRecord :: forall z.
D1 x (C1 y prod) z -> Aliases (D1 x (C1 y prod)) String Identity
gFromRecord (M1 (M1 prod z
prod)) =
    forall (x :: * -> *) a (h :: * -> *) (xs :: Meta) (prev :: Meta).
Aliases x a h -> Aliases (D1 xs (C1 prev x)) a h
Record (forall (rep :: * -> *) z.
GRecord rep =>
rep z -> Aliases rep String Identity
gFromRecord prod z
prod)
  gBiliftA2RecordAliases :: forall a1 a2 ar (h1 :: * -> *) (h2 :: * -> *) (hr :: * -> *).
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases (D1 x (C1 y prod)) a1 h1
-> Aliases (D1 x (C1 y prod)) a2 h2
-> Aliases (D1 x (C1 y prod)) ar hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g (Record Aliases fields a1 h1
a1) (Record Aliases fields a2 h2
a2) =
    forall (x :: * -> *) a (h :: * -> *) (xs :: Meta) (prev :: Meta).
Aliases x a h -> Aliases (D1 xs (C1 prev x)) a h
Record (forall (rep :: * -> *) a1 a2 ar (h1 :: * -> *) (h2 :: * -> *)
       (hr :: * -> *).
GRecord rep =>
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases rep a1 h1
-> Aliases rep a2 h2
-> Aliases rep ar hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g Aliases fields a1 h1
a1 Aliases fields a2 h2
a2)

instance
  (GRecord left, GRecord right) =>
  GRecord (left :*: right)
  where
  gToRecord :: forall (g :: * -> *) a (h :: * -> *) z.
Applicative g =>
Aliases (left :*: right) a h
-> (forall v. a -> h v -> g v) -> g ((:*:) left right z)
gToRecord (FieldTree Aliases left a h
aleft Aliases right a h
aright) forall v. a -> h v -> g v
parseField =
    forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rep :: * -> *) (g :: * -> *) a (h :: * -> *) z.
(GRecord rep, Applicative g) =>
Aliases rep a h -> (forall v. a -> h v -> g v) -> g (rep z)
gToRecord Aliases left a h
aleft forall v. a -> h v -> g v
parseField forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (rep :: * -> *) (g :: * -> *) a (h :: * -> *) z.
(GRecord rep, Applicative g) =>
Aliases rep a h -> (forall v. a -> h v -> g v) -> g (rep z)
gToRecord Aliases right a h
aright forall v. a -> h v -> g v
parseField
  gFromRecord :: forall z.
(:*:) left right z -> Aliases (left :*: right) String Identity
gFromRecord (left z
left :*: right z
right) =
    forall (x :: * -> *) a (h :: * -> *) (xs :: * -> *).
Aliases x a h -> Aliases xs a h -> Aliases (x :*: xs) a h
FieldTree (forall (rep :: * -> *) z.
GRecord rep =>
rep z -> Aliases rep String Identity
gFromRecord left z
left) (forall (rep :: * -> *) z.
GRecord rep =>
rep z -> Aliases rep String Identity
gFromRecord right z
right)
  gBiliftA2RecordAliases :: forall a1 a2 ar (h1 :: * -> *) (h2 :: * -> *) (hr :: * -> *).
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases (left :*: right) a1 h1
-> Aliases (left :*: right) a2 h2
-> Aliases (left :*: right) ar hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g (FieldTree Aliases left a1 h1
left1 Aliases right a1 h1
right1) (FieldTree Aliases left a2 h2
left2 Aliases right a2 h2
right2) =
    forall (x :: * -> *) a (h :: * -> *) (xs :: * -> *).
Aliases x a h -> Aliases xs a h -> Aliases (x :*: xs) a h
FieldTree (forall (rep :: * -> *) a1 a2 ar (h1 :: * -> *) (h2 :: * -> *)
       (hr :: * -> *).
GRecord rep =>
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases rep a1 h1
-> Aliases rep a2 h2
-> Aliases rep ar hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g Aliases left a1 h1
left1 Aliases left a2 h2
left2) (forall (rep :: * -> *) a1 a2 ar (h1 :: * -> *) (h2 :: * -> *)
       (hr :: * -> *).
GRecord rep =>
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases rep a1 h1
-> Aliases rep a2 h2
-> Aliases rep ar hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g Aliases right a1 h1
right1 Aliases right a2 h2
right2)

instance KnownSymbol fieldName => GRecord (S1 ('MetaSel ('Just fieldName) unpackedness strictness laziness) (Rec0 v)) where
  gToRecord :: forall (g :: * -> *) a (h :: * -> *) z.
Applicative g =>
Aliases
  (S1
     ('MetaSel ('Just fieldName) unpackedness strictness laziness)
     (Rec0 v))
  a
  h
-> (forall v. a -> h v -> g v)
-> g (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v)
        z)
gToRecord (Field a
a h v
hv) forall v. a -> h v -> g v
parseField =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. a -> h v -> g v
parseField a
a h v
hv
  gFromRecord :: forall z.
S1
  ('MetaSel ('Just fieldName) unpackedness strictness laziness)
  (Rec0 v)
  z
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     String
     Identity
gFromRecord (M1 (K1 v
v)) = forall (x :: Symbol) a (h :: * -> *) xs
       (prev :: SourceUnpackedness) (sels :: SourceStrictness)
       (laziness :: DecidedStrictness).
KnownSymbol x =>
a
-> h xs
-> Aliases
     (S1 ('MetaSel ('Just x) prev sels laziness) (Rec0 xs)) a h
Field (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @fieldName)) (forall a. a -> Identity a
Identity v
v)
  gBiliftA2RecordAliases :: forall a1 a2 ar (h1 :: * -> *) (h2 :: * -> *) (hr :: * -> *).
(a1 -> a2 -> ar)
-> (forall v. h1 v -> h2 v -> hr v)
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     a1
     h1
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     a2
     h2
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     ar
     hr
gBiliftA2RecordAliases a1 -> a2 -> ar
f forall v. h1 v -> h2 v -> hr v
g (Field a1
a1 h1 v
h1) (Field a2
a2 h2 v
h2) =
    forall (x :: Symbol) a (h :: * -> *) xs
       (prev :: SourceUnpackedness) (sels :: SourceStrictness)
       (laziness :: DecidedStrictness).
KnownSymbol x =>
a
-> h xs
-> Aliases
     (S1 ('MetaSel ('Just x) prev sels laziness) (Rec0 xs)) a h
Field (a1 -> a2 -> ar
f a1
a1 a2
a2) (forall v. h1 v -> h2 v -> hr v
g h1 v
h1 h2 v
h2)