module Lorentz.Entrypoints.Impl
(
EpdPlain
, EpdRecursive
, EpdDelegate
, EpdWithRoot
, PlainEntrypointsC
, EPTree (..)
, BuildEPTree
) where
import Data.Singletons (withSingI)
import Data.Vinyl.Core (Rec(..), (<+>))
import Data.Vinyl.Recursive (rmap)
import Fcf (Eval, Exp)
import Fcf qualified
import GHC.Generics qualified as G
import Morley.Util.TypeLits
import Prelude.Singletons (SBool(SFalse, STrue), (%==))
import Lorentz.Value
import Morley.Michelson.Typed
import Morley.Michelson.Typed.Haskell.Value (GValueType)
import Morley.Michelson.Untyped (FieldAnn, mkAnnotation, noAnn)
import Morley.Util.Fcf (Over2, TyEqSing, type (<|>))
import Morley.Util.Type
import Lorentz.Annotation
import Lorentz.Entrypoints.Core
import Lorentz.Entrypoints.Helpers
data EpdPlain
instance PlainEntrypointsC EpdPlain cp => EntrypointsDerivation EpdPlain cp where
type EpdAllEntrypoints EpdPlain cp = PlainAllEntrypointsExt EpdPlain cp
type EpdLookupEntrypoint EpdPlain cp = PlainLookupEntrypointExt EpdPlain cp
epdNotes :: (Notes (ToT cp), RootAnn)
epdNotes = (forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack) =>
Notes (ToT cp)
plainEpdNotesExt @EpdPlain @cp, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
epdCall :: forall (name :: Symbol).
ParameterScope (ToT cp) =>
Label name
-> EpConstructionRes
(ToT cp) (Eval (EpdLookupEntrypoint EpdPlain cp name))
epdCall = forall mode cp (name :: Symbol).
(PlainEntrypointsC mode cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp)
(Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt @EpdPlain @cp
epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints EpdPlain cp)
epdDescs = forall mode cp.
PlainEntrypointsC mode cp =>
Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt @EpdPlain @cp
data EpdRecursive
instance PlainEntrypointsC EpdRecursive cp => EntrypointsDerivation EpdRecursive cp where
type EpdAllEntrypoints EpdRecursive cp = PlainAllEntrypointsExt EpdRecursive cp
type EpdLookupEntrypoint EpdRecursive cp = PlainLookupEntrypointExt EpdRecursive cp
epdNotes :: (Notes (ToT cp), RootAnn)
epdNotes = (forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack) =>
Notes (ToT cp)
plainEpdNotesExt @EpdRecursive @cp, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
epdCall :: forall (name :: Symbol).
ParameterScope (ToT cp) =>
Label name
-> EpConstructionRes
(ToT cp) (Eval (EpdLookupEntrypoint EpdRecursive cp name))
epdCall = forall mode cp (name :: Symbol).
(PlainEntrypointsC mode cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp)
(Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt @EpdRecursive @cp
epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints EpdRecursive cp)
epdDescs = forall mode cp.
PlainEntrypointsC mode cp =>
Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt @EpdRecursive @cp
data EpdDelegate
instance (PlainEntrypointsC EpdDelegate cp) => EntrypointsDerivation EpdDelegate cp where
type EpdAllEntrypoints EpdDelegate cp = PlainAllEntrypointsExt EpdDelegate cp
type EpdLookupEntrypoint EpdDelegate cp = PlainLookupEntrypointExt EpdDelegate cp
epdNotes :: (Notes (ToT cp), RootAnn)
epdNotes = (forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack) =>
Notes (ToT cp)
plainEpdNotesExt @EpdDelegate @cp, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
epdCall :: forall (name :: Symbol).
ParameterScope (ToT cp) =>
Label name
-> EpConstructionRes
(ToT cp) (Eval (EpdLookupEntrypoint EpdDelegate cp name))
epdCall = forall mode cp (name :: Symbol).
(PlainEntrypointsC mode cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp)
(Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt @EpdDelegate @cp
epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints EpdDelegate cp)
epdDescs = forall mode cp.
PlainEntrypointsC mode cp =>
Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt @EpdDelegate @cp
data EpdWithRoot (r :: Symbol) epd
instance (KnownSymbol r, PlainEntrypointsC deriv cp) => EntrypointsDerivation (EpdWithRoot r deriv) cp where
type EpdAllEntrypoints (EpdWithRoot r deriv) cp =
'(r, cp) ': PlainAllEntrypointsExt deriv cp
type EpdLookupEntrypoint (EpdWithRoot r deriv) cp =
Fcf.Case
'[ Fcf.Is (TyEqSing r) ('Just cp)
, Fcf.Else (PlainLookupEntrypointExt deriv cp)
]
epdNotes :: (Notes (ToT cp), RootAnn)
epdNotes = (forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack) =>
Notes (ToT cp)
plainEpdNotesExt @deriv @cp, Either Text RootAnn -> RootAnn
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text RootAnn -> RootAnn)
-> (Text -> Either Text RootAnn) -> Text -> RootAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text RootAnn
forall {k} (a :: k). Text -> Either Text (Annotation a)
mkAnnotation (Text -> RootAnn) -> Text -> RootAnn
forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @r)
epdCall :: forall (name :: Symbol).
ParameterScope (ToT cp) =>
Label name
-> EpConstructionRes
(ToT cp) (Eval (EpdLookupEntrypoint (EpdWithRoot r deriv) cp name))
epdCall label :: Label name
label@(Label name
Label :: Label name) = case forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @r Sing r -> Sing name -> Sing (Apply (Apply (==@#@$) r) name)
forall a (t1 :: a) (t2 :: a).
SEq a =>
Sing t1 -> Sing t2 -> Sing (Apply (Apply (==@#@$) t1) t2)
%== forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @name of
Sing (Apply (Apply (==@#@$) r) name)
SBool (DefaultEq r name)
STrue -> EpLiftSequence (ToT cp) (GValueType (Rep cp))
-> EpConstructionRes (GValueType (Rep cp)) ('Just cp)
forall arg (param :: T).
ParameterScope (ToT arg) =>
EpLiftSequence (ToT arg) param
-> EpConstructionRes param ('Just arg)
EpConstructed EpLiftSequence (ToT cp) (GValueType (Rep cp))
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
Sing (Apply (Apply (==@#@$) r) name)
SBool (DefaultEq r name)
SFalse -> forall mode cp (name :: Symbol).
(PlainEntrypointsC mode cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp)
(Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt @deriv @cp Label name
label
epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints (EpdWithRoot r deriv) cp)
epdDescs =
(forall (ctor :: Symbol) (eps :: [(Symbol, *)]).
KnownSymbol ctor =>
Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep @r (Rec EpCallingDesc '[ '(r, cp)] -> Rec EpCallingDesc '[ '(r, cp)])
-> Rec EpCallingDesc '[ '(r, cp)] -> Rec EpCallingDesc '[ '(r, cp)]
forall a b. (a -> b) -> a -> b
$
EpCallingDesc :: forall arg (name :: Symbol).
Proxy arg
-> EpName -> [EpCallingStep] -> EpCallingDesc '(name, arg)
EpCallingDesc
{ epcdArg :: Proxy cp
epcdArg = Proxy cp
forall {k} (t :: k). Proxy t
Proxy
, epcdEntrypoint :: EpName
epcdEntrypoint = forall (ctor :: Symbol). (KnownSymbol ctor, HasCallStack) => EpName
ctorNameToEp @r
, epcdSteps :: [EpCallingStep]
epcdSteps = []
} EpCallingDesc '(r, cp)
-> Rec EpCallingDesc '[] -> Rec EpCallingDesc '[ '(r, cp)]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec EpCallingDesc '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
) Rec EpCallingDesc '[ '(r, cp)]
-> Rec
EpCallingDesc
(GAllEntrypoints
deriv (GBuildEntrypointsTree deriv (Rep cp)) (Rep cp))
-> Rec
EpCallingDesc
('[ '(r, cp)]
++ GAllEntrypoints
deriv (GBuildEntrypointsTree deriv (Rep cp)) (Rep cp))
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall mode cp.
PlainEntrypointsC mode cp =>
Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt @deriv @cp
type PlainAllEntrypointsExt mode cp = AllEntrypoints mode (BuildEPTree mode cp) cp
type PlainLookupEntrypointExt mode cp = LookupEntrypoint mode (BuildEPTree mode cp) cp
plainEpdNotesExt
:: forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack)
=> Notes (ToT cp)
plainEpdNotesExt :: forall mode cp.
(PlainEntrypointsC mode cp, HasCallStack) =>
Notes (ToT cp)
plainEpdNotesExt = forall mode (ep :: EPTree) a.
(EntrypointsNotes mode ep a, GenericIsoValue a, HasCallStack) =>
Notes (ToT a)
mkEntrypointsNotes @mode @(BuildEPTree mode cp) @cp
plainEpdCallExt
:: forall mode cp name.
(PlainEntrypointsC mode cp, ParameterScope (ToT cp))
=> Label name
-> EpConstructionRes (ToT cp) (Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt :: forall mode cp (name :: Symbol).
(PlainEntrypointsC mode cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp)
(Eval (LookupEntrypoint mode (BuildEPTree mode cp) cp name))
plainEpdCallExt = forall mode (ep :: EPTree) a (name :: Symbol).
(EntrypointsNotes mode ep a, ParameterScope (ToT a),
GenericIsoValue a) =>
Label name
-> EpConstructionRes
(ToT a) (Eval (LookupEntrypoint mode ep a name))
mkEpLiftSequence @mode @(BuildEPTree mode cp) @cp
plainEpdDescsExt
:: forall mode cp.
(PlainEntrypointsC mode cp)
=> Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt :: forall mode cp.
PlainEntrypointsC mode cp =>
Rec EpCallingDesc (PlainAllEntrypointsExt mode cp)
plainEpdDescsExt = forall mode (ep :: EPTree) a.
EntrypointsNotes mode ep a =>
Rec EpCallingDesc (AllEntrypoints mode ep a)
mkEpDescs @mode @(BuildEPTree mode cp) @cp
type PlainEntrypointsC mode cp =
( GenericIsoValue cp
, EntrypointsNotes mode (BuildEPTree mode cp) cp
, RequireSumType cp
)
data EPTree
= EPNode EPTree EPTree
| EPLeaf
| EPDelegate
type BuildEPTree mode a = GBuildEntrypointsTree mode (G.Rep a)
type family GBuildEntrypointsTree (mode :: Type) (x :: Type -> Type)
:: EPTree where
GBuildEntrypointsTree mode (G.D1 _ x) =
GBuildEntrypointsTree mode x
GBuildEntrypointsTree mode (x G.:+: y) =
'EPNode (GBuildEntrypointsTree mode x) (GBuildEntrypointsTree mode y)
GBuildEntrypointsTree _ G.V1 =
'EPLeaf
GBuildEntrypointsTree EpdPlain (G.C1 _ _) =
'EPLeaf
GBuildEntrypointsTree EpdRecursive (G.C1 _ x) =
GBuildEntrypointsTree EpdRecursive x
GBuildEntrypointsTree EpdDelegate (G.C1 _ (G.S1 _ (G.Rec0 _))) =
'EPDelegate
GBuildEntrypointsTree EpdDelegate (G.C1 _ _) =
'EPLeaf
GBuildEntrypointsTree mode (G.S1 _ x) =
GBuildEntrypointsTree mode x
GBuildEntrypointsTree _ G.U1 =
'EPLeaf
GBuildEntrypointsTree _ (_ G.:*: _) =
'EPLeaf
GBuildEntrypointsTree mode (G.Rec0 a) =
If (IsPrimitiveValue a)
'EPLeaf
(BuildEPTree mode a)
type EntrypointsNotes mode ep a = (Generic a, GEntrypointsNotes mode ep (G.Rep a))
mkEntrypointsNotes
:: forall mode ep a.
(EntrypointsNotes mode ep a, GenericIsoValue a, HasCallStack)
=> Notes (ToT a)
mkEntrypointsNotes :: forall mode (ep :: EPTree) a.
(EntrypointsNotes mode ep a, GenericIsoValue a, HasCallStack) =>
Notes (ToT a)
mkEntrypointsNotes = (Notes (GValueType (Rep a)), RootAnn) -> Notes (GValueType (Rep a))
forall a b. (a, b) -> a
fst ((Notes (GValueType (Rep a)), RootAnn)
-> Notes (GValueType (Rep a)))
-> (Notes (GValueType (Rep a)), RootAnn)
-> Notes (GValueType (Rep a))
forall a b. (a -> b) -> a -> b
$ forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @ep @(G.Rep a)
mkEpLiftSequence
:: forall mode ep a name.
( EntrypointsNotes mode ep a, ParameterScope (ToT a)
, GenericIsoValue a
)
=> Label name
-> EpConstructionRes (ToT a) (Eval (LookupEntrypoint mode ep a name))
mkEpLiftSequence :: forall mode (ep :: EPTree) a (name :: Symbol).
(EntrypointsNotes mode ep a, ParameterScope (ToT a),
GenericIsoValue a) =>
Label name
-> EpConstructionRes
(ToT a) (Eval (LookupEntrypoint mode ep a name))
mkEpLiftSequence = forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @ep @(G.Rep a)
mkEpDescs
:: forall mode ep a.
(EntrypointsNotes mode ep a)
=> Rec EpCallingDesc (AllEntrypoints mode ep a)
mkEpDescs :: forall mode (ep :: EPTree) a.
EntrypointsNotes mode ep a =>
Rec EpCallingDesc (AllEntrypoints mode ep a)
mkEpDescs = forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @ep @(G.Rep a)
type AllEntrypoints mode ep a = GAllEntrypoints mode ep (G.Rep a)
type LookupEntrypoint mode ep a = GLookupEntrypoint mode ep (G.Rep a)
class GEntrypointsNotes (mode :: Type) (ep :: EPTree) (x :: Type -> Type) where
type GAllEntrypoints mode ep x :: [(Symbol, Type)]
type GLookupEntrypoint mode ep x :: Symbol -> Exp (Maybe Type)
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType x), FieldAnn)
gMkEpLiftSequence
:: ParameterScope (GValueType x)
=> Label name
-> EpConstructionRes (GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkDescs
:: Rec EpCallingDesc (GAllEntrypoints mode ep x)
instance GEntrypointsNotes mode ep x => GEntrypointsNotes mode ep (G.D1 i x) where
type GAllEntrypoints mode ep (G.D1 i x) = GAllEntrypoints mode ep x
type GLookupEntrypoint mode ep (G.D1 i x) = GLookupEntrypoint mode ep x
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (D1 i x)), RootAnn)
gMkEntrypointsNotes = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @ep @x
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (D1 i x)) =>
Label name
-> EpConstructionRes
(GValueType (D1 i x))
(Eval (GLookupEntrypoint mode ep (D1 i x) name))
gMkEpLiftSequence = forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @ep @x
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints mode ep (D1 i x))
gMkDescs = forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @ep @x
instance (GEntrypointsNotes mode epx x, GEntrypointsNotes mode epy y) =>
GEntrypointsNotes mode ('EPNode epx epy) (x G.:+: y) where
type GAllEntrypoints mode ('EPNode epx epy) (x G.:+: y) =
GAllEntrypoints mode epx x ++ GAllEntrypoints mode epy y
type GLookupEntrypoint mode ('EPNode epx epy) (x G.:+: y) =
Over2 (<|>) (GLookupEntrypoint mode epx x) (GLookupEntrypoint mode epy y)
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (x :+: y)), RootAnn)
gMkEntrypointsNotes =
let (Notes (GValueType x)
xnotes, RootAnn
xann) = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @epx @x
(Notes (GValueType y)
ynotes, RootAnn
yann) = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @epy @y
in (TypeAnn
-> RootAnn
-> RootAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TOr (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> RootAnn -> RootAnn -> Notes p -> Notes q -> Notes ('TOr p q)
NTOr TypeAnn
forall {k} (a :: k). Annotation a
noAnn RootAnn
xann RootAnn
yann Notes (GValueType x)
xnotes Notes (GValueType y)
ynotes, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (x :+: y)) =>
Label name
-> EpConstructionRes
(GValueType (x :+: y))
(Eval (GLookupEntrypoint mode ('EPNode epx epy) (x :+: y) name))
gMkEpLiftSequence Label name
label =
case forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @(GValueType (x G.:+: y)) of
STOr Sing n1
sl Sing n2
sr -> Sing (GValueType x)
-> (SingI (GValueType x) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name)))
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n1
Sing (GValueType x)
sl ((SingI (GValueType x) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> (SingI (GValueType x) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name)))
forall a b. (a -> b) -> a -> b
$ Sing (GValueType y)
-> (SingI (GValueType y) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name)))
forall {k} (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n2
Sing (GValueType y)
sr ((SingI (GValueType y) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> (SingI (GValueType y) =>
EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name))))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name)))
forall a b. (a -> b) -> a -> b
$ case (Sing (GValueType x) -> OpPresence (GValueType x)
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing n1
Sing (GValueType x)
sl, Sing (GValueType x) -> NestedBigMapsPresence (GValueType x)
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing n1
Sing (GValueType x)
sl) of
(OpPresence (GValueType x)
OpAbsent, NestedBigMapsPresence (GValueType x)
NestedBigMapsAbsent) ->
case forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @epx @x Label name
label of
EpConstructed EpLiftSequence (ToT arg) (GValueType x)
liftSeq -> EpLiftSequence (ToT arg) ('TOr (GValueType x) (GValueType y))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y)) ('Just arg)
forall arg (param :: T).
ParameterScope (ToT arg) =>
EpLiftSequence (ToT arg) param
-> EpConstructionRes param ('Just arg)
EpConstructed (EpLiftSequence (ToT arg) (GValueType x)
-> EpLiftSequence (ToT arg) ('TOr (GValueType x) (GValueType y))
forall (subparam :: T) (r :: T) (arg :: T).
(SingI subparam, SingI r) =>
EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr subparam r)
EplWrapLeft EpLiftSequence (ToT arg) (GValueType x)
liftSeq)
EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode epx x name))
EpConstructionFailed ->
case forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @epy @y Label name
label of
EpConstructed EpLiftSequence (ToT arg) (GValueType y)
liftSeq -> EpLiftSequence (ToT arg) ('TOr (GValueType x) (GValueType y))
-> EpConstructionRes
('TOr (GValueType x) (GValueType y)) ('Just arg)
forall arg (param :: T).
ParameterScope (ToT arg) =>
EpLiftSequence (ToT arg) param
-> EpConstructionRes param ('Just arg)
EpConstructed (EpLiftSequence (ToT arg) (GValueType y)
-> EpLiftSequence (ToT arg) ('TOr (GValueType x) (GValueType y))
forall (l :: T) (subparam :: T) (arg :: T).
(SingI l, SingI subparam) =>
EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr l subparam)
EplWrapRight EpLiftSequence (ToT arg) (GValueType y)
liftSeq)
EpConstructionRes
(GValueType y) (Eval (GLookupEntrypoint mode epy y name))
EpConstructionFailed -> EpConstructionRes
('TOr (GValueType x) (GValueType y))
(Eval
(Eval (GLookupEntrypoint mode epx x name)
<|> Eval (GLookupEntrypoint mode epy y name)))
forall (param :: T). EpConstructionRes param 'Nothing
EpConstructionFailed
gMkDescs :: Rec
EpCallingDesc (GAllEntrypoints mode ('EPNode epx epy) (x :+: y))
gMkDescs =
forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @epx @x Rec EpCallingDesc (GAllEntrypoints mode epx x)
-> Rec EpCallingDesc (GAllEntrypoints mode epy y)
-> Rec
EpCallingDesc
(GAllEntrypoints mode epx x ++ GAllEntrypoints mode epy y)
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @epy @y
instance ( GHasAnnotation x, KnownSymbol ctor
, ToT (GExtractField x) ~ GValueType x
) =>
GEntrypointsNotes mode 'EPLeaf (G.C1 ('G.MetaCons ctor _1 _2) x) where
type GAllEntrypoints mode 'EPLeaf (G.C1 ('G.MetaCons ctor _1 _2) x) =
'[ '(ctor, GExtractField x) ]
type GLookupEntrypoint mode 'EPLeaf (G.C1 ('G.MetaCons ctor _1 _2) x) =
JustOnEq ctor (GExtractField x)
gMkEntrypointsNotes :: HasCallStack =>
(Notes (GValueType (C1 ('MetaCons ctor _1 _2) x)), RootAnn)
gMkEntrypointsNotes =
(forall (a :: * -> *).
GHasAnnotation a =>
AnnOptions
-> FollowEntrypointFlag
-> GenerateFieldAnnFlag
-> (Notes (GValueType a), RootAnn, VarAnn)
gGetAnnotation @x AnnOptions
forall a. Default a => a
def FollowEntrypointFlag
FollowEntrypoint GenerateFieldAnnFlag
NotGenerateFieldAnn (Notes (GValueType x), RootAnn, VarAnn)
-> Getting
(Notes (GValueType x))
(Notes (GValueType x), RootAnn, VarAnn)
(Notes (GValueType x))
-> Notes (GValueType x)
forall s a. s -> Getting a s a -> a
^. Getting
(Notes (GValueType x))
(Notes (GValueType x), RootAnn, VarAnn)
(Notes (GValueType x))
forall s t a b. Field1 s t a b => Lens s t a b
_1, forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
RootAnn
ctorNameToAnn @ctor)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (C1 ('MetaCons ctor _1 _2) x)) =>
Label name
-> EpConstructionRes
(GValueType (C1 ('MetaCons ctor _1 _2) x))
(Eval
(GLookupEntrypoint
mode 'EPLeaf (C1 ('MetaCons ctor _1 _2) x) name))
gMkEpLiftSequence (Label name
Label :: Label name) =
case forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @ctor Sing ctor -> Sing name -> Sing (Apply (Apply (==@#@$) ctor) name)
forall a (t1 :: a) (t2 :: a).
SEq a =>
Sing t1 -> Sing t2 -> Sing (Apply (Apply (==@#@$) t1) t2)
%== forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @name of
Sing (Apply (Apply (==@#@$) ctor) name)
SBool (DefaultEq ctor name)
STrue -> EpLiftSequence (ToT (GExtractField x)) (GValueType x)
-> EpConstructionRes (GValueType x) ('Just (GExtractField x))
forall arg (param :: T).
ParameterScope (ToT arg) =>
EpLiftSequence (ToT arg) param
-> EpConstructionRes param ('Just arg)
EpConstructed EpLiftSequence (ToT (GExtractField x)) (GValueType x)
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
Sing (Apply (Apply (==@#@$) ctor) name)
SBool (DefaultEq ctor name)
SFalse -> EpConstructionRes
(GValueType (C1 ('MetaCons ctor _1 _2) x))
(Eval
(GLookupEntrypoint
mode 'EPLeaf (C1 ('MetaCons ctor _1 _2) x) name))
forall (param :: T). EpConstructionRes param 'Nothing
EpConstructionFailed
gMkDescs :: Rec
EpCallingDesc
(GAllEntrypoints mode 'EPLeaf (C1 ('MetaCons ctor _1 _2) x))
gMkDescs = forall (ctor :: Symbol) (eps :: [(Symbol, *)]).
KnownSymbol ctor =>
Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep @ctor (Rec EpCallingDesc '[ '(ctor, GExtractField x)]
-> Rec EpCallingDesc '[ '(ctor, GExtractField x)])
-> Rec EpCallingDesc '[ '(ctor, GExtractField x)]
-> Rec EpCallingDesc '[ '(ctor, GExtractField x)]
forall a b. (a -> b) -> a -> b
$
EpCallingDesc :: forall arg (name :: Symbol).
Proxy arg
-> EpName -> [EpCallingStep] -> EpCallingDesc '(name, arg)
EpCallingDesc
{ epcdArg :: Proxy (GExtractField x)
epcdArg = Proxy (GExtractField x)
forall {k} (t :: k). Proxy t
Proxy
, epcdEntrypoint :: EpName
epcdEntrypoint = forall (ctor :: Symbol). (KnownSymbol ctor, HasCallStack) => EpName
ctorNameToEp @ctor
, epcdSteps :: [EpCallingStep]
epcdSteps = []
} EpCallingDesc '(ctor, GExtractField x)
-> Rec EpCallingDesc '[]
-> Rec EpCallingDesc '[ '(ctor, GExtractField x)]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec EpCallingDesc '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
instance (ep ~ 'EPNode epx epy, GEntrypointsNotes mode ep x, KnownSymbol ctor) =>
GEntrypointsNotes mode ('EPNode epx epy) (G.C1 ('G.MetaCons ctor _1 _2) x) where
type GAllEntrypoints mode ('EPNode epx epy) (G.C1 ('G.MetaCons ctor _1 _2) x) =
GAllEntrypoints mode ('EPNode epx epy) x
type GLookupEntrypoint mode ('EPNode epx epy) (G.C1 ('G.MetaCons ctor _1 _2) x) =
GLookupEntrypoint mode ('EPNode epx epy) x
gMkEntrypointsNotes :: HasCallStack =>
(Notes (GValueType (C1 ('MetaCons ctor _1 _2) x)), RootAnn)
gMkEntrypointsNotes = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @ep @x
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (C1 ('MetaCons ctor _1 _2) x)) =>
Label name
-> EpConstructionRes
(GValueType (C1 ('MetaCons ctor _1 _2) x))
(Eval
(GLookupEntrypoint
mode ('EPNode epx epy) (C1 ('MetaCons ctor _1 _2) x) name))
gMkEpLiftSequence = forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @ep @x
gMkDescs :: Rec
EpCallingDesc
(GAllEntrypoints
mode ('EPNode epx epy) (C1 ('MetaCons ctor _1 _2) x))
gMkDescs = forall (ctor :: Symbol) (eps :: [(Symbol, *)]).
KnownSymbol ctor =>
Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep @ctor (Rec EpCallingDesc (GAllEntrypoints mode ('EPNode epx epy) x)
-> Rec EpCallingDesc (GAllEntrypoints mode ('EPNode epx epy) x))
-> Rec EpCallingDesc (GAllEntrypoints mode ('EPNode epx epy) x)
-> Rec EpCallingDesc (GAllEntrypoints mode ('EPNode epx epy) x)
forall a b. (a -> b) -> a -> b
$ forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @ep @x
instance ( ep ~ 'EPDelegate, GEntrypointsNotes mode ep x
, KnownSymbol ctor, ToT (GExtractField x) ~ GValueType x
) =>
GEntrypointsNotes mode 'EPDelegate (G.C1 ('G.MetaCons ctor _1 _2) x) where
type GAllEntrypoints mode 'EPDelegate (G.C1 ('G.MetaCons ctor _1 _2) x) =
'(ctor, GExtractField x) ': GAllEntrypoints mode 'EPDelegate x
type GLookupEntrypoint mode 'EPDelegate (G.C1 ('G.MetaCons ctor _1 _2) x) =
Over2 (<|>) (JustOnEq ctor (GExtractField x)) (GLookupEntrypoint mode 'EPDelegate x)
gMkEntrypointsNotes :: HasCallStack =>
(Notes (GValueType (C1 ('MetaCons ctor _1 _2) x)), RootAnn)
gMkEntrypointsNotes =
let (Notes (GValueType x)
notes, RootAnn
_rootAnn) = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @ep @x
in (Notes (GValueType x)
Notes (GValueType (C1 ('MetaCons ctor _1 _2) x))
notes, forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
RootAnn
ctorNameToAnn @ctor)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (C1 ('MetaCons ctor _1 _2) x)) =>
Label name
-> EpConstructionRes
(GValueType (C1 ('MetaCons ctor _1 _2) x))
(Eval
(GLookupEntrypoint
mode 'EPDelegate (C1 ('MetaCons ctor _1 _2) x) name))
gMkEpLiftSequence label :: Label name
label@(Label name
Label :: Label name) =
case forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @ctor Sing ctor -> Sing name -> Sing (Apply (Apply (==@#@$) ctor) name)
forall a (t1 :: a) (t2 :: a).
SEq a =>
Sing t1 -> Sing t2 -> Sing (Apply (Apply (==@#@$) t1) t2)
%== forall {k} (a :: k). SingI a => Sing a
forall (a :: Symbol). SingI a => Sing a
sing @name of
Sing (Apply (Apply (==@#@$) ctor) name)
SBool (DefaultEq ctor name)
STrue -> EpLiftSequence (ToT (GExtractField x)) (GValueType x)
-> EpConstructionRes (GValueType x) ('Just (GExtractField x))
forall arg (param :: T).
ParameterScope (ToT arg) =>
EpLiftSequence (ToT arg) param
-> EpConstructionRes param ('Just arg)
EpConstructed EpLiftSequence (ToT (GExtractField x)) (GValueType x)
forall (arg :: T). EpLiftSequence arg arg
EplArgHere
Sing (Apply (Apply (==@#@$) ctor) name)
SBool (DefaultEq ctor name)
SFalse -> forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @ep @x Label name
label
gMkDescs :: Rec
EpCallingDesc
(GAllEntrypoints mode 'EPDelegate (C1 ('MetaCons ctor _1 _2) x))
gMkDescs = forall (ctor :: Symbol) (eps :: [(Symbol, *)]).
KnownSymbol ctor =>
Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep @ctor (Rec
EpCallingDesc
('(ctor, GExtractField x) : GAllEntrypoints mode 'EPDelegate x)
-> Rec
EpCallingDesc
('(ctor, GExtractField x) : GAllEntrypoints mode 'EPDelegate x))
-> Rec
EpCallingDesc
('(ctor, GExtractField x) : GAllEntrypoints mode 'EPDelegate x)
-> Rec
EpCallingDesc
('(ctor, GExtractField x) : GAllEntrypoints mode 'EPDelegate x)
forall a b. (a -> b) -> a -> b
$
EpCallingDesc :: forall arg (name :: Symbol).
Proxy arg
-> EpName -> [EpCallingStep] -> EpCallingDesc '(name, arg)
EpCallingDesc
{ epcdArg :: Proxy (GExtractField x)
epcdArg = Proxy (GExtractField x)
forall {k} (t :: k). Proxy t
Proxy
, epcdEntrypoint :: EpName
epcdEntrypoint = forall (ctor :: Symbol). (KnownSymbol ctor, HasCallStack) => EpName
ctorNameToEp @ctor
, epcdSteps :: [EpCallingStep]
epcdSteps = []
} EpCallingDesc '(ctor, GExtractField x)
-> Rec EpCallingDesc (GAllEntrypoints mode 'EPDelegate x)
-> Rec
EpCallingDesc
('(ctor, GExtractField x) : GAllEntrypoints mode 'EPDelegate x)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @ep @x
instance GEntrypointsNotes mode ep x => GEntrypointsNotes mode ep (G.S1 i x) where
type GAllEntrypoints mode ep (G.S1 i x) = GAllEntrypoints mode ep x
type GLookupEntrypoint mode ep (G.S1 i x) = GLookupEntrypoint mode ep x
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (S1 i x)), RootAnn)
gMkEntrypointsNotes = forall mode (ep :: EPTree) (x :: * -> *).
(GEntrypointsNotes mode ep x, HasCallStack) =>
(Notes (GValueType x), RootAnn)
gMkEntrypointsNotes @mode @ep @x
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (S1 i x)) =>
Label name
-> EpConstructionRes
(GValueType (S1 i x))
(Eval (GLookupEntrypoint mode ep (S1 i x) name))
gMkEpLiftSequence = forall mode (ep :: EPTree) (x :: * -> *) (name :: Symbol).
(GEntrypointsNotes mode ep x, ParameterScope (GValueType x)) =>
Label name
-> EpConstructionRes
(GValueType x) (Eval (GLookupEntrypoint mode ep x name))
gMkEpLiftSequence @mode @ep @x
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints mode ep (S1 i x))
gMkDescs = forall mode (ep :: EPTree) (x :: * -> *).
GEntrypointsNotes mode ep x =>
Rec EpCallingDesc (GAllEntrypoints mode ep x)
gMkDescs @mode @ep @x
instance (EntrypointsNotes EpdRecursive ep a, GenericIsoValue a) =>
GEntrypointsNotes EpdRecursive ep (G.Rec0 a) where
type GAllEntrypoints EpdRecursive ep (G.Rec0 a) = AllEntrypoints EpdRecursive ep a
type GLookupEntrypoint EpdRecursive ep (G.Rec0 a) = LookupEntrypoint EpdRecursive ep a
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (Rec0 a)), RootAnn)
gMkEntrypointsNotes = (forall mode (ep :: EPTree) a.
(EntrypointsNotes mode ep a, GenericIsoValue a, HasCallStack) =>
Notes (ToT a)
mkEntrypointsNotes @EpdRecursive @ep @a, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (Rec0 a)) =>
Label name
-> EpConstructionRes
(GValueType (Rec0 a))
(Eval (GLookupEntrypoint EpdRecursive ep (Rec0 a) name))
gMkEpLiftSequence = forall mode (ep :: EPTree) a (name :: Symbol).
(EntrypointsNotes mode ep a, ParameterScope (ToT a),
GenericIsoValue a) =>
Label name
-> EpConstructionRes
(ToT a) (Eval (LookupEntrypoint mode ep a name))
mkEpLiftSequence @EpdRecursive @ep @a
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints EpdRecursive ep (Rec0 a))
gMkDescs = forall mode (ep :: EPTree) a.
EntrypointsNotes mode ep a =>
Rec EpCallingDesc (AllEntrypoints mode ep a)
mkEpDescs @EpdRecursive @ep @a
instance (ParameterDeclaresEntrypoints a) =>
GEntrypointsNotes EpdDelegate 'EPDelegate (G.Rec0 a) where
type GAllEntrypoints EpdDelegate 'EPDelegate (G.Rec0 a) = AllParameterEntrypoints a
type GLookupEntrypoint EpdDelegate 'EPDelegate (G.Rec0 a) = LookupParameterEntrypoint a
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (Rec0 a)), RootAnn)
gMkEntrypointsNotes = ((Notes (ToT a), RootAnn) -> Notes (ToT a)
forall a b. (a, b) -> a
fst (forall cp.
ParameterDeclaresEntrypoints cp =>
(Notes (ToT cp), RootAnn)
pepNotes @a), RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (Rec0 a)) =>
Label name
-> EpConstructionRes
(GValueType (Rec0 a))
(Eval (GLookupEntrypoint EpdDelegate 'EPDelegate (Rec0 a) name))
gMkEpLiftSequence = forall cp (name :: Symbol).
(ParameterDeclaresEntrypoints cp, ParameterScope (ToT cp)) =>
Label name
-> EpConstructionRes
(ToT cp) (Eval (LookupParameterEntrypoint cp name))
pepCall @a
gMkDescs :: Rec
EpCallingDesc (GAllEntrypoints EpdDelegate 'EPDelegate (Rec0 a))
gMkDescs = forall cp.
ParameterDeclaresEntrypoints cp =>
Rec EpCallingDesc (AllParameterEntrypoints cp)
pepDescs @a
instance GEntrypointsNotes mode 'EPLeaf G.U1 where
type GAllEntrypoints mode 'EPLeaf G.U1 = '[]
type GLookupEntrypoint mode 'EPLeaf G.U1 = Fcf.ConstFn 'Nothing
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType U1), RootAnn)
gMkEntrypointsNotes = (Notes (GValueType U1)
forall (t :: T). SingI t => Notes t
starNotes, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType U1) =>
Label name
-> EpConstructionRes
(GValueType U1) (Eval (GLookupEntrypoint mode 'EPLeaf U1 name))
gMkEpLiftSequence Label name
_ = EpConstructionRes
(GValueType U1) (Eval (GLookupEntrypoint mode 'EPLeaf U1 name))
forall (param :: T). EpConstructionRes param 'Nothing
EpConstructionFailed
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf U1)
gMkDescs = Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf U1)
forall {u} (a :: u -> *). Rec a '[]
RNil
instance GEntrypointsNotes mode 'EPLeaf G.V1 where
type GAllEntrypoints mode 'EPLeaf G.V1 = '[]
type GLookupEntrypoint mode 'EPLeaf G.V1 = Fcf.ConstFn 'Nothing
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType V1), RootAnn)
gMkEntrypointsNotes = (Notes (GValueType V1)
forall (t :: T). SingI t => Notes t
starNotes, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType V1) =>
Label name
-> EpConstructionRes
(GValueType V1) (Eval (GLookupEntrypoint mode 'EPLeaf V1 name))
gMkEpLiftSequence Label name
_ = EpConstructionRes
(GValueType V1) (Eval (GLookupEntrypoint mode 'EPLeaf V1 name))
forall (param :: T). EpConstructionRes param 'Nothing
EpConstructionFailed
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf V1)
gMkDescs = Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf V1)
forall {u} (a :: u -> *). Rec a '[]
RNil
instance Each '[SingI] [GValueType x, GValueType y] =>
GEntrypointsNotes mode 'EPLeaf (x G.:*: y) where
type GAllEntrypoints mode 'EPLeaf (x G.:*: y) = '[]
type GLookupEntrypoint mode 'EPLeaf (x G.:*: y) = Fcf.ConstFn 'Nothing
gMkEntrypointsNotes :: HasCallStack => (Notes (GValueType (x :*: y)), RootAnn)
gMkEntrypointsNotes = (Notes (GValueType (x :*: y))
forall (t :: T). SingI t => Notes t
starNotes, RootAnn
forall {k} (a :: k). Annotation a
noAnn)
gMkEpLiftSequence :: forall (name :: Symbol).
ParameterScope (GValueType (x :*: y)) =>
Label name
-> EpConstructionRes
(GValueType (x :*: y))
(Eval (GLookupEntrypoint mode 'EPLeaf (x :*: y) name))
gMkEpLiftSequence Label name
_ = EpConstructionRes
(GValueType (x :*: y))
(Eval (GLookupEntrypoint mode 'EPLeaf (x :*: y) name))
forall (param :: T). EpConstructionRes param 'Nothing
EpConstructionFailed
gMkDescs :: Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf (x :*: y))
gMkDescs = Rec EpCallingDesc (GAllEntrypoints mode 'EPLeaf (x :*: y))
forall {u} (a :: u -> *). Rec a '[]
RNil
type family JustOnEq (a :: k1) (b :: k2) :: k1 -> Exp (Maybe k2) where
JustOnEq a b =
Fcf.Case
'[ Fcf.Is (TyEqSing a) ('Just b)
, Fcf.Any 'Nothing
]
type family (x :: Type -> Type) where
(G.S1 _ x) = GExtractField x
(G.Rec0 a) = a
G.U1 = ()
addDescStep
:: forall ctor eps.
KnownSymbol ctor
=> Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep :: forall (ctor :: Symbol) (eps :: [(Symbol, *)]).
KnownSymbol ctor =>
Rec EpCallingDesc eps -> Rec EpCallingDesc eps
addDescStep =
let step :: EpCallingStep
step = Text -> EpCallingStep
EpsWrapIn (Text -> EpCallingStep) -> Text -> EpCallingStep
forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @ctor
in (forall (x :: (Symbol, *)). EpCallingDesc x -> EpCallingDesc x)
-> Rec EpCallingDesc eps -> Rec EpCallingDesc eps
forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap ((forall (x :: (Symbol, *)). EpCallingDesc x -> EpCallingDesc x)
-> Rec EpCallingDesc eps -> Rec EpCallingDesc eps)
-> (forall (x :: (Symbol, *)). EpCallingDesc x -> EpCallingDesc x)
-> Rec EpCallingDesc eps
-> Rec EpCallingDesc eps
forall a b. (a -> b) -> a -> b
$ \EpCallingDesc{[EpCallingStep]
Proxy arg
EpName
epcdSteps :: [EpCallingStep]
epcdEntrypoint :: EpName
epcdArg :: Proxy arg
epcdSteps :: forall arg (name :: Symbol).
EpCallingDesc '(name, arg) -> [EpCallingStep]
epcdEntrypoint :: forall arg (name :: Symbol). EpCallingDesc '(name, arg) -> EpName
epcdArg :: forall arg (name :: Symbol).
EpCallingDesc '(name, arg) -> Proxy arg
..} ->
EpCallingDesc :: forall arg (name :: Symbol).
Proxy arg
-> EpName -> [EpCallingStep] -> EpCallingDesc '(name, arg)
EpCallingDesc{ epcdSteps :: [EpCallingStep]
epcdSteps = EpCallingStep
step EpCallingStep -> [EpCallingStep] -> [EpCallingStep]
forall a. a -> [a] -> [a]
: [EpCallingStep]
epcdSteps, Proxy arg
EpName
epcdEntrypoint :: EpName
epcdArg :: Proxy arg
epcdEntrypoint :: EpName
epcdArg :: Proxy arg
.. }