Safe Haskell | None |
---|---|
Language | Haskell2010 |
Utilities for declaring and documenting entry points.
Synopsis
- data DEntrypoint (kind :: Type) = DEntrypoint {}
- data DEntrypointReference = DEntrypointReference Text Anchor
- class EntryArrow kind name body where
- data PlainEntrypointsKind
- diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown
- data DEntrypointArg = DEntrypointArg {
- epaArg :: Maybe DType
- epaBuilding :: [ParamBuildingStep]
- epaType :: Type
- data DType where
- DType :: forall a. TypeHasDoc a => Proxy a -> DType
- class KnownSymbol con => DeriveCtorFieldDoc con (cf :: CtorField) where
- newtype ParamBuilder = ParamBuilder {
- unParamBuilder :: Markdown -> Markdown
- data ParamBuildingDesc = ParamBuildingDesc {}
- data ParamBuildingStep
- mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep
- clarifyParamBuildingSteps :: ParamBuildingStep -> (inp :-> out) -> inp :-> out
- constructDEpArg :: forall arg. (TypeHasDoc arg, HasAnnotation arg, KnownValue arg) => DEntrypointArg
- emptyDEpArg :: DEntrypointArg
- mkUType :: forall (x :: T). SingI x => Notes x -> Type
- mkDEpUType :: forall t. (KnownValue t, HasAnnotation t) => Type
- mkDEntrypointArgSimple :: forall t. (KnownValue t, HasAnnotation t, TypeHasDoc t) => DEntrypointArg
- type DocumentEntrypoints kind a = (Generic a, GDocumentEntrypoints kind (Rep a))
- documentEntrypoint :: forall kind epName param s out. (KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param, HasAnnotation param, KnownValue param) => ((param & s) :-> out) -> (param & s) :-> out
- entryCase :: forall dt entrypointKind out inp clauses. (CaseTC dt out inp clauses, DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> IsoRecTuple clauses -> (dt & inp) :-> out
- entryCase_ :: forall dt entrypointKind out inp. (InstrCaseC dt, RMap (CaseClauses dt), DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt & inp) :-> out
- finalizeParamCallingDoc :: forall cp inp out. (NiceParameterFull cp, RequireSumType cp, HasCallStack) => ((cp ': inp) :-> out) -> (cp ': inp) :-> out
- areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool
- entryCaseSimple_ :: forall cp out inp. (InstrCaseC cp, RMap (CaseClauses cp), DocumentEntrypoints PlainEntrypointsKind cp, NiceParameterFull cp, RequireFlatParamEps cp) => Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp & inp) :-> out
- entryCaseSimple :: forall cp out inp clauses. (CaseTC cp out inp clauses, DocumentEntrypoints PlainEntrypointsKind cp, NiceParameterFull cp, RequireFlatParamEps cp) => IsoRecTuple clauses -> (cp & inp) :-> out
- type family RequireFlatParamEps cp :: Constraint where ...
- type family RequireFlatEpDerivation cp deriv :: Constraint where ...
Documentation
data DEntrypoint (kind :: Type) Source #
Gathers information about single entrypoint.
We assume that entry points might be of different kinds,
which is designated by phantom type parameter.
For instance, you may want to have several groups of entry points
corresponding to various parts of a contract - specifying different kind
type argument for each of those groups will allow you defining different
DocItem
instances with appropriate custom descriptions for them.
Instances
data DEntrypointReference Source #
DEntrypointReference Text Anchor |
Instances
DocItem DEntrypointReference Source # | |
Defined in Lorentz.Entrypoints.Doc type DocItemPlacement DEntrypointReference :: DocItemPlacementKind # type DocItemReferenced DEntrypointReference :: DocItemReferencedKind # docItemPos :: Natural # docItemSectionName :: Maybe Text # docItemSectionDescription :: Maybe Markdown # docItemSectionNameStyle :: DocSectionNameStyle # docItemRef :: DEntrypointReference -> DocItemRef (DocItemPlacement DEntrypointReference) (DocItemReferenced DEntrypointReference) # docItemToMarkdown :: HeaderLevel -> DEntrypointReference -> Markdown # docItemToToc :: HeaderLevel -> DEntrypointReference -> Markdown # docItemDependencies :: DEntrypointReference -> [SomeDocDefinitionItem] # docItemsOrder :: [DEntrypointReference] -> [DEntrypointReference] # | |
type DocItemPlacement DEntrypointReference Source # | |
Defined in Lorentz.Entrypoints.Doc | |
type DocItemReferenced DEntrypointReference Source # | |
Defined in Lorentz.Entrypoints.Doc |
class EntryArrow kind name body where Source #
Provides arror for convenient entrypoint documentation
(#->) :: (Label name, Proxy kind) -> body -> body Source #
Lift entrypoint implementation.
Entrypoint names should go with "e" prefix.
Instances
(name ~ AppendSymbol "e" epName, body ~ ((param & s) :-> out), KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param, HasAnnotation param, KnownValue param) => EntryArrow (kind :: Type) name body Source # | |
data PlainEntrypointsKind Source #
Default value for DEntrypoint
type argument.
Instances
diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown Source #
Default implementation of docItemToMarkdown
for entry points.
data DEntrypointArg Source #
Describes argument of an entrypoint.
DEntrypointArg | |
|
Instances
DocItem DEntrypointArg Source # | |
Defined in Lorentz.Entrypoints.Doc type DocItemPlacement DEntrypointArg :: DocItemPlacementKind # type DocItemReferenced DEntrypointArg :: DocItemReferencedKind # docItemPos :: Natural # docItemSectionName :: Maybe Text # docItemSectionDescription :: Maybe Markdown # docItemSectionNameStyle :: DocSectionNameStyle # docItemRef :: DEntrypointArg -> DocItemRef (DocItemPlacement DEntrypointArg) (DocItemReferenced DEntrypointArg) # docItemToMarkdown :: HeaderLevel -> DEntrypointArg -> Markdown # docItemToToc :: HeaderLevel -> DEntrypointArg -> Markdown # docItemDependencies :: DEntrypointArg -> [SomeDocDefinitionItem] # docItemsOrder :: [DEntrypointArg] -> [DEntrypointArg] # | |
type DocItemPlacement DEntrypointArg Source # | |
Defined in Lorentz.Entrypoints.Doc | |
type DocItemReferenced DEntrypointArg Source # | |
Defined in Lorentz.Entrypoints.Doc |
DType :: forall a. TypeHasDoc a => Proxy a -> DType |
Instances
Eq DType | |
Ord DType | |
Show DType | |
DocItem DType | |
Defined in Michelson.Typed.Haskell.Doc type DocItemPlacement DType :: DocItemPlacementKind # type DocItemReferenced DType :: DocItemReferencedKind # docItemPos :: Natural # docItemSectionName :: Maybe Text # docItemSectionDescription :: Maybe Markdown # docItemSectionNameStyle :: DocSectionNameStyle # docItemRef :: DType -> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType) # docItemToMarkdown :: HeaderLevel -> DType -> Markdown # docItemToToc :: HeaderLevel -> DType -> Markdown # docItemDependencies :: DType -> [SomeDocDefinitionItem] # docItemsOrder :: [DType] -> [DType] # | |
type DocItemPlacement DType | |
Defined in Michelson.Typed.Haskell.Doc | |
type DocItemReferenced DType | |
Defined in Michelson.Typed.Haskell.Doc |
class KnownSymbol con => DeriveCtorFieldDoc con (cf :: CtorField) where Source #
Pick a type documentation from CtorField
.
Instances
KnownSymbol con => DeriveCtorFieldDoc con 'NoFields Source # | |
Defined in Lorentz.Entrypoints.Doc | |
(TypeHasDoc ty, HasAnnotation ty, KnownValue ty, KnownSymbol con) => DeriveCtorFieldDoc con ('OneField ty) Source # | |
Defined in Lorentz.Entrypoints.Doc |
newtype ParamBuilder Source #
When describing the way of parameter construction - piece of incremental builder for this description.
ParamBuilder | |
|
Instances
Eq ParamBuilder Source # | |
Defined in Lorentz.Entrypoints.Doc (==) :: ParamBuilder -> ParamBuilder -> Bool # (/=) :: ParamBuilder -> ParamBuilder -> Bool # | |
Show ParamBuilder Source # | |
Defined in Lorentz.Entrypoints.Doc showsPrec :: Int -> ParamBuilder -> ShowS # show :: ParamBuilder -> String # showList :: [ParamBuilder] -> ShowS # | |
Buildable ParamBuilder Source # | |
Defined in Lorentz.Entrypoints.Doc build :: ParamBuilder -> Builder # |
data ParamBuildingDesc Source #
ParamBuildingDesc | |
|
Instances
Eq ParamBuildingDesc Source # | |
Defined in Lorentz.Entrypoints.Doc (==) :: ParamBuildingDesc -> ParamBuildingDesc -> Bool # (/=) :: ParamBuildingDesc -> ParamBuildingDesc -> Bool # | |
Show ParamBuildingDesc Source # | |
Defined in Lorentz.Entrypoints.Doc showsPrec :: Int -> ParamBuildingDesc -> ShowS # show :: ParamBuildingDesc -> String # showList :: [ParamBuildingDesc] -> ShowS # |
data ParamBuildingStep Source #
Describes a parameter building step.
This can be wrapping into (Haskell) constructor, or a more complex transformation.
PbsWrapIn Text ParamBuildingDesc | Wraps something into constructor with given name.
Constructor should be the one which corresponds to an entrypoint
defined via field annotation, for more complex cases use |
PbsCallEntrypoint EpName | Directly call an entrypoint marked with a field annotation. |
PbsCustom ParamBuildingDesc | Other action. |
PbsUncallable [ParamBuildingStep] | This entrypoint cannot be called, which is possible when an explicit
default entrypoint is present. This is not a true entrypoint but just some
intermediate node in It contains dummy |
Instances
Eq ParamBuildingStep Source # | |
Defined in Lorentz.Entrypoints.Doc (==) :: ParamBuildingStep -> ParamBuildingStep -> Bool # (/=) :: ParamBuildingStep -> ParamBuildingStep -> Bool # | |
Show ParamBuildingStep Source # | |
Defined in Lorentz.Entrypoints.Doc showsPrec :: Int -> ParamBuildingStep -> ShowS # show :: ParamBuildingStep -> String # showList :: [ParamBuildingStep] -> ShowS # | |
Buildable ParamBuildingStep Source # | |
Defined in Lorentz.Entrypoints.Doc build :: ParamBuildingStep -> Builder # |
mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep Source #
Make a ParamBuildingStep
that tells about wrapping an argument into
a constructor with given name and uses given ParamBuilder
as description of
Michelson part.
clarifyParamBuildingSteps :: ParamBuildingStep -> (inp :-> out) -> inp :-> out Source #
Go over contract code and update every occurrence of DEntrypointArg
documentation item, adding the given step to its "how to build parameter"
description.
constructDEpArg :: forall arg. (TypeHasDoc arg, HasAnnotation arg, KnownValue arg) => DEntrypointArg Source #
mkDEpUType :: forall t. (KnownValue t, HasAnnotation t) => Type Source #
mkDEntrypointArgSimple :: forall t. (KnownValue t, HasAnnotation t, TypeHasDoc t) => DEntrypointArg Source #
type DocumentEntrypoints kind a = (Generic a, GDocumentEntrypoints kind (Rep a)) Source #
Constraint for documentEntrypoints
.
documentEntrypoint :: forall kind epName param s out. (KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param, HasAnnotation param, KnownValue param) => ((param & s) :-> out) -> (param & s) :-> out Source #
Wrapper for documenting single entrypoint which parameter isn't going to be unwrapped from some datatype.
entryCase
unwraps a datatype, however, sometimes we want to
have entrypoint parameter to be not wrapped into some datatype.
entryCase :: forall dt entrypointKind out inp clauses. (CaseTC dt out inp clauses, DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> IsoRecTuple clauses -> (dt & inp) :-> out Source #
Version of entryCase_
for tuples.
entryCase_ :: forall dt entrypointKind out inp. (InstrCaseC dt, RMap (CaseClauses dt), DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt & inp) :-> out Source #
Like case_
, to be used for pattern-matching on a parameter
or its part.
Modifies documentation accordingly. Including description of
entrypoints' arguments, thus for them you will need to supply
TypeHasDoc
instance.
finalizeParamCallingDoc :: forall cp inp out. (NiceParameterFull cp, RequireSumType cp, HasCallStack) => ((cp ': inp) :-> out) -> (cp ': inp) :-> out Source #
Modify param building steps with respect to entrypoints that given parameter declares.
Each contract with entrypoints should eventually call this function, otherwise, in case if contract uses built-in entrypoints feature, the resulting parameter building steps in the generated documentation will not consider entrypoints and thus may be incorrect.
Calling this twice over the same code is also prohibited.
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool Source #
Whether finalizeParamCallingDoc
has already been applied to these steps.
entryCaseSimple_ :: forall cp out inp. (InstrCaseC cp, RMap (CaseClauses cp), DocumentEntrypoints PlainEntrypointsKind cp, NiceParameterFull cp, RequireFlatParamEps cp) => Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp & inp) :-> out Source #
entryCaseSimple :: forall cp out inp clauses. (CaseTC cp out inp clauses, DocumentEntrypoints PlainEntrypointsKind cp, NiceParameterFull cp, RequireFlatParamEps cp) => IsoRecTuple clauses -> (cp & inp) :-> out Source #
Version of entryCase
for contracts with flat parameter, use it when you
need only one entryCase
all over the contract implementation.
This method calls finalizeParamCallingDoc
inside.
type family RequireFlatParamEps cp :: Constraint where ... Source #
RequireFlatParamEps cp = (RequireFlatEpDerivation cp (GetParameterEpDerivation cp), RequireSumType cp) |
type family RequireFlatEpDerivation cp deriv :: Constraint where ... Source #
RequireFlatEpDerivation _ EpdNone = () | |
RequireFlatEpDerivation _ EpdPlain = () | |
RequireFlatEpDerivation cp deriv = TypeError (('Text "Parameter is not flat" :$$: (('Text "For parameter `" :<>: 'ShowType cp) :<>: 'Text "`")) :$$: (('Text "With entrypoints derivation way `" :<>: 'ShowType deriv) :<>: 'Text "`")) |