{-# 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 package 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`.
module ByOtherNames.Internal
  ( Aliases (..),
    zipAliasesWith,
    AliasList,
    aliasListBegin,
    alias,
    aliasListEnd,
    Aliased (aliases),
    Rubric (..),

    -- * Generic helpers
    GHasDatatypeName(..),
    GHasFieldNames (..),
    GRecord (..),
    GHasBranchNames (..),
    GSum (..),
    Slots (..),
    -- * Re-exports
    Symbol,
  )
where

import Control.Applicative
import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Kind
import Data.Proxy
import Data.Traversable.WithIndex
import GHC.Generics
import GHC.TypeLits

-- | This datatype carries the field aliases and matches the structure of the
--   generic Rep' shape.
type Aliases :: (Type -> Type) -> Type -> Type
data Aliases rep a where
  Field :: KnownSymbol fieldName => a -> Aliases (S1 ('MetaSel ('Just fieldName) unpackedness strictness laziness) v) a
  Branch :: KnownSymbol branchName => a -> Aliases (C1 ('MetaCons branchName fixity sels) v) a
  FieldTree ::
    Aliases left a ->
    Aliases right a ->
    Aliases (left :*: right) a
  BranchTree ::
    Aliases left a ->
    Aliases right a ->
    Aliases (left :+: right) a
  -- | We force the sum to contain at least two branches.
  Sum ::
    Aliases (left :+: right) a ->
    Aliases (D1 x (left :+: right)) a
  Record ::
    Aliases fields a ->
    Aliases (D1 x (C1 y fields)) a

zipAliasesWith :: (a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith :: (a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases rep a
a1 Aliases rep b
a2 = case (Aliases rep a
a1, Aliases rep b
a2) of
    (Field a
a, Field b
b) -> c
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     c
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (a -> b -> c
f a
a b
b)
    (Branch a
a, Branch b
b) -> c -> Aliases (C1 ('MetaCons branchName fixity sels) v) c
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a -> b -> c
f a
a b
b)
    (FieldTree Aliases left a
a1 Aliases right a
a2, FieldTree Aliases left b
b1 Aliases right b
b2) -> Aliases left c -> Aliases right c -> Aliases (left :*: right) c
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree ((a -> b -> c) -> Aliases left a -> Aliases left b -> Aliases left c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases left a
a1 Aliases left b
Aliases left b
b1) ((a -> b -> c)
-> Aliases right a -> Aliases right b -> Aliases right c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases right a
a2 Aliases right b
Aliases right b
b2)
    (BranchTree Aliases left a
a1 Aliases right a
a2, BranchTree Aliases left b
b1 Aliases right b
b2) -> Aliases left c -> Aliases right c -> Aliases (left :+: right) c
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree ((a -> b -> c) -> Aliases left a -> Aliases left b -> Aliases left c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases left a
a1 Aliases left b
Aliases left b
b1) ((a -> b -> c)
-> Aliases right a -> Aliases right b -> Aliases right c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases right a
a2 Aliases right b
Aliases right b
b2)
    (Sum Aliases (left :+: right) a
a, Sum Aliases (left :+: right) b
b) -> Aliases (left :+: right) c -> Aliases (D1 x (left :+: right)) c
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum ((a -> b -> c)
-> Aliases (left :+: right) a
-> Aliases (left :+: right) b
-> Aliases (left :+: right) c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases (left :+: right) a
a Aliases (left :+: right) b
Aliases (left :+: right) b
b)
    (Record Aliases fields a
a, Record Aliases fields b
b) -> Aliases fields c -> Aliases (D1 x (C1 y fields)) c
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record ((a -> b -> c)
-> Aliases fields a -> Aliases fields b -> Aliases fields c
forall a b c (rep :: * -> *).
(a -> b -> c) -> Aliases rep a -> Aliases rep b -> Aliases rep c
zipAliasesWith a -> b -> c
f Aliases fields a
a Aliases fields b
Aliases fields b
b)

instance Functor (Aliases rep) where
  fmap :: (a -> b) -> Aliases rep a -> Aliases rep b
fmap a -> b
f Aliases rep a
as = case Aliases rep a
as of
    Field a
a -> b
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     b
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (a -> b
f a
a)
    Branch a
a -> b -> Aliases (C1 ('MetaCons branchName fixity sels) v) b
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a -> b
f a
a)
    FieldTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :*: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree ((a -> b) -> Aliases left a -> Aliases left b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases left a
left) ((a -> b) -> Aliases right a -> Aliases right b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases right a
right)
    BranchTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :+: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree ((a -> b) -> Aliases left a -> Aliases left b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases left a
left) ((a -> b) -> Aliases right a -> Aliases right b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases right a
right)
    Sum Aliases (left :+: right) a
a -> Aliases (left :+: right) b -> Aliases (D1 x (left :+: right)) b
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum ((a -> b)
-> Aliases (left :+: right) a -> Aliases (left :+: right) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases (left :+: right) a
a)
    Record Aliases fields a
a -> Aliases fields b -> Aliases (D1 x (C1 y fields)) b
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record ((a -> b) -> Aliases fields a -> Aliases fields b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases fields a
a)

instance Foldable (Aliases rep) where
  foldMap :: (a -> m) -> Aliases rep a -> m
foldMap a -> m
f Aliases rep a
as = case Aliases rep a
as of
    Field a
a -> a -> m
f a
a
    Branch a
a -> a -> m
f a
a
    FieldTree Aliases left a
left Aliases right a
right -> (a -> m) -> Aliases left a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases left a
left m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Aliases right a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases right a
right
    BranchTree Aliases left a
left Aliases right a
right -> (a -> m) -> Aliases left a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases left a
left m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Aliases right a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases right a
right
    Sum Aliases (left :+: right) a
a -> (a -> m) -> Aliases (left :+: right) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases (left :+: right) a
a
    Record Aliases fields a
a -> (a -> m) -> Aliases fields a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases fields a
a

instance Traversable (Aliases rep) where
  traverse :: (a -> f b) -> Aliases rep a -> f (Aliases rep b)
traverse a -> f b
f Aliases rep a
as = case Aliases rep a
as of
    Field a
a -> b
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     b
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (b
 -> Aliases
      (S1
         ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
      b)
-> f b
-> f (Aliases
        (S1
           ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
        b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    Branch a
a -> b -> Aliases (C1 ('MetaCons branchName fixity sels) v) b
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (b -> Aliases (C1 ('MetaCons branchName fixity sels) v) b)
-> f b -> f (Aliases (C1 ('MetaCons branchName fixity sels) v) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    FieldTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :*: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree (Aliases left b -> Aliases right b -> Aliases (left :*: right) b)
-> f (Aliases left b)
-> f (Aliases right b -> Aliases (left :*: right) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Aliases left a -> f (Aliases left b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases left a
left f (Aliases right b -> Aliases (left :*: right) b)
-> f (Aliases right b) -> f (Aliases (left :*: right) b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Aliases right a -> f (Aliases right b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases right a
right
    BranchTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :+: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree (Aliases left b -> Aliases right b -> Aliases (left :+: right) b)
-> f (Aliases left b)
-> f (Aliases right b -> Aliases (left :+: right) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Aliases left a -> f (Aliases left b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases left a
left f (Aliases right b -> Aliases (left :+: right) b)
-> f (Aliases right b) -> f (Aliases (left :+: right) b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Aliases right a -> f (Aliases right b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases right a
right
    Sum Aliases (left :+: right) a
a -> Aliases (left :+: right) b -> Aliases (D1 x (left :+: right)) b
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum (Aliases (left :+: right) b -> Aliases (D1 x (left :+: right)) b)
-> f (Aliases (left :+: right) b)
-> f (Aliases (D1 x (left :+: right)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b)
-> Aliases (left :+: right) a -> f (Aliases (left :+: right) b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases (left :+: right) a
a
    Record Aliases fields a
a -> Aliases fields b -> Aliases (D1 x (C1 y fields)) b
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record (Aliases fields b -> Aliases (D1 x (C1 y fields)) b)
-> f (Aliases fields b) -> f (Aliases (D1 x (C1 y fields)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Aliases fields a -> f (Aliases fields b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Aliases fields a
a

-- | Indexed by the field or branch names.
deriving anyclass instance (FunctorWithIndex String (Aliases rep))

deriving anyclass instance (FoldableWithIndex String (Aliases rep))

instance TraversableWithIndex String (Aliases rep) where
  itraverse :: (String -> a -> f b) -> Aliases rep a -> f (Aliases rep b)
itraverse String -> a -> f b
f Aliases rep a
as = case Aliases rep a
as of
    afield :: Aliases rep a
afield@(Field a
a) -> b
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     b
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (b
 -> Aliases
      (S1
         ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
      b)
-> f b
-> f (Aliases
        (S1
           ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
        b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b)
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
-> a
-> f b
forall k k (fieldName :: Symbol) a (m :: k -> *) (b :: k)
       (v :: k -> *) (proxy :: (k -> *) -> * -> *)
       (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness).
KnownSymbol fieldName =>
(String -> a -> m b)
-> proxy
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
-> a
-> m b
traverseField String -> a -> f b
f Aliases rep a
Aliases
  (S1
     ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
  a
afield a
a
    abranch :: Aliases rep a
abranch@(Branch a
a) -> b -> Aliases (C1 ('MetaCons branchName fixity sels) v) b
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (b -> Aliases (C1 ('MetaCons branchName fixity sels) v) b)
-> f b -> f (Aliases (C1 ('MetaCons branchName fixity sels) v) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b)
-> Aliases (C1 ('MetaCons branchName fixity sels) v) a -> a -> f b
forall k k (branchName :: Symbol) a (m :: k -> *) (b :: k)
       (v :: k -> *) (proxy :: (k -> *) -> * -> *) (fixity :: FixityI)
       (sels :: Bool).
KnownSymbol branchName =>
(String -> a -> m b)
-> proxy (C1 ('MetaCons branchName fixity sels) v) a -> a -> m b
traverseBranch String -> a -> f b
f Aliases rep a
Aliases (C1 ('MetaCons branchName fixity sels) v) a
abranch a
a
    FieldTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :*: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree (Aliases left b -> Aliases right b -> Aliases (left :*: right) b)
-> f (Aliases left b)
-> f (Aliases right b -> Aliases (left :*: right) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b) -> Aliases left a -> f (Aliases left b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases left a
left f (Aliases right b -> Aliases (left :*: right) b)
-> f (Aliases right b) -> f (Aliases (left :*: right) b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> a -> f b) -> Aliases right a -> f (Aliases right b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases right a
right
    BranchTree Aliases left a
left Aliases right a
right -> Aliases left b -> Aliases right b -> Aliases (left :+: right) b
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree (Aliases left b -> Aliases right b -> Aliases (left :+: right) b)
-> f (Aliases left b)
-> f (Aliases right b -> Aliases (left :+: right) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b) -> Aliases left a -> f (Aliases left b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases left a
left f (Aliases right b -> Aliases (left :+: right) b)
-> f (Aliases right b) -> f (Aliases (left :+: right) b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> a -> f b) -> Aliases right a -> f (Aliases right b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases right a
right
    Sum Aliases (left :+: right) a
a -> Aliases (left :+: right) b -> Aliases (D1 x (left :+: right)) b
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum (Aliases (left :+: right) b -> Aliases (D1 x (left :+: right)) b)
-> f (Aliases (left :+: right) b)
-> f (Aliases (D1 x (left :+: right)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b)
-> Aliases (left :+: right) a -> f (Aliases (left :+: right) b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases (left :+: right) a
a
    Record Aliases fields a
a -> Aliases fields b -> Aliases (D1 x (C1 y fields)) b
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record (Aliases fields b -> Aliases (D1 x (C1 y fields)) b)
-> f (Aliases fields b) -> f (Aliases (D1 x (C1 y fields)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> a -> f b) -> Aliases fields a -> f (Aliases fields b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse String -> a -> f b
f Aliases fields a
a
    where
      traverseField :: forall fieldName a m b v proxy unpackedness strictness laziness. KnownSymbol fieldName => (String -> a -> m b) -> proxy (S1 ('MetaSel ('Just fieldName) unpackedness strictness laziness) v) a -> a -> m b
      traverseField :: (String -> a -> m b)
-> proxy
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
-> a
-> m b
traverseField String -> a -> m b
f proxy
  (S1
     ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
  a
_ a
a =
        let fieldName :: String
fieldName = Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy fieldName
forall k (t :: k). Proxy t
Proxy @fieldName)
         in String -> a -> m b
f String
fieldName a
a
      traverseBranch :: forall branchName a m b v proxy fixity sels. KnownSymbol branchName => (String -> a -> m b) -> proxy (C1 ('MetaCons branchName fixity sels) v) a -> a -> m b
      traverseBranch :: (String -> a -> m b)
-> proxy (C1 ('MetaCons branchName fixity sels) v) a -> a -> m b
traverseBranch String -> a -> m b
f proxy (C1 ('MetaCons branchName fixity sels) v) a
_ a
a =
        let branchName :: String
branchName = Proxy branchName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy branchName
forall k (t :: k). Proxy t
Proxy @branchName)
         in String -> a -> m b
f String
branchName a
a

-- | An intermediate datatype for specifying the aliases.  See
-- 'aliasListBegin', 'alias' and 'aliasListEnd'.
type AliasList :: [Symbol] -> Type -> Type
data AliasList names a where
  Null :: AliasList '[] a
  Cons :: Proxy name -> a -> AliasList names a -> AliasList (name : names) a

-- | Add an alias to an `AliasList`.
--
-- __/TYPE APPLICATION REQUIRED!/__ You must provide the field/branch name using a type application.
alias :: forall name a names. a -> AliasList names a -> AliasList (name : names) a
alias :: a -> AliasList names a -> AliasList (name : names) a
alias = Proxy name -> a -> AliasList names a -> AliasList (name : names) a
forall (name :: Symbol) a (names :: [Symbol]).
Proxy name -> a -> AliasList names a -> AliasList (name : names) a
Cons (Proxy name
forall k (t :: k). Proxy t
Proxy @name)

-- | Define the aliases for a type by listing them.
--
-- See also 'alias' and 'aliasListEnd'.
aliasListBegin :: forall before a tree. (AliasTree before tree '[]) => AliasList before a -> Aliases tree a
aliasListBegin :: AliasList before a -> Aliases tree a
aliasListBegin AliasList before a
names =
  let (Aliases tree a
aliases, AliasList '[] a
Null) = AliasList before a -> (Aliases tree a, AliasList '[] a)
forall (before :: [Symbol]) (rep :: * -> *) (after :: [Symbol]) a.
AliasTree before rep after =>
AliasList before a -> (Aliases rep a, AliasList after a)
parseAliasTree @before @tree AliasList before a
names
   in Aliases tree a
aliases

-- | The empty `AliasList`.
aliasListEnd :: AliasList '[] a
aliasListEnd :: AliasList '[] a
aliasListEnd = AliasList '[] a
forall a. AliasList '[] a
Null

type AssertNamesAreEqual :: Symbol -> Symbol -> Constraint
type family AssertNamesAreEqual given expected where
  AssertNamesAreEqual expected expected = ()
  AssertNamesAreEqual given expected =
    TypeError
      ( Text "Expected field or constructor name \"" :<>: Text expected :<>: Text "\","
          :$$: Text "but instead found name \"" :<>: Text given :<>: Text "\"."
      )

type MissingAlias :: Symbol -> Constraint
type family MissingAlias expected where
  MissingAlias expected =
    TypeError
      (Text "No alias given for field or constructor name \"" :<>: Text expected :<>: Text "\".")

-- type ExcessAliasError :: Symbol -> Constraint
-- type family ExcessAliasError name where
--   ExcessAliasError name =
--     TypeError
--       ( Text "Alias given for nonexistent field or constructor \"" :<>: Text name :<>: Text "\".")

-- | This typeclass converts the list-representation of aliases `AliasList` to
-- the tree of aliases 'Aliases' that matches the generic Rep's shape.
--
-- Also, quite importantly, it ensures that the field names in the list match
-- the field names in the Rep.
type AliasTree :: [Symbol] -> (Type -> Type) -> [Symbol] -> Constraint
-- Note that we could add the functional dependency "rep after -> before", but
-- we don't want that because it would allow us to omit the field name
-- annotation when giving the aliases. We *don't* want inference there!
class AliasTree before rep after | before rep -> after where
  parseAliasTree :: AliasList before a -> (Aliases rep a, AliasList after a)

--
instance (AssertNamesAreEqual name name', KnownSymbol name') => AliasTree (name : names) (S1 ('MetaSel (Just name') x y z) v) names where
  parseAliasTree :: AliasList (name : names) a
-> (Aliases (S1 ('MetaSel ('Just name') x y z) v) a,
    AliasList names a)
parseAliasTree (Cons Proxy name
_ a
a AliasList names a
rest) = (a -> Aliases (S1 ('MetaSel ('Just name') x y z) v) a
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field a
a, AliasList names a
AliasList names a
rest)

instance MissingAlias name' => AliasTree '[] (S1 ('MetaSel (Just name') x y z) v) '[]

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

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

-- doesn't work because of the functional dependency :(
-- instance ExcessAliasError name => AliasTree before (D1 x (C1 y tree)) (name : names) where

--
instance (AssertNamesAreEqual name name', KnownSymbol name') => AliasTree (name : names) (C1 ('MetaCons name' fixity False) slots) names where
  parseAliasTree :: AliasList (name : names) a
-> (Aliases (C1 ('MetaCons name' fixity 'False) slots) a,
    AliasList names a)
parseAliasTree (Cons Proxy name
_ a
a AliasList names a
rest) = (a -> Aliases (C1 ('MetaCons name' fixity 'False) slots) a
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch a
a, AliasList names a
AliasList names a
rest)

instance MissingAlias name' => AliasTree '[] (C1 ('MetaCons name' fixity False) slots) '[]

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

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

-- doesn't work because of the functional dependency :(
-- instance ExcessAliasError name => AliasTree before (D1 x (left :+: right)) (name : names) where

-- | Typeclass for datatypes @r@ that have aliases for some 'Rubric' @k@.
type Aliased :: k -> Type -> Constraint
class (Rubric k, Generic r) => Aliased k r where
  aliases :: Aliases (Rep r) (AliasType k)

-- | Typeclass for marker datakinds used as rubrics, for classifying aliases according to their use.
--
-- The associated type family `AliasType` gives the type of the aliases.
--
-- 'Rubric's are needed when defining helper newtypes for use with @-XDerivingVia@. Because
-- 'Aliases' are defined at the value level, we need a way to relate the aliases with
-- the datatype during deriving.

-- If you are using 'Aliases' in standalone functions (possibly in combination with
-- 'GRecord' and 'GSum') you might not need to define a 'Rubric'. 
type Rubric :: k -> Constraint
class Rubric k where
  type AliasType k :: Type

class GHasDatatypeName rep where
  gGetDatatypeName :: String

instance KnownSymbol datatypeName => GHasDatatypeName (D1 (MetaData datatypeName m p nt) (C1 y prod)) where
  gGetDatatypeName :: String
gGetDatatypeName = Proxy datatypeName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy datatypeName
forall k (t :: k). Proxy t
Proxy @datatypeName)

class GHasFieldNames rep where
  gGetFieldNames :: Aliases rep String


instance GHasFieldNames prod => GHasFieldNames (D1 x (C1 y prod)) where
  gGetFieldNames :: Aliases (D1 x (C1 y prod)) String
gGetFieldNames = Aliases prod String -> Aliases (D1 x (C1 y prod)) String
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record (GHasFieldNames prod => Aliases prod String
forall (rep :: * -> *). GHasFieldNames rep => Aliases rep String
gGetFieldNames @prod)

instance KnownSymbol fieldName => GHasFieldNames (S1 ('MetaSel ('Just fieldName) unpackedness strictness laziness) (Rec0 v)) where
  gGetFieldNames :: Aliases
  (S1
     ('MetaSel ('Just fieldName) unpackedness strictness laziness)
     (Rec0 v))
  String
gGetFieldNames = String
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     String
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy fieldName
forall k (t :: k). Proxy t
Proxy @fieldName))

instance
  (GHasFieldNames left, GHasFieldNames right) =>
  GHasFieldNames (left :*: right)
  where
  gGetFieldNames :: Aliases (left :*: right) String
gGetFieldNames = Aliases left String
-> Aliases right String -> Aliases (left :*: right) String
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree (GHasFieldNames left => Aliases left String
forall (rep :: * -> *). GHasFieldNames rep => Aliases rep String
gGetFieldNames @left) (GHasFieldNames right => Aliases right String
forall (rep :: * -> *). GHasFieldNames rep => Aliases rep String
gGetFieldNames @right)


class GHasBranchNames rep where
  gGetBranchNames :: Aliases rep String

instance
  (GHasBranchNames (left :+: right)) =>
  GHasBranchNames (D1 x (left :+: right))
  where
  gGetBranchNames :: Aliases (D1 x (left :+: right)) String
gGetBranchNames = Aliases (left :+: right) String
-> Aliases (D1 x (left :+: right)) String
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum (GHasBranchNames (left :+: right) => Aliases (left :+: right) String
forall (rep :: * -> *). GHasBranchNames rep => Aliases rep String
gGetBranchNames @(left :+: right))

instance
  ( GHasBranchNames left,
    GHasBranchNames right
  ) =>
  GHasBranchNames (left :+: right)
  where
  gGetBranchNames :: Aliases (left :+: right) String
gGetBranchNames = Aliases left String
-> Aliases right String -> Aliases (left :+: right) String
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree (GHasBranchNames left => Aliases left String
forall (rep :: * -> *). GHasBranchNames rep => Aliases rep String
gGetBranchNames @left) (GHasBranchNames right => Aliases right String
forall (rep :: * -> *). GHasBranchNames rep => Aliases rep String
gGetBranchNames @right)

instance KnownSymbol branchName => GHasBranchNames (C1 ('MetaCons branchName fixity sels) y) where
  gGetBranchNames :: Aliases (C1 ('MetaCons branchName fixity sels) y) String
gGetBranchNames = String -> Aliases (C1 ('MetaCons branchName fixity sels) y) String
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (Proxy branchName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy branchName
forall k (t :: k). Proxy t
Proxy @branchName))

--
--
class GRecord (c :: Type -> Constraint) rep where
  gToRecord ::
    Applicative m =>
    Aliases rep a ->
    (forall v. c v => a -> m v) ->
    m (rep z)
  gFromRecord ::
    Aliases rep a ->
    (forall v. c v => a -> v -> o) ->
    rep z ->
    Aliases rep o
  gRecordEnum ::
    Aliases rep a ->
    (forall v. c v => Proxy v -> o) ->
    Aliases rep (a, o)

instance GRecord c prod => GRecord c (D1 x (C1 y prod)) where
  gToRecord :: Aliases (D1 x (C1 y prod)) a
-> (forall v. c v => a -> m v) -> m (D1 x (C1 y prod) z)
gToRecord (Record Aliases fields a
as) forall v. c v => a -> m v
parseField =
    M1 C y fields z -> M1 D x (M1 C y fields) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C y fields z -> M1 D x (M1 C y fields) z)
-> (fields z -> M1 C y fields z)
-> fields z
-> M1 D x (M1 C y fields) z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fields z -> M1 C y fields z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (fields z -> M1 D x (M1 C y fields) z)
-> m (fields z) -> m (M1 D x (M1 C y fields) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases fields a -> (forall v. c v => a -> m v) -> m (fields z)
forall (c :: * -> Constraint) (rep :: * -> *) (m :: * -> *) a z.
(GRecord c rep, Applicative m) =>
Aliases rep a -> (forall v. c v => a -> m v) -> m (rep z)
gToRecord @c Aliases fields a
as forall v. c v => a -> m v
parseField
  gFromRecord :: Aliases (D1 x (C1 y prod)) a
-> (forall v. c v => a -> v -> o)
-> D1 x (C1 y prod) z
-> Aliases (D1 x (C1 y prod)) o
gFromRecord (Record Aliases fields a
as) forall v. c v => a -> v -> o
renderField (M1 (M1 prod z
prod)) =
    Aliases fields o -> Aliases (D1 x (C1 y fields)) o
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record (Aliases fields a
-> (forall v. c v => a -> v -> o) -> fields z -> Aliases fields o
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => a -> v -> o) -> rep z -> Aliases rep o
gFromRecord @c Aliases fields a
as forall v. c v => a -> v -> o
renderField prod z
fields z
prod)
  gRecordEnum :: Aliases (D1 x (C1 y prod)) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (D1 x (C1 y prod)) (a, o)
gRecordEnum (Record Aliases fields a
as) forall v. c v => Proxy v -> o
renderField = Aliases prod (a, o) -> Aliases (D1 x (C1 y prod)) (a, o)
forall (fields :: * -> *) a (x :: Meta) (y :: Meta).
Aliases fields a -> Aliases (D1 x (C1 y fields)) a
Record (Aliases prod a
-> (forall v. c v => Proxy v -> o) -> Aliases prod (a, o)
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, o)
gRecordEnum @c @prod Aliases prod a
Aliases fields a
as forall v. c v => Proxy v -> o
renderField)

instance c v => GRecord c (S1 x (Rec0 v)) where
  gToRecord :: Aliases (S1 x (Rec0 v)) a
-> (forall v. c v => a -> m v) -> m (S1 x (Rec0 v) z)
gToRecord (Field a
a) forall v. c v => a -> m v
parseField =
    K1 R v z -> S1 x (Rec0 v) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R v z -> S1 x (Rec0 v) z)
-> (v -> K1 R v z) -> v -> S1 x (Rec0 v) z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> K1 R v z
forall k i c (p :: k). c -> K1 i c p
K1 (v -> S1 x (Rec0 v) z) -> m v -> m (S1 x (Rec0 v) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m v
forall v. c v => a -> m v
parseField a
a
  gFromRecord :: Aliases (S1 x (Rec0 v)) a
-> (forall v. c v => a -> v -> o)
-> S1 x (Rec0 v) z
-> Aliases (S1 x (Rec0 v)) o
gFromRecord (Field a
a) forall v. c v => a -> v -> o
renderField (M1 (K1 v
v)) = o
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     o
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field ( a -> v -> o
forall v. c v => a -> v -> o
renderField a
a v
v )
  gRecordEnum :: Aliases (S1 x (Rec0 v)) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (S1 x (Rec0 v)) (a, o)
gRecordEnum (Field a
a) forall v. c v => Proxy v -> o
renderField = (a, o)
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness)
        (Rec0 v))
     (a, o)
forall (fieldName :: Symbol) a (unpackedness :: SourceUnpackedness)
       (strictness :: SourceStrictness) (laziness :: DecidedStrictness)
       (v :: * -> *).
KnownSymbol fieldName =>
a
-> Aliases
     (S1
        ('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
     a
Field (a
a, Proxy v -> o
forall v. c v => Proxy v -> o
renderField (Proxy v
forall k (t :: k). Proxy t
Proxy @v))

instance
  (GRecord c left, GRecord c right) =>
  GRecord c (left :*: right)
  where
  gToRecord :: Aliases (left :*: right) a
-> (forall v. c v => a -> m v) -> m ((:*:) left right z)
gToRecord (FieldTree Aliases left a
aleft Aliases right a
aright) forall v. c v => a -> m v
parseField =
    left z -> right z -> (:*:) left right z
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (left z -> right z -> (:*:) left right z)
-> m (left z) -> m (right z -> (:*:) left right z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases left a -> (forall v. c v => a -> m v) -> m (left z)
forall (c :: * -> Constraint) (rep :: * -> *) (m :: * -> *) a z.
(GRecord c rep, Applicative m) =>
Aliases rep a -> (forall v. c v => a -> m v) -> m (rep z)
gToRecord @c Aliases left a
aleft forall v. c v => a -> m v
parseField m (right z -> (:*:) left right z)
-> m (right z) -> m ((:*:) left right z)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Aliases right a -> (forall v. c v => a -> m v) -> m (right z)
forall (c :: * -> Constraint) (rep :: * -> *) (m :: * -> *) a z.
(GRecord c rep, Applicative m) =>
Aliases rep a -> (forall v. c v => a -> m v) -> m (rep z)
gToRecord @c Aliases right a
aright forall v. c v => a -> m v
parseField
  gFromRecord :: Aliases (left :*: right) a
-> (forall v. c v => a -> v -> o)
-> (:*:) left right z
-> Aliases (left :*: right) o
gFromRecord (FieldTree Aliases left a
aleft Aliases right a
aright) forall v. c v => a -> v -> o
renderField (left z
left :*: right z
right) =
    Aliases left o -> Aliases right o -> Aliases (left :*: right) o
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree (Aliases left a
-> (forall v. c v => a -> v -> o) -> left z -> Aliases left o
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => a -> v -> o) -> rep z -> Aliases rep o
gFromRecord @c Aliases left a
aleft forall v. c v => a -> v -> o
renderField left z
left z
left) (Aliases right a
-> (forall v. c v => a -> v -> o) -> right z -> Aliases right o
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => a -> v -> o) -> rep z -> Aliases rep o
gFromRecord @c Aliases right a
aright forall v. c v => a -> v -> o
renderField right z
right z
right)
  gRecordEnum :: Aliases (left :*: right) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (left :*: right) (a, o)
gRecordEnum (FieldTree Aliases left a
aleft Aliases right a
aright) forall v. c v => Proxy v -> o
renderField =
    Aliases left (a, o)
-> Aliases right (a, o) -> Aliases (left :*: right) (a, o)
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :*: left) a
FieldTree (Aliases left a
-> (forall v. c v => Proxy v -> o) -> Aliases left (a, o)
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, o)
gRecordEnum @c @left Aliases left a
Aliases left a
aleft forall v. c v => Proxy v -> o
renderField) (Aliases right a
-> (forall v. c v => Proxy v -> o) -> Aliases right (a, o)
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GRecord c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, o)
gRecordEnum @c @right Aliases right a
Aliases right a
aright forall v. c v => Proxy v -> o
renderField)

--
--
data Slots m1 m2 v
  = ZeroSlots v
  | SingleSlot (m1 v)
  | ManySlots (m2 v)
  deriving stock (Int -> Slots m1 m2 v -> ShowS
[Slots m1 m2 v] -> ShowS
Slots m1 m2 v -> String
(Int -> Slots m1 m2 v -> ShowS)
-> (Slots m1 m2 v -> String)
-> ([Slots m1 m2 v] -> ShowS)
-> Show (Slots m1 m2 v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
Int -> Slots m1 m2 v -> ShowS
forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
[Slots m1 m2 v] -> ShowS
forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
Slots m1 m2 v -> String
showList :: [Slots m1 m2 v] -> ShowS
$cshowList :: forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
[Slots m1 m2 v] -> ShowS
show :: Slots m1 m2 v -> String
$cshow :: forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
Slots m1 m2 v -> String
showsPrec :: Int -> Slots m1 m2 v -> ShowS
$cshowsPrec :: forall (m1 :: * -> *) (m2 :: * -> *) v.
(Show v, Show (m1 v), Show (m2 v)) =>
Int -> Slots m1 m2 v -> ShowS
Show, a -> Slots m1 m2 b -> Slots m1 m2 a
(a -> b) -> Slots m1 m2 a -> Slots m1 m2 b
(forall a b. (a -> b) -> Slots m1 m2 a -> Slots m1 m2 b)
-> (forall a b. a -> Slots m1 m2 b -> Slots m1 m2 a)
-> Functor (Slots m1 m2)
forall a b. a -> Slots m1 m2 b -> Slots m1 m2 a
forall a b. (a -> b) -> Slots m1 m2 a -> Slots m1 m2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(Functor m1, Functor m2) =>
a -> Slots m1 m2 b -> Slots m1 m2 a
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(Functor m1, Functor m2) =>
(a -> b) -> Slots m1 m2 a -> Slots m1 m2 b
<$ :: a -> Slots m1 m2 b -> Slots m1 m2 a
$c<$ :: forall (m1 :: * -> *) (m2 :: * -> *) a b.
(Functor m1, Functor m2) =>
a -> Slots m1 m2 b -> Slots m1 m2 a
fmap :: (a -> b) -> Slots m1 m2 a -> Slots m1 m2 b
$cfmap :: forall (m1 :: * -> *) (m2 :: * -> *) a b.
(Functor m1, Functor m2) =>
(a -> b) -> Slots m1 m2 a -> Slots m1 m2 b
Functor)

class GSum (c :: Type -> Constraint) rep where
  gToSum ::
    (Functor n, Applicative m2) =>
    Aliases rep a ->
    (forall b. a -> Slots m1 m2 b -> n b) ->
    (forall v. c v => m1 v) ->
    (forall v. c v => m2 v) ->
    Aliases rep (n (rep z))
  gFromSum ::
    Aliases rep a ->
    (forall v. c v => v -> o) ->
    rep z ->
    (a, [o])
  gSumEnum ::
    Aliases rep a ->
    (forall v. c v => Proxy v -> o) ->
    Aliases rep (a, [o])

instance
  (GSum c (left :+: right)) =>
  GSum c (D1 x (left :+: right))
  where
  gToSum :: Aliases (D1 x (left :+: right)) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (D1 x (left :+: right)) (n (D1 x (left :+: right) z))
gToSum (Sum Aliases (left :+: right) a
s) forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2 = Aliases (left :+: right) (n (M1 D x (left :+: right) z))
-> Aliases (D1 x (left :+: right)) (n (M1 D x (left :+: right) z))
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum (((:+:) left right z -> M1 D x (left :+: right) z)
-> n ((:+:) left right z) -> n (M1 D x (left :+: right) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) left right z -> M1 D x (left :+: right) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (n ((:+:) left right z) -> n (M1 D x (left :+: right) z))
-> Aliases (left :+: right) (n ((:+:) left right z))
-> Aliases (left :+: right) (n (M1 D x (left :+: right) z))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases (left :+: right) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (left :+: right) (n ((:+:) left right z))
forall (c :: * -> Constraint) (rep :: * -> *) (n :: * -> *)
       (m2 :: * -> *) a (m1 :: * -> *) z.
(GSum c rep, Functor n, Applicative m2) =>
Aliases rep a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases rep (n (rep z))
gToSum @c Aliases (left :+: right) a
s forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2)
  gFromSum :: Aliases (D1 x (left :+: right)) a
-> (forall v. c v => v -> o) -> D1 x (left :+: right) z -> (a, [o])
gFromSum (Sum Aliases (left :+: right) a
s) forall v. c v => v -> o
renderSlot (M1 (:+:) left right z
srep) = Aliases (left :+: right) a
-> (forall v. c v => v -> o) -> (:+:) left right z -> (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GSum c rep =>
Aliases rep a -> (forall v. c v => v -> o) -> rep z -> (a, [o])
gFromSum @c Aliases (left :+: right) a
s forall v. c v => v -> o
renderSlot (:+:) left right z
(:+:) left right z
srep
  gSumEnum :: Aliases (D1 x (left :+: right)) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (D1 x (left :+: right)) (a, [o])
gSumEnum (Sum Aliases (left :+: right) a
s) forall v. c v => Proxy v -> o
renderSlot = Aliases (left :+: right) (a, [o])
-> Aliases (D1 x (left :+: right)) (a, [o])
forall (left :: * -> *) (right :: * -> *) a (x :: Meta).
Aliases (left :+: right) a -> Aliases (D1 x (left :+: right)) a
Sum (Aliases (left :+: right) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (left :+: right) (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GSum c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, [o])
gSumEnum @c @_ @_ @_ Aliases (left :+: right) a
s forall v. c v => Proxy v -> o
renderSlot)

instance
  ( GSum c left,
    GSum c right
  ) =>
  GSum c (left :+: right)
  where
  gToSum :: Aliases (left :+: right) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (left :+: right) (n ((:+:) left right z))
gToSum (BranchTree Aliases left a
aleft Aliases right a
aright) forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2 =
    Aliases left (n ((:+:) left right z))
-> Aliases right (n ((:+:) left right z))
-> Aliases (left :+: right) (n ((:+:) left right z))
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree ((left z -> (:+:) left right z)
-> n (left z) -> n ((:+:) left right z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap left z -> (:+:) left right z
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n (left z) -> n ((:+:) left right z))
-> Aliases left (n (left z))
-> Aliases left (n ((:+:) left right z))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases left a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases left (n (left z))
forall (c :: * -> Constraint) (rep :: * -> *) (n :: * -> *)
       (m2 :: * -> *) a (m1 :: * -> *) z.
(GSum c rep, Functor n, Applicative m2) =>
Aliases rep a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases rep (n (rep z))
gToSum @c @left Aliases left a
Aliases left a
aleft forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2) ((right z -> (:+:) left right z)
-> n (right z) -> n ((:+:) left right z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap right z -> (:+:) left right z
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n (right z) -> n ((:+:) left right z))
-> Aliases right (n (right z))
-> Aliases right (n ((:+:) left right z))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aliases right a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases right (n (right z))
forall (c :: * -> Constraint) (rep :: * -> *) (n :: * -> *)
       (m2 :: * -> *) a (m1 :: * -> *) z.
(GSum c rep, Functor n, Applicative m2) =>
Aliases rep a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases rep (n (rep z))
gToSum @c @right Aliases right a
Aliases right a
aright forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2)
  gFromSum :: Aliases (left :+: right) a
-> (forall v. c v => v -> o) -> (:+:) left right z -> (a, [o])
gFromSum (BranchTree Aliases left a
aleft Aliases right a
aright) forall v. c v => v -> o
renderSlot = \case
    L1 left z
rleft -> Aliases left a -> (forall v. c v => v -> o) -> left z -> (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GSum c rep =>
Aliases rep a -> (forall v. c v => v -> o) -> rep z -> (a, [o])
gFromSum @c Aliases left a
aleft forall v. c v => v -> o
renderSlot left z
left z
rleft
    R1 right z
rright -> Aliases right a -> (forall v. c v => v -> o) -> right z -> (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o z.
GSum c rep =>
Aliases rep a -> (forall v. c v => v -> o) -> rep z -> (a, [o])
gFromSum @c Aliases right a
aright forall v. c v => v -> o
renderSlot right z
right z
rright
  gSumEnum :: Aliases (left :+: right) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (left :+: right) (a, [o])
gSumEnum (BranchTree Aliases left a
aleft Aliases right a
aright) forall v. c v => Proxy v -> o
renderSlot =
    Aliases left (a, [o])
-> Aliases right (a, [o]) -> Aliases (left :+: right) (a, [o])
forall (left :: * -> *) a (left :: * -> *).
Aliases left a -> Aliases left a -> Aliases (left :+: left) a
BranchTree (Aliases left a
-> (forall v. c v => Proxy v -> o) -> Aliases left (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GSum c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, [o])
gSumEnum @c Aliases left a
aleft forall v. c v => Proxy v -> o
renderSlot) (Aliases right a
-> (forall v. c v => Proxy v -> o) -> Aliases right (a, [o])
forall (c :: * -> Constraint) (rep :: * -> *) a o.
GSum c rep =>
Aliases rep a
-> (forall v. c v => Proxy v -> o) -> Aliases rep (a, [o])
gSumEnum @c Aliases right a
aright forall v. c v => Proxy v -> o
renderSlot)

instance GSum c (C1 x U1) where
  gToSum :: Aliases (C1 x U1) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (C1 x U1) (n (C1 x U1 z))
gToSum (Branch a
fieldName) forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2 =
    n (C1 x U1 z)
-> Aliases
     (C1 ('MetaCons branchName fixity sels) U1) (n (C1 x U1 z))
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a -> Slots m1 m2 (C1 x U1 z) -> n (C1 x U1 z)
forall b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (C1 x U1 z -> Slots m1 m2 (C1 x U1 z)
forall (m1 :: * -> *) (m2 :: * -> *) v. v -> Slots m1 m2 v
ZeroSlots (U1 z -> C1 x U1 z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 z
forall k (p :: k). U1 p
U1)))
  gFromSum :: Aliases (C1 x U1) a
-> (forall v. c v => v -> o) -> C1 x U1 z -> (a, [o])
gFromSum (Branch a
fieldName) forall v. c v => v -> o
renderSlot C1 x U1 z
_ =
    (a
fieldName, [])
  gSumEnum :: Aliases (C1 x U1) a
-> (forall v. c v => Proxy v -> o) -> Aliases (C1 x U1) (a, [o])
gSumEnum (Branch a
fieldName) forall v. c v => Proxy v -> o
renderSlot =
    (a, [o])
-> Aliases (C1 ('MetaCons branchName fixity sels) U1) (a, [o])
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a
fieldName, [])

instance (c v) => GSum c (C1 x (S1 y (Rec0 v))) where
  gToSum :: Aliases (C1 x (S1 y (Rec0 v))) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (C1 x (S1 y (Rec0 v))) (n (C1 x (S1 y (Rec0 v)) z))
gToSum (Branch a
fieldName) forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2 =
    n (C1 x (S1 y (Rec0 v)) z)
-> Aliases
     (C1 ('MetaCons branchName fixity sels) (S1 y (Rec0 v)))
     (n (C1 x (S1 y (Rec0 v)) z))
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (M1 S y (Rec0 v) z -> C1 x (S1 y (Rec0 v)) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 S y (Rec0 v) z -> C1 x (S1 y (Rec0 v)) z)
-> (v -> M1 S y (Rec0 v) z) -> v -> C1 x (S1 y (Rec0 v)) z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R v z -> M1 S y (Rec0 v) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R v z -> M1 S y (Rec0 v) z)
-> (v -> K1 R v z) -> v -> M1 S y (Rec0 v) z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> K1 R v z
forall k i c (p :: k). c -> K1 i c p
K1 (v -> C1 x (S1 y (Rec0 v)) z) -> n v -> n (C1 x (S1 y (Rec0 v)) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Slots m1 m2 v -> n v
forall b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (m1 v -> Slots m1 m2 v
forall (m1 :: * -> *) (m2 :: * -> *) v. m1 v -> Slots m1 m2 v
SingleSlot m1 v
forall v. c v => m1 v
parseSlot1))
  gFromSum :: Aliases (C1 x (S1 y (Rec0 v))) a
-> (forall v. c v => v -> o) -> C1 x (S1 y (Rec0 v)) z -> (a, [o])
gFromSum (Branch a
fieldName) forall v. c v => v -> o
renderSlot (M1 (M1 (K1 v
slots))) =
    (a
fieldName, [v -> o
forall v. c v => v -> o
renderSlot v
slots])
  gSumEnum :: Aliases (C1 x (S1 y (Rec0 v))) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (C1 x (S1 y (Rec0 v))) (a, [o])
gSumEnum (Branch a
fieldName) forall v. c v => Proxy v -> o
renderSlot =
    (a, [o])
-> Aliases
     (C1 ('MetaCons branchName fixity sels) (S1 y (Rec0 v))) (a, [o])
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a
fieldName, [Proxy v -> o
forall v. c v => Proxy v -> o
renderSlot (Proxy v
forall k (t :: k). Proxy t
Proxy @v)])

instance (GSumSlots c (left :*: right)) => GSum c (C1 x (left :*: right)) where
  gToSum :: Aliases (C1 x (left :*: right)) a
-> (forall b. a -> Slots m1 m2 b -> n b)
-> (forall v. c v => m1 v)
-> (forall v. c v => m2 v)
-> Aliases (C1 x (left :*: right)) (n (C1 x (left :*: right) z))
gToSum (Branch a
fieldName) forall b. a -> Slots m1 m2 b -> n b
parseBranch forall v. c v => m1 v
parseSlot1 forall v. c v => m2 v
parseSlot2 =
    n (C1 x (left :*: right) z)
-> Aliases
     (C1 ('MetaCons branchName fixity sels) (left :*: right))
     (n (C1 x (left :*: right) z))
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch ((:*:) left right z -> C1 x (left :*: right) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:*:) left right z -> C1 x (left :*: right) z)
-> n ((:*:) left right z) -> n (C1 x (left :*: right) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Slots m1 m2 ((:*:) left right z) -> n ((:*:) left right z)
forall b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (m2 ((:*:) left right z) -> Slots m1 m2 ((:*:) left right z)
forall (m1 :: * -> *) (m2 :: * -> *) v. m2 v -> Slots m1 m2 v
ManySlots ((forall v. c v => m2 v) -> m2 ((:*:) left right z)
forall k (c :: * -> Constraint) (rep :: k -> *) (m :: * -> *)
       (z :: k).
(GSumSlots c rep, Applicative m) =>
(forall v. c v => m v) -> m (rep z)
gToSumSlots @c forall v. c v => m2 v
parseSlot2)))
  gFromSum :: Aliases (C1 x (left :*: right)) a
-> (forall v. c v => v -> o) -> C1 x (left :*: right) z -> (a, [o])
gFromSum (Branch a
fieldName) forall v. c v => v -> o
renderSlot (M1 (:*:) left right z
slots) =
    (a
fieldName, (forall v. c v => v -> o) -> (:*:) left right z -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o (z :: k).
GSumSlots c rep =>
(forall v. c v => v -> o) -> rep z -> [o]
gFromSumSlots @c forall v. c v => v -> o
renderSlot (:*:) left right z
slots)
  gSumEnum :: Aliases (C1 x (left :*: right)) a
-> (forall v. c v => Proxy v -> o)
-> Aliases (C1 x (left :*: right)) (a, [o])
gSumEnum (Branch a
fieldName) forall v. c v => Proxy v -> o
renderSlot =
    (a, [o])
-> Aliases
     (C1 ('MetaCons branchName fixity sels) (left :*: right)) (a, [o])
forall (branchName :: Symbol) a (fixity :: FixityI) (left :: Bool)
       (v :: * -> *).
KnownSymbol branchName =>
a -> Aliases (C1 ('MetaCons branchName fixity left) v) a
Branch (a
fieldName, (forall v. c v => Proxy v -> o) -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o.
GSumSlots c rep =>
(forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots @c @(left :*: right) forall v. c v => Proxy v -> o
renderSlot)

class GSumSlots (c :: Type -> Constraint) rep where
  gToSumSlots ::
    Applicative m =>
    (forall v. c v => m v) ->
    m (rep z)
  gFromSumSlots :: (forall v. c v => v -> o) -> rep z -> [o]
  gSumEnumSlots :: (forall v. c v => Proxy v -> o) -> [o]

instance c v => GSumSlots c (S1 y (Rec0 v)) where
  gToSumSlots :: (forall v. c v => m v) -> m (S1 y (Rec0 v) z)
gToSumSlots forall v. c v => m v
parseSlot = K1 R v z -> S1 y (Rec0 v) z
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R v z -> S1 y (Rec0 v) z)
-> (v -> K1 R v z) -> v -> S1 y (Rec0 v) z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> K1 R v z
forall k i c (p :: k). c -> K1 i c p
K1 (v -> S1 y (Rec0 v) z) -> m v -> m (S1 y (Rec0 v) z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
forall v. c v => m v
parseSlot
  gFromSumSlots :: (forall v. c v => v -> o) -> S1 y (Rec0 v) z -> [o]
gFromSumSlots forall v. c v => v -> o
renderSlot (M1 (K1 v
v)) = [v -> o
forall v. c v => v -> o
renderSlot v
v]
  gSumEnumSlots :: (forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots forall v. c v => Proxy v -> o
renderSlot = [Proxy v -> o
forall v. c v => Proxy v -> o
renderSlot (Proxy v
forall k (t :: k). Proxy t
Proxy @v)]

instance
  ( GSumSlots c left,
    GSumSlots c right
  ) =>
  GSumSlots c (left :*: right)
  where
  gToSumSlots :: (forall v. c v => m v) -> m ((:*:) left right z)
gToSumSlots forall v. c v => m v
parseSlot =
    left z -> right z -> (:*:) left right z
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (left z -> right z -> (:*:) left right z)
-> m (left z) -> m (right z -> (:*:) left right z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall v. c v => m v) -> m (left z)
forall k (c :: * -> Constraint) (rep :: k -> *) (m :: * -> *)
       (z :: k).
(GSumSlots c rep, Applicative m) =>
(forall v. c v => m v) -> m (rep z)
gToSumSlots @c @left forall v. c v => m v
parseSlot m (right z -> (:*:) left right z)
-> m (right z) -> m ((:*:) left right z)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall v. c v => m v) -> m (right z)
forall k (c :: * -> Constraint) (rep :: k -> *) (m :: * -> *)
       (z :: k).
(GSumSlots c rep, Applicative m) =>
(forall v. c v => m v) -> m (rep z)
gToSumSlots @c @right forall v. c v => m v
parseSlot
  gFromSumSlots :: (forall v. c v => v -> o) -> (:*:) left right z -> [o]
gFromSumSlots forall v. c v => v -> o
renderSlot (left z
left :*: right z
right) =
    (forall v. c v => v -> o) -> left z -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o (z :: k).
GSumSlots c rep =>
(forall v. c v => v -> o) -> rep z -> [o]
gFromSumSlots @c forall v. c v => v -> o
renderSlot left z
left [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ (forall v. c v => v -> o) -> right z -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o (z :: k).
GSumSlots c rep =>
(forall v. c v => v -> o) -> rep z -> [o]
gFromSumSlots @c forall v. c v => v -> o
renderSlot right z
right
  gSumEnumSlots :: (forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots forall v. c v => Proxy v -> o
renderSlot =
    (forall v. c v => Proxy v -> o) -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o.
GSumSlots c rep =>
(forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots @c @left forall v. c v => Proxy v -> o
renderSlot [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ (forall v. c v => Proxy v -> o) -> [o]
forall k (c :: * -> Constraint) (rep :: k -> *) o.
GSumSlots c rep =>
(forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots @c @right forall v. c v => Proxy v -> o
renderSlot