{-# 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 #-}
module ByOtherNames.Internal
( Aliases (..),
zipAliasesWith,
AliasList,
aliasListBegin,
alias,
aliasListEnd,
Aliased (aliases),
Rubric (..),
GHasDatatypeName (..),
GHasFieldNames (..),
GRecord (..),
GHasBranchNames (..),
GSum (..),
Slots (..),
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
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
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 :: forall a b c (rep :: * -> *).
(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) -> forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field (a -> b -> c
f a
a b
b)
(Branch a
a, Branch b
b) -> forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) 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) -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree (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
b1) (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
b2)
(BranchTree Aliases left a
a1 Aliases right a
a2, BranchTree Aliases left b
b1 Aliases right b
b2) -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree (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
b1) (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
b2)
(Sum Aliases (left :+: right) a
a, Sum Aliases (left :+: right) b
b) -> forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum (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
b)
(Record Aliases fields a
a, Record Aliases fields b
b) -> forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record (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
b)
instance Functor (Aliases rep) where
fmap :: forall a b. (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 -> forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field (a -> b
f a
a)
Branch a
a -> forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (a -> b
f a
a)
FieldTree Aliases left a
left Aliases right a
right -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases left a
left) (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 -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Aliases left a
left) (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 -> forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum (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 -> forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record (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 :: forall m a. Monoid m => (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 -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases left a
left forall a. Semigroup a => a -> a -> a
<> 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 -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Aliases left a
left forall a. Semigroup a => a -> a -> a
<> 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 -> 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 -> 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 :: forall (f :: * -> *) a b.
Applicative f =>
(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 -> forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
Branch a
a -> forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch 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 -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 -> forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 -> forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
deriving anyclass instance (FunctorWithIndex String (Aliases rep))
deriving anyclass instance (FoldableWithIndex String (Aliases rep))
instance TraversableWithIndex String (Aliases rep) where
itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(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) -> forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f 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
afield a
a
abranch :: Aliases rep a
abranch@(Branch a
a) -> forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch forall (f :: * -> *) a b. Functor f => (a -> b) -> f 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
abranch a
a
FieldTree Aliases left a
left Aliases right a
right -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 -> forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 -> forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 -> forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: 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 -> m b
f proxy
(S1
('MetaSel ('Just fieldName) unpackedness strictness laziness) v)
a
_ a
a =
let fieldName :: String
fieldName = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (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 :: 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 -> m b
f proxy (C1 ('MetaCons branchName fixity sels) v) a
_ a
a =
let branchName :: String
branchName = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @branchName)
in String -> a -> m b
f String
branchName a
a
type AliasList :: [Symbol] -> Type -> Type
data AliasList names a where
Null :: AliasList '[] a
Cons :: Proxy name -> a -> AliasList names a -> AliasList (name : names) a
alias :: forall name a names.
a ->
AliasList names a ->
AliasList (name : names) a
alias :: forall (name :: Symbol) a (names :: [Symbol]).
a -> AliasList names a -> AliasList (name : names) a
alias = forall (name :: Symbol) a (names :: [Symbol]).
Proxy name -> a -> AliasList names a -> AliasList (name : names) a
Cons (forall {k} (t :: k). Proxy t
Proxy @name)
aliasListBegin :: forall names a rep. (AliasTree names rep '[])
=> AliasList names a
-> Aliases rep a
aliasListBegin :: forall (names :: [Symbol]) a (rep :: * -> *).
AliasTree names rep '[] =>
AliasList names a -> Aliases rep a
aliasListBegin AliasList names a
names =
let (Aliases rep a
aliases, AliasList '[] a
Null) = forall (before :: [Symbol]) (rep :: * -> *) (after :: [Symbol]) a.
AliasTree before rep after =>
AliasList before a -> (Aliases rep a, AliasList after a)
parseAliasTree @names @rep AliasList names a
names
in Aliases rep a
aliases
aliasListEnd :: AliasList '[] a
aliasListEnd :: forall a. AliasList '[] a
aliasListEnd = 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 AliasTree :: [Symbol] -> (Type -> Type) -> [Symbol] -> Constraint
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 :: forall a.
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) = (forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field a
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 :: forall a.
AliasList before a -> (Aliases (left :*: right) a, AliasList end a)
parseAliasTree AliasList before a
as =
let (Aliases left a
left, AliasList middle a
middle) = 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) = 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 (forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) 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 :: forall a.
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') = 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 (forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record Aliases tree a
aliases', AliasList '[] a
as')
instance (AssertNamesAreEqual name name', KnownSymbol name') => AliasTree (name : names) (C1 ('MetaCons name' fixity False) slots) names where
parseAliasTree :: forall a.
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) = (forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch a
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 :: forall a.
AliasList before a -> (Aliases (left :+: right) a, AliasList end a)
parseAliasTree AliasList before a
as =
let (Aliases left a
left, AliasList middle a
middle) = 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) = 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 (forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) 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 :: forall a.
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') = 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 (forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum Aliases (left :+: right) a
aliases', AliasList '[] a
as')
type Aliased :: k -> Type -> Constraint
class (Rubric k, Generic r) => Aliased k r where
aliases :: Aliases (Rep r) (AliasType k)
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 = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (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 = forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record (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 = forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @fieldName))
instance
(GHasFieldNames left, GHasFieldNames right) =>
GHasFieldNames (left :*: right)
where
gGetFieldNames :: Aliases (left :*: right) String
gGetFieldNames = forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree (forall (rep :: * -> *). GHasFieldNames rep => Aliases rep String
gGetFieldNames @left) (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 = forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum (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 = forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree (forall (rep :: * -> *). GHasBranchNames rep => Aliases rep String
gGetBranchNames @left) (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 = forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (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 :: forall (m :: * -> *) a z.
Applicative m =>
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 =
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 (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 :: forall a o z.
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)) =
forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record (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
prod)
gRecordEnum :: forall a o.
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 = forall (name :: * -> *) a (names :: Meta) (y :: Meta).
Aliases name a -> Aliases (D1 names (C1 y name)) a
Record (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 fields a
as forall v. c v => Proxy v -> o
renderField)
instance
(GRecord c left, GRecord c right) =>
GRecord c (left :*: right)
where
gToRecord :: forall (m :: * -> *) a z.
Applicative m =>
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 =
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 (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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall a o z.
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) =
forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree (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) (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)
gRecordEnum :: forall a o.
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 =
forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :*: names) a
FieldTree (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
aleft forall v. c v => Proxy v -> o
renderField) (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
aright forall v. c v => Proxy v -> o
renderField)
instance c v => GRecord c (S1 x (Rec0 v)) where
gToRecord :: forall (m :: * -> *) a z.
Applicative m =>
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 =
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. c v => a -> m v
parseField a
a
gFromRecord :: forall a o z.
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)) = forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field (forall v. c v => a -> v -> o
renderField a
a v
v)
gRecordEnum :: forall a o.
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 = forall (name :: Symbol) a (names :: SourceUnpackedness)
(y :: SourceStrictness) (v :: DecidedStrictness) (v :: * -> *).
KnownSymbol name =>
a -> Aliases (S1 ('MetaSel ('Just name) names y v) v) a
Field (a
a, forall v. c v => Proxy v -> o
renderField (forall {k} (t :: k). Proxy t
Proxy @v))
data Slots m1 m2 v
= ZeroSlots v
| SingleSlot (m1 v)
| ManySlots (m2 v)
deriving stock (Int -> Slots m1 m2 v -> ShowS
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, 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
<$ :: forall a 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 :: forall a b. (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])
::
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 :: forall (n :: * -> *) (m2 :: * -> *) a (m1 :: * -> *) z.
(Functor n, Applicative m2) =>
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 = forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall a o z.
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) = 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
srep
gSumEnum :: forall a o.
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 = forall (name :: * -> *) (names :: * -> *) a (y :: Meta).
Aliases (name :+: names) a -> Aliases (D1 y (name :+: names)) a
Sum (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 :: forall (n :: * -> *) (m2 :: * -> *) a (m1 :: * -> *) z.
(Functor n, Applicative m2) =>
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 =
forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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 :: forall a o z.
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 -> 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
rleft
R1 right z
rright -> 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
rright
gSumEnum :: forall a o.
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 =
forall (name :: * -> *) a (names :: * -> *).
Aliases name a -> Aliases names a -> Aliases (name :+: names) a
BranchTree (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) (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 :: forall (n :: * -> *) (m2 :: * -> *) a (m1 :: * -> *) z.
(Functor n, Applicative m2) =>
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (forall b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (forall (m1 :: * -> *) (m2 :: * -> *) v. v -> Slots m1 m2 v
ZeroSlots (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall k (p :: k). U1 p
U1)))
gFromSum :: forall a o z.
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 :: forall a o.
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (a
fieldName, [])
instance (c v) => GSum c (C1 x (S1 y (Rec0 v))) where
gToSum :: forall (n :: * -> *) (m2 :: * -> *) a (m1 :: * -> *) z.
(Functor n, Applicative m2) =>
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (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 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 b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (forall (m1 :: * -> *) (m2 :: * -> *) v. m1 v -> Slots m1 m2 v
SingleSlot forall v. c v => m1 v
parseSlot1))
gFromSum :: forall a o z.
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, [forall v. c v => v -> o
renderSlot v
slots])
gSumEnum :: forall a o.
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (a
fieldName, [forall v. c v => Proxy v -> o
renderSlot (forall {k} (t :: k). Proxy t
Proxy @v)])
instance (GSumSlots c (left :*: right)) => GSum c (C1 x (left :*: right)) where
gToSum :: forall (n :: * -> *) (m2 :: * -> *) a (m1 :: * -> *) z.
(Functor n, Applicative m2) =>
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (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 b. a -> Slots m1 m2 b -> n b
parseBranch a
fieldName (forall (m1 :: * -> *) (m2 :: * -> *) v. m2 v -> Slots m1 m2 v
ManySlots (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 :: forall a o z.
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 {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 :: forall a o.
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 =
forall (name :: Symbol) a (names :: FixityI) (y :: Bool)
(v :: * -> *).
KnownSymbol name =>
a -> Aliases (C1 ('MetaCons name names y) v) a
Branch (a
fieldName, 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]
:: (forall v. c v => Proxy v -> o) -> [o]
instance c v => GSumSlots c (S1 y (Rec0 v)) where
gToSumSlots :: forall (m :: * -> *) (z :: k).
Applicative m =>
(forall v. c v => m v) -> m (S1 y (Rec0 v) z)
gToSumSlots forall v. c v => m v
parseSlot = 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. c v => m v
parseSlot
gFromSumSlots :: forall o (z :: k).
(forall v. c v => v -> o) -> S1 y (Rec0 v) z -> [o]
gFromSumSlots forall v. c v => v -> o
renderSlot (M1 (K1 v
v)) = [forall v. c v => v -> o
renderSlot v
v]
gSumEnumSlots :: forall o. (forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots forall v. c v => Proxy v -> o
renderSlot = [forall v. c v => Proxy v -> o
renderSlot (forall {k} (t :: k). Proxy t
Proxy @v)]
instance
( GSumSlots c left,
GSumSlots c right
) =>
GSumSlots c (left :*: right)
where
gToSumSlots :: forall (m :: * -> *) (z :: k).
Applicative m =>
(forall v. c v => m v) -> m ((:*:) left right z)
gToSumSlots forall v. c v => m v
parseSlot =
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 o (z :: k).
(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 {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 forall a. [a] -> [a] -> [a]
++ 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 o. (forall v. c v => Proxy v -> o) -> [o]
gSumEnumSlots forall v. c v => Proxy v -> o
renderSlot =
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 forall a. [a] -> [a] -> [a]
++ 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