{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Lorentz.Entrypoints.Doc
( DEntrypoint (..)
, pattern DEntrypointDocItem
, EntrypointKindHasDoc (..)
, entrypointSection
, DEntrypointReference (..)
, EntryArrow (..)
, PlainEntrypointsKind
, FlattenedEntrypointsKind
, FlattenedEntrypointsKindHiding
, CommonContractBehaviourKind
, CommonEntrypointsBehaviourKind
, diEntrypointToMarkdown
, SomeEntrypointArg (..)
, DEntrypointArg (..)
, DType (..)
, DeriveCtorFieldDoc (..)
, ParamBuilder (..)
, ParamBuildingDesc (..)
, ParamBuildingStep (..)
, mkPbsWrapIn
, clarifyParamBuildingSteps
, emptyDEpArg
, mkUType
, mkDEpUType
, mkDEntrypointArgSimple
, DocumentEntrypoints
, documentEntrypoint
, entryCase
, entryCase_
, finalizeParamCallingDoc
, finalizeParamCallingDoc'
, areFinalizedParamBuildingSteps
, entryCaseSimple_
, entryCaseSimple
, entryCaseFlattened_
, entryCaseFlattened
, entryCaseFlattenedHiding_
, entryCaseFlattenedHiding
, RequireFlatParamEps
, RequireFlatEpDerivation
) where
import Control.Lens.Cons (_head)
import Data.Char (toLower)
import Data.Constraint (Dict(..))
import Data.Map qualified as Map
import Data.Singletons (fromSing)
import Data.Text qualified as T
import Data.Vinyl.Core (RMap)
import Fcf (IsJust, type (@@))
import Fmt (Buildable(..), build, fmt, listF)
import GHC.Generics ((:+:))
import GHC.Generics qualified as G
import Lorentz.ADT
import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints
import Lorentz.Doc
import Lorentz.Entrypoints.Core
import Lorentz.Entrypoints.Helpers
import Lorentz.Entrypoints.Impl
import Morley.Michelson.Printer (printTypedValue)
import Morley.Michelson.Printer.Util (RenderDoc(..), needsParens, printDocB)
import Morley.Michelson.Typed (EpName, ToT, mkUType, pattern DefEpName, sampleTypedValue, sing)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Haskell.Doc
import Morley.Michelson.Typed.Haskell.Instr
import Morley.Michelson.Untyped qualified as Untyped
import Morley.Util.Label (Label)
import Morley.Util.Markdown
import Morley.Util.Type
import Morley.Util.TypeLits
import Morley.Util.TypeTuple
import Morley.Util.Typeable
data DEntrypoint (kind :: Type) = DEntrypoint
{ forall kind. DEntrypoint kind -> Text
depName :: Text
, forall kind. DEntrypoint kind -> SubDoc
depSub :: SubDoc
}
pattern DEntrypointDocItem :: DEntrypoint kind -> SomeDocItem
pattern $mDEntrypointDocItem :: forall {r}.
SomeDocItem
-> (forall {kind}. DEntrypoint kind -> r) -> (Void# -> r) -> r
DEntrypointDocItem dep <- SomeDocItem (castIgnoringPhantom -> Just dep)
diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown :: forall level. HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown HeaderLevel
lvl (DEntrypoint Text
name SubDoc
block) =
Markdown
mdSeparator Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
lvl (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> (Text -> Markdown) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> (Text -> Text) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Text Text Char Char -> (Char -> Char) -> Text -> Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Text Text Char Char
forall s a. Cons s s a a => Traversal' s a
_head Char -> Char
toLower (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Text
name) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
( SubDoc -> Markdown -> Markdown
modifyExample SubDoc
block
(Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown (HeaderLevel -> HeaderLevel
nextHeaderLevel HeaderLevel
lvl)
(SubDoc -> Markdown) -> SubDoc -> Markdown
forall a b. (a -> b) -> a -> b
$ SubDoc -> SubDoc
filterDEntrypointExample SubDoc
block
)
where
filterDEntrypointExample :: SubDoc -> SubDoc
filterDEntrypointExample (SubDoc DocBlock
subdoc) =
DocBlock -> SubDoc
SubDoc (DocBlock -> SubDoc) -> DocBlock -> SubDoc
forall a b. (a -> b) -> a -> b
$ DocItemPos -> DocBlock -> DocBlock
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall d. DocItem d => DocItemPos
docItemPosition @DEntrypointExample) DocBlock
subdoc
modifyExample :: SubDoc -> Markdown -> Markdown
modifyExample :: SubDoc -> Markdown -> Markdown
modifyExample (SubDoc DocBlock
sub) Markdown
subDocMd =
case (DocItemPos -> DocBlock -> Maybe DocSection
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall d. DocItem d => DocItemPos
docItemPosition @DEntrypointExample) DocBlock
sub) of
Just (DocSection ((DocElem d
b Maybe SubDoc
_ ) :| [DocElem d]
_)) ->
Markdown -> Markdown -> Markdown
mdFindExampleIdAndReplace
(HeaderLevel -> d -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdown (Int -> HeaderLevel
HeaderLevel Int
0) (d -> Markdown) -> d -> Markdown
forall a b. (a -> b) -> a -> b
$ d
b)
Markdown
subDocMd
Maybe DocSection
Nothing -> Markdown
subDocMd
mdFindExampleIdAndReplace :: Markdown -> Markdown -> Markdown
mdFindExampleIdAndReplace :: Markdown -> Markdown -> Markdown
mdFindExampleIdAndReplace Markdown
replaceTxt Markdown
inputText =
Text -> Markdown
forall p. Buildable p => p -> Markdown
build
(Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines
([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\Text
w -> case Text -> Text -> DocItemReferencedKind
T.isInfixOf (Text
"id=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (forall b. FromBuilder b => Markdown -> b
fmt @Text Markdown
exampleId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") Text
w of
DocItemReferencedKind
True -> forall b. FromBuilder b => Markdown -> b
fmt @Text (Markdown -> Text) -> Markdown -> Text
forall a b. (a -> b) -> a -> b
$ Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Example" (Markdown -> Markdown -> Markdown
mdAddId Markdown
exampleId (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> Markdown
mdTicked Markdown
replaceTxt)
DocItemReferencedKind
False -> Text
w
)
(Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
lines (forall b. FromBuilder b => Markdown -> b
fmt @Text Markdown
inputText)
where
exampleId :: Markdown
exampleId = Markdown
"example-id"
class Typeable ep => EntrypointKindHasDoc (ep :: Type) where
type EntrypointKindOverride ep
type EntrypointKindOverride ep = ep
entrypointKindOverrideSpecified :: Dict ((EntrypointKindOverride ep == ep) ~ False)
entrypointKindOverrideSpecified = Text -> Dict ((EntrypointKindOverride ep == ep) ~ 'False)
forall a. HasCallStack => Text -> a
error Text
"Called entrypointKindOverrideSpecified"
entrypointKindPos :: Natural
default entrypointKindPos :: EntrypointKindHasDoc (EntrypointKindOverride ep) => Natural
entrypointKindPos = forall ep. EntrypointKindHasDoc ep => Natural
entrypointKindPos @(EntrypointKindOverride ep)
entrypointKindSectionName :: Text
default entrypointKindSectionName :: EntrypointKindHasDoc (EntrypointKindOverride ep) => Text
entrypointKindSectionName = forall ep. EntrypointKindHasDoc ep => Text
entrypointKindSectionName @(EntrypointKindOverride ep)
entrypointKindSectionDescription :: Maybe Markdown
entrypointKindSectionDescription = Maybe Markdown
forall a. Maybe a
Nothing
{-# MINIMAL entrypointKindOverrideSpecified | (entrypointKindPos, entrypointKindSectionName) #-}
{-# WARNING entrypointKindOverrideSpecified "Normally you should never need to use this function" #-}
instance EntrypointKindHasDoc ep => DocItem (DEntrypoint ep) where
type DocItemPlacement (DEntrypoint ep) = 'DocItemInlined
type DocItemReferenced (DEntrypoint ep) = 'True
docItemRef :: DEntrypoint ep
-> DocItemRef
(DocItemPlacement (DEntrypoint ep))
(DocItemReferenced (DEntrypoint ep))
docItemRef (DEntrypoint Text
name SubDoc
_) = DocItemId -> DocItemRef 'DocItemInlined 'True
DocItemRefInlined (DocItemId -> DocItemRef 'DocItemInlined 'True)
-> DocItemId -> DocItemRef 'DocItemInlined 'True
forall a b. (a -> b) -> a -> b
$
Text -> DocItemId
DocItemId (Text
"entrypoints-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ASetter Text Text Char Char -> (Char -> Char) -> Text -> Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Text Text Char Char
forall s a. Cons s s a a => Traversal' s a
_head Char -> Char
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
name))
docItemPos :: Natural
docItemPos = forall ep. EntrypointKindHasDoc ep => Natural
entrypointKindPos @ep
docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ forall ep. EntrypointKindHasDoc ep => Text
entrypointKindSectionName @ep
docItemSectionDescription :: Maybe Markdown
docItemSectionDescription = forall ep. EntrypointKindHasDoc ep => Maybe Markdown
entrypointKindSectionDescription @ep
docItemToMarkdown :: HeaderLevel -> DEntrypoint ep -> Markdown
docItemToMarkdown = HeaderLevel -> DEntrypoint ep -> Markdown
forall level. HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown
docItemToToc :: HeaderLevel -> DEntrypoint ep -> Markdown
docItemToToc HeaderLevel
lvl d :: DEntrypoint ep
d@(DEntrypoint Text
name SubDoc
_) =
HeaderLevel -> Markdown -> DEntrypoint ep -> Markdown
forall d.
(DocItem d, DocItemReferenced d ~ 'True) =>
HeaderLevel -> Markdown -> d -> Markdown
mdTocFromRef HeaderLevel
lvl (Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> (Text -> Text) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Text Text Char Char -> (Char -> Char) -> Text -> Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Text Text Char Char
forall s a. Cons s s a a => Traversal' s a
_head Char -> Char
toLower (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Text
name) DEntrypoint ep
d
entrypointSection
:: EntrypointKindHasDoc kind
=> Text -> Proxy kind -> (i :-> o) -> (i :-> o)
entrypointSection :: forall kind (i :: [*]) (o :: [*]).
EntrypointKindHasDoc kind =>
Text -> Proxy kind -> (i :-> o) -> i :-> o
entrypointSection Text
name (Proxy kind
_ :: Proxy kind) =
(SubDoc -> DEntrypoint kind) -> (i :-> o) -> i :-> o
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @kind Text
name)
data PlainEntrypointsKind
instance EntrypointKindHasDoc PlainEntrypointsKind where
entrypointKindPos :: Natural
entrypointKindPos = Natural
1000
entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Entrypoints"
data FlattenedEntrypointsKindHiding (hiddenEntrypoints :: [Symbol])
type FlattenedEntrypointsKind = FlattenedEntrypointsKindHiding '[]
instance Typeable heps => EntrypointKindHasDoc (FlattenedEntrypointsKindHiding heps) where
type EntrypointKindOverride (FlattenedEntrypointsKindHiding heps) = PlainEntrypointsKind
entrypointKindOverrideSpecified :: Dict
((EntrypointKindOverride (FlattenedEntrypointsKindHiding heps)
== FlattenedEntrypointsKindHiding heps)
~ 'False)
entrypointKindOverrideSpecified = Dict
((EntrypointKindOverride (FlattenedEntrypointsKindHiding heps)
== FlattenedEntrypointsKindHiding heps)
~ 'False)
forall (a :: Constraint). a => Dict a
Dict
data CommonContractBehaviourKind
instance EntrypointKindHasDoc CommonContractBehaviourKind where
entrypointKindPos :: Natural
entrypointKindPos = Natural
1800
entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Common for all contract's entrypoints"
data CommonEntrypointsBehaviourKind kind
instance EntrypointKindHasDoc kind =>
EntrypointKindHasDoc (CommonEntrypointsBehaviourKind kind) where
entrypointKindPos :: Natural
entrypointKindPos = forall ep. EntrypointKindHasDoc ep => Natural
entrypointKindPos @kind Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
5
entrypointKindSectionName :: Text
entrypointKindSectionName =
Text
"Common for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall ep. EntrypointKindHasDoc ep => Text
entrypointKindSectionName @kind
entrypointKindSectionDescription :: Maybe Markdown
entrypointKindSectionDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Markdown -> Maybe Markdown) -> Markdown -> Maybe Markdown
forall a b. (a -> b) -> a -> b
$
let refToBase :: Markdown
refToBase = forall di. DocItem di => Maybe Markdown
docItemSectionRef @(DEntrypoint kind)
Maybe Markdown -> Markdown -> Markdown
forall a. Maybe a -> a -> a
?: Text -> Markdown
forall a. HasCallStack => Text -> a
error Text
"Unexpectedly cannot reference section with entrypoints"
in Markdown
"Logic common for all entrypoints in " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
refToBase Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" section."
data DEntrypointReference = DEntrypointReference Text Anchor
instance DocItem DEntrypointReference where
docItemPos :: Natural
docItemPos = Natural
13
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DEntrypointReference -> Markdown
docItemToMarkdown HeaderLevel
_ (DEntrypointReference Text
name Anchor
anchor) =
Markdown
"Copies behaviour of " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Anchor -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
name) Anchor
anchor Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown
" entrypoint."
newtype ParamBuilder = ParamBuilder
{ ParamBuilder -> Markdown -> Markdown
unParamBuilder :: Markdown -> Markdown
}
pbSample :: ParamBuilder -> Markdown
pbSample :: ParamBuilder -> Markdown
pbSample (ParamBuilder Markdown -> Markdown
b) = Markdown -> Markdown
b Markdown
"·"
instance Buildable ParamBuilder where
build :: ParamBuilder -> Markdown
build = ParamBuilder -> Markdown
pbSample
instance Eq ParamBuilder where
== :: ParamBuilder -> ParamBuilder -> DocItemReferencedKind
(==) = Markdown -> Markdown -> DocItemReferencedKind
forall a. Eq a => a -> a -> DocItemReferencedKind
(==) (Markdown -> Markdown -> DocItemReferencedKind)
-> (ParamBuilder -> Markdown)
-> ParamBuilder
-> ParamBuilder
-> DocItemReferencedKind
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ParamBuilder -> Markdown
pbSample
data ParamBuildingDesc = ParamBuildingDesc
{ ParamBuildingDesc -> Markdown
pbdEnglish :: Markdown
, ParamBuildingDesc -> ParamBuilder
pbdHaskell :: ParamBuilder
, ParamBuildingDesc -> ParamBuilder
pbdMichelson :: ParamBuilder
} deriving stock (ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind
(ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind)
-> (ParamBuildingDesc
-> ParamBuildingDesc -> DocItemReferencedKind)
-> Eq ParamBuildingDesc
forall a.
(a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind) -> Eq a
/= :: ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind
$c/= :: ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind
== :: ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind
$c== :: ParamBuildingDesc -> ParamBuildingDesc -> DocItemReferencedKind
Eq)
data ParamBuildingStep
= PbsWrapIn Text ParamBuildingDesc
| PbsCallEntrypoint EpName
| PbsCustom ParamBuildingDesc
| PbsUncallable [ParamBuildingStep]
deriving stock (ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind
(ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind)
-> (ParamBuildingStep
-> ParamBuildingStep -> DocItemReferencedKind)
-> Eq ParamBuildingStep
forall a.
(a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind) -> Eq a
/= :: ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind
$c/= :: ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind
== :: ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind
$c== :: ParamBuildingStep -> ParamBuildingStep -> DocItemReferencedKind
Eq)
instance Buildable ParamBuildingStep where
build :: ParamBuildingStep -> Markdown
build = \case
PbsWrapIn Text
ctor ParamBuildingDesc
_desc -> Markdown
"Wrap in `" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
ctor Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"`"
PbsCallEntrypoint EpName
ep -> Markdown
"Call entrypoint " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> EpName -> Markdown
forall p. Buildable p => p -> Markdown
build EpName
ep
PbsCustom ParamBuildingDesc
desc -> Markdown
"Custom: \"" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> ParamBuildingDesc -> Markdown
pbdEnglish ParamBuildingDesc
desc Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\""
PbsUncallable [ParamBuildingStep]
steps -> Markdown
"Uncallable; dummy steps: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> [ParamBuildingStep] -> Markdown
forall (f :: * -> *) a.
(Foldable f, Buildable a) =>
f a -> Markdown
listF [ParamBuildingStep]
steps
mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep
mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep
mkPbsWrapIn Text
ctorName ParamBuilder
michDesc =
Text -> ParamBuildingDesc -> ParamBuildingStep
PbsWrapIn Text
ctorName ParamBuildingDesc :: Markdown -> ParamBuilder -> ParamBuilder -> ParamBuildingDesc
ParamBuildingDesc
{ pbdEnglish :: Markdown
pbdEnglish = Markdown
"Wrap into " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown -> Markdown
mdTicked (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
ctorName) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" constructor."
, pbdHaskell :: ParamBuilder
pbdHaskell = (Markdown -> Markdown) -> ParamBuilder
ParamBuilder ((Markdown -> Markdown) -> ParamBuilder)
-> (Markdown -> Markdown) -> ParamBuilder
forall a b. (a -> b) -> a -> b
$ \Markdown
p -> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
ctorName Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" (" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
p Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
, pbdMichelson :: ParamBuilder
pbdMichelson = ParamBuilder
michDesc
}
data SomeEntrypointArg =
forall a. (NiceParameter a, TypeHasDoc a) => SomeEntrypointArg (Proxy a)
data DEntrypointArg =
DEntrypointArg
{ DEntrypointArg -> Maybe SomeEntrypointArg
epaArg :: Maybe SomeEntrypointArg
, DEntrypointArg -> [ParamBuildingStep]
epaBuilding :: [ParamBuildingStep]
}
emptyDEpArg :: DEntrypointArg
emptyDEpArg :: DEntrypointArg
emptyDEpArg = DEntrypointArg :: Maybe SomeEntrypointArg -> [ParamBuildingStep] -> DEntrypointArg
DEntrypointArg
{ epaArg :: Maybe SomeEntrypointArg
epaArg = Maybe SomeEntrypointArg
forall a. Maybe a
Nothing
, epaBuilding :: [ParamBuildingStep]
epaBuilding = []
}
mkDEpUType :: forall t. HasAnnotation t => Untyped.Ty
mkDEpUType :: forall t. HasAnnotation t => Ty
mkDEpUType = Notes (ToT t) -> Ty
forall (x :: T). Notes x -> Ty
mkUType (forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @t FollowEntrypointFlag
FollowEntrypoint)
mkDEntrypointArgSimple :: forall t. (NiceParameter t, TypeHasDoc t) => DEntrypointArg
mkDEntrypointArgSimple :: forall t. (NiceParameter t, TypeHasDoc t) => DEntrypointArg
mkDEntrypointArgSimple = DEntrypointArg :: Maybe SomeEntrypointArg -> [ParamBuildingStep] -> DEntrypointArg
DEntrypointArg
{ epaArg :: Maybe SomeEntrypointArg
epaArg = SomeEntrypointArg -> Maybe SomeEntrypointArg
forall a. a -> Maybe a
Just (SomeEntrypointArg -> Maybe SomeEntrypointArg)
-> SomeEntrypointArg -> Maybe SomeEntrypointArg
forall a b. (a -> b) -> a -> b
$ Proxy t -> SomeEntrypointArg
forall a.
(NiceParameter a, TypeHasDoc a) =>
Proxy a -> SomeEntrypointArg
SomeEntrypointArg (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)
, epaBuilding :: [ParamBuildingStep]
epaBuilding = []
}
modifyParamBuildingSteps
:: ([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out)
-> (inp :-> out)
modifyParamBuildingSteps :: forall (inp :: [*]) (out :: [*]).
([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
modifyParamBuildingSteps [ParamBuildingStep] -> [ParamBuildingStep]
f =
(DEntrypointArg -> Maybe DEntrypointArg)
-> (inp :-> out) -> inp :-> out
forall a i1 i2.
(ContainsUpdateableDoc a, DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> a -> a
modifyDoc (\DEntrypointArg
di -> DEntrypointArg -> Maybe DEntrypointArg
forall a. a -> Maybe a
Just DEntrypointArg
di{ epaBuilding :: [ParamBuildingStep]
epaBuilding = [ParamBuildingStep] -> [ParamBuildingStep]
f (DEntrypointArg -> [ParamBuildingStep]
epaBuilding DEntrypointArg
di) })
clarifyParamBuildingSteps :: ParamBuildingStep -> (inp :-> out) -> (inp :-> out)
clarifyParamBuildingSteps :: forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
pbs =
([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
modifyParamBuildingSteps (ParamBuildingStep
pbs ParamBuildingStep -> [ParamBuildingStep] -> [ParamBuildingStep]
forall a. a -> [a] -> [a]
:)
instance DocItem DEntrypointArg where
docItemPos :: Natural
docItemPos = Natural
20
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemDependencies :: DEntrypointArg -> [SomeDocDefinitionItem]
docItemDependencies (DEntrypointArg Maybe SomeEntrypointArg
mdty [ParamBuildingStep]
_) =
[ DType -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (Proxy a -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy a -> DType) -> Proxy a -> DType
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ty)
| Just (SomeEntrypointArg (Proxy a
_ :: Proxy ty)) <- Maybe SomeEntrypointArg -> [Maybe SomeEntrypointArg]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeEntrypointArg
mdty ]
docItemToMarkdown :: HeaderLevel -> DEntrypointArg -> Markdown
docItemToMarkdown HeaderLevel
_ (DEntrypointArg Maybe SomeEntrypointArg
mdty [ParamBuildingStep]
psteps) =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Markdown] -> [Markdown]) -> [Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markdown -> Markdown) -> [Markdown] -> [Markdown]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.map (Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n") ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
[ Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Argument" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
case Maybe SomeEntrypointArg
mdty of
Maybe SomeEntrypointArg
Nothing -> Markdown
"none (pass unit)"
Just (SomeEntrypointArg (Proxy a
dty :: Proxy ep)) -> [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Markdown] -> [Markdown]) -> [Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
Prelude.intersperse Markdown
"\n" ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
[ Markdown
forall a. Monoid a => a
mempty
, Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"In Haskell"
(Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
dty (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False))
, Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"In Michelson"
(Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ DocItemReferencedKind -> Doc -> Markdown
printDocB DocItemReferencedKind
False (Doc -> Markdown) -> (Ty -> Doc) -> Ty -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> Ty -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens (Ty -> Markdown) -> Ty -> Markdown
forall a b. (a -> b) -> a -> b
$
forall (t :: T). SingI t => Ty
T.untypeDemoteT @(T.ToT ep))
, Markdown -> Maybe Markdown -> Markdown
forall a. a -> Maybe a -> a
fromMaybe Markdown
"" (Maybe Markdown -> Markdown) -> Maybe Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Sing (ToT a) -> Maybe (Value (ToT a))
forall (t :: T). WellTyped t => Sing t -> Maybe (Value t)
sampleTypedValue (forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @(ToT ep)) Maybe (Value (ToT a))
-> (Value (ToT a) -> Markdown) -> Maybe Markdown
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Value (ToT a)
sampleVal ->
Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Example"
(Markdown -> Markdown -> Markdown
mdAddId Markdown
"example-id"
(Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> Markdown
mdTicked
(Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ DocItemReferencedKind -> Value (ToT a) -> Text
forall (t :: T).
ProperUntypedValBetterErrors t =>
DocItemReferencedKind -> Value t -> Text
printTypedValue DocItemReferencedKind
True Value (ToT a)
sampleVal
)
],
Markdown -> Markdown -> Markdown
mdSpoiler Markdown
"How to call this entrypoint" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
Markdown
"\n0. Construct an argument for the entrypoint.\n" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown
howToCall
]
where
howToCall :: Markdown
howToCall =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Markdown] -> [Markdown]) -> [Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
Prelude.intersperse Markdown
"\n" ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
(Markdown -> Markdown) -> [Markdown] -> [Markdown]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.map (Markdown
"1. " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>) ([Markdown] -> [Markdown]) -> [Markdown] -> [Markdown]
forall a b. (a -> b) -> a -> b
$
[ParamBuildingStep] -> [ParamBuildingStep]
forall a. [a] -> [a]
reverse [ParamBuildingStep]
psteps [ParamBuildingStep]
-> (ParamBuildingStep -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
PbsWrapIn Text
_ ParamBuildingDesc
pbd ->
ParamBuildingDesc -> Markdown
renderPbDesc ParamBuildingDesc
pbd
PbsCallEntrypoint EpName
ep -> case EpName
ep of
EpName
DefEpName ->
Markdown
"Call the contract (default entrypoint) with the constructed \
\argument."
EpName
_ ->
Markdown
"Call contract's " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown -> Markdown
mdTicked (EpName -> Markdown
forall p. Buildable p => p -> Markdown
build EpName
ep) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" entrypoint \
\passing the constructed argument."
PbsCustom ParamBuildingDesc
pbd ->
ParamBuildingDesc -> Markdown
renderPbDesc ParamBuildingDesc
pbd
PbsUncallable [ParamBuildingStep]
_ ->
Markdown
"Feel sad: this entrypoint *cannot* be called and is enlisted \
\here only to describe the parameter structure."
renderPbDesc :: ParamBuildingDesc -> Markdown
renderPbDesc ParamBuildingDesc{Markdown
ParamBuilder
pbdMichelson :: ParamBuilder
pbdHaskell :: ParamBuilder
pbdEnglish :: Markdown
pbdMichelson :: ParamBuildingDesc -> ParamBuilder
pbdHaskell :: ParamBuildingDesc -> ParamBuilder
pbdEnglish :: ParamBuildingDesc -> Markdown
..} =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Markdown] -> [Markdown]) -> [Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
Prelude.intersperse Markdown
"\n" ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
[ Markdown
pbdEnglish
, Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"In Haskell" (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ ParamBuilder -> Markdown
pbSample ParamBuilder
pbdHaskell)
, Markdown
" + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Markdown -> Markdown
mdSubsection Markdown
"In Michelson" (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ ParamBuilder -> Markdown
pbSample ParamBuilder
pbdMichelson)
]
class (KnownSymbol con) => DeriveCtorFieldDoc con (cf :: CtorField) where
deriveCtorFieldDoc :: DEntrypointArg
instance
(KnownSymbol con)
=>
DeriveCtorFieldDoc con 'NoFields
where
deriveCtorFieldDoc :: DEntrypointArg
deriveCtorFieldDoc = DEntrypointArg
emptyDEpArg
instance
(NiceParameter ty, TypeHasDoc ty, KnownValue ty, KnownSymbol con)
=>
DeriveCtorFieldDoc con ('OneField ty)
where
deriveCtorFieldDoc :: DEntrypointArg
deriveCtorFieldDoc = forall t. (NiceParameter t, TypeHasDoc t) => DEntrypointArg
mkDEntrypointArgSimple @ty
documentEntrypoints
:: forall a kind inp out.
DocumentEntrypoints kind a
=> Rec (CaseClauseL inp out) (CaseClauses a)
-> Rec (CaseClauseL inp out) (CaseClauses a)
documentEntrypoints :: forall a kind (inp :: [*]) (out :: [*]).
DocumentEntrypoints kind a =>
Rec (CaseClauseL inp out) (CaseClauses a)
-> Rec (CaseClauseL inp out) (CaseClauses a)
documentEntrypoints Rec (CaseClauseL inp out) (CaseClauses a)
r =
forall (ept :: EPTree) kind (x :: * -> *)
(rest :: [CaseClauseParam]) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints ept kind x rest =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
gDocumentEntrypoints @(BuildEPTree' a) @kind @(G.Rep a) @'[]
((Markdown -> Markdown) -> ParamBuilder
ParamBuilder Markdown -> Markdown
forall a. a -> a
id) Rec (CaseClauseL inp out) (CaseClauses a)
r (\Rec (CaseClauseL inp out) '[]
RNil -> Rec (CaseClauseL inp out) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)
type DocumentEntrypoints kind a =
(Generic a, GDocumentEntrypoints (BuildEPTree' a) kind (G.Rep a) '[])
type BuildEPTree' a = BuildEPTree (GetParameterEpDerivation a) a
class GDocumentEntrypoints
(ept :: EPTree)
(kind :: Type)
(x :: Type -> Type)
(rest :: [CaseClauseParam]) where
gDocumentEntrypoints
:: ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
-> (Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
instance GDocumentEntrypoints ept kind x rest =>
GDocumentEntrypoints ept kind (G.D1 i x) rest where
gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x) rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x) rest)
gDocumentEntrypoints = forall (ept :: EPTree) kind (x :: * -> *)
(rest :: [CaseClauseParam]) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints ept kind x rest =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
gDocumentEntrypoints @ept @kind @x @rest
instance ( GDocumentEntrypoints eptl kind x (GCaseClauses y rest)
, GDocumentEntrypoints eptr kind y rest
) =>
GDocumentEntrypoints ('EPNode eptl eptr) kind (x :+: y) rest where
gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (x :+: y) rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses (x :+: y) rest)
gDocumentEntrypoints (ParamBuilder Markdown -> Markdown
michDesc) Rec (CaseClauseL inp out) (GCaseClauses (x :+: y) rest)
clauses Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont =
forall (ept :: EPTree) kind (x :: * -> *)
(rest :: [CaseClauseParam]) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints ept kind x rest =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
gDocumentEntrypoints @eptl @kind @x ParamBuilder
lpb Rec (CaseClauseL inp out) (GCaseClauses x (GCaseClauses y rest))
Rec (CaseClauseL inp out) (GCaseClauses (x :+: y) rest)
clauses
(\Rec (CaseClauseL inp out) (GCaseClauses y rest)
clauses' -> forall (ept :: EPTree) kind (x :: * -> *)
(rest :: [CaseClauseParam]) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints ept kind x rest =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec (CaseClauseL inp out) (GCaseClauses x rest)
gDocumentEntrypoints @eptr @kind @y @rest ParamBuilder
rpb Rec (CaseClauseL inp out) (GCaseClauses y rest)
clauses' Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont)
where
lpb :: ParamBuilder
lpb = (Markdown -> Markdown) -> ParamBuilder
ParamBuilder ((Markdown -> Markdown) -> ParamBuilder)
-> (Markdown -> Markdown) -> ParamBuilder
forall a b. (a -> b) -> a -> b
$ \Markdown
a -> Markdown -> Markdown
michDesc (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown
"Left (" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
a Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
rpb :: ParamBuilder
rpb = (Markdown -> Markdown) -> ParamBuilder
ParamBuilder ((Markdown -> Markdown) -> ParamBuilder)
-> (Markdown -> Markdown) -> ParamBuilder
forall a b. (a -> b) -> a -> b
$ \Markdown
a -> Markdown -> Markdown
michDesc (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown
"Right (" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
a Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
instance {-# OVERLAPPABLE #-}
( 'CaseClauseParam ctor cf ~ GCaseBranchInput ctor x
, KnownSymbol ctor
, DocItem (DEntrypoint (EntrypointKindOverride kind))
, DeriveCtorFieldDoc ctor cf
) =>
GDocumentEntrypoints ept kind (G.C1 ('G.MetaCons ctor _1 _2) x) rest where
gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
gDocumentEntrypoints ParamBuilder
michDesc (CaseClauseL AppendCtorField x inp :-> out
clause :& Rec (CaseClauseL inp out) rs
rest) Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont =
let entrypointName :: Text
entrypointName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy ctor -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @ctor)
psteps :: ParamBuildingStep
psteps = Text -> ParamBuilder -> ParamBuildingStep
mkPbsWrapIn Text
entrypointName ParamBuilder
michDesc
addDoc :: (AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
addDoc AppendCtorField cf inp :-> out
instr =
ParamBuildingStep
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
psteps ((AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out)
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall a b. (a -> b) -> a -> b
$
(SubDoc -> DEntrypoint (EntrypointKindOverride kind))
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @(EntrypointKindOverride kind) Text
entrypointName) ((AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out)
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall a b. (a -> b) -> a -> b
$
DEntrypointArg -> AppendCtorField cf inp :-> AppendCtorField cf inp
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (forall (con :: Symbol) (cf :: CtorField).
DeriveCtorFieldDoc con cf =>
DEntrypointArg
deriveCtorFieldDoc @ctor @cf) (AppendCtorField cf inp :-> AppendCtorField cf inp)
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# AppendCtorField cf inp :-> out
instr
in (AppendCtorField cf inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor cf)
forall (x :: CtorField) (inp :: [*]) (out :: [*]) (ctor :: Symbol).
(AppendCtorField x inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor x)
CaseClauseL ((AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
addDoc AppendCtorField cf inp :-> out
AppendCtorField x inp :-> out
clause) CaseClauseL inp out ('CaseClauseParam ctor cf)
-> Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) ('CaseClauseParam ctor cf : rest)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont Rec (CaseClauseL inp out) rest
Rec (CaseClauseL inp out) rs
rest
instance ( 'CaseClauseParam ctor cf ~ GCaseBranchInput ctor x
, KnownSymbol ctor
) =>
GDocumentEntrypoints ('EPNode a b) (FlattenedEntrypointsKindHiding _heps)
(G.C1 ('G.MetaCons ctor _1 _2) x) rest where
gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
gDocumentEntrypoints ParamBuilder
michDesc (CaseClauseL AppendCtorField x inp :-> out
clause :& Rec (CaseClauseL inp out) rs
rest) Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont =
let entrypointName :: Text
entrypointName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy ctor -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @ctor)
psteps :: ParamBuildingStep
psteps = Text -> ParamBuilder -> ParamBuildingStep
mkPbsWrapIn Text
entrypointName ParamBuilder
michDesc
in (AppendCtorField cf inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor cf)
forall (x :: CtorField) (inp :: [*]) (out :: [*]) (ctor :: Symbol).
(AppendCtorField x inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor x)
CaseClauseL (ParamBuildingStep
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
psteps AppendCtorField cf inp :-> out
AppendCtorField x inp :-> out
clause) CaseClauseL inp out ('CaseClauseParam ctor cf)
-> Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) ('CaseClauseParam ctor cf : rest)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont Rec (CaseClauseL inp out) rest
Rec (CaseClauseL inp out) rs
rest
instance {-# OVERLAPPABLE #-}
( 'CaseClauseParam ctor cf ~ GCaseBranchInput ctor x
, KnownSymbol ctor
, DeriveCtorFieldDoc ctor cf
, T.SingI heps
) =>
GDocumentEntrypoints ept (FlattenedEntrypointsKindHiding heps)
(G.C1 ('G.MetaCons ctor _1 _2) x) rest where
gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
-> (Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) rest)
-> Rec
(CaseClauseL inp out)
(GCaseClauses (C1 ('MetaCons ctor _1 _2) x) rest)
gDocumentEntrypoints ParamBuilder
michDesc (CaseClauseL AppendCtorField x inp :-> out
clause :& Rec (CaseClauseL inp out) rs
rest) Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont =
let epName :: Text
epName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy ctor -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @ctor)
psteps :: ParamBuildingStep
psteps = Text -> ParamBuilder -> ParamBuildingStep
mkPbsWrapIn Text
epName ParamBuilder
michDesc
hiddenEps :: Demote [Symbol]
hiddenEps = Sing heps -> Demote [Symbol]
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (Sing heps -> Demote [Symbol]) -> Sing heps -> Demote [Symbol]
forall a b. (a -> b) -> a -> b
$ forall (a :: [Symbol]). SingI a => Sing a
forall {k} (a :: k). SingI a => Sing a
T.sing @heps
epDoc :: (AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
epDoc AppendCtorField cf inp :-> out
instr
| Text
Element [Text]
epName Element [Text] -> [Text] -> DocItemReferencedKind
forall t.
(Container t, Eq (Element t)) =>
Element t -> t -> DocItemReferencedKind
`elem` [Text]
Demote [Symbol]
hiddenEps = AppendCtorField cf inp :-> out
instr
| DocItemReferencedKind
otherwise =
(SubDoc -> DEntrypoint PlainEntrypointsKind)
-> (AppendCtorField cf inp :-> AppendCtorField cf inp)
-> AppendCtorField cf inp :-> AppendCtorField cf inp
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @PlainEntrypointsKind Text
epName)
(DEntrypointArg -> AppendCtorField cf inp :-> AppendCtorField cf inp
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (forall (con :: Symbol) (cf :: CtorField).
DeriveCtorFieldDoc con cf =>
DEntrypointArg
deriveCtorFieldDoc @ctor @cf))
# instr
addDoc :: (AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
addDoc AppendCtorField cf inp :-> out
instr =
ParamBuildingStep
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall (inp :: [*]) (out :: [*]).
ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps ParamBuildingStep
psteps ((AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out)
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall a b. (a -> b) -> a -> b
$
(AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
epDoc AppendCtorField cf inp :-> out
instr
in (AppendCtorField cf inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor cf)
forall (x :: CtorField) (inp :: [*]) (out :: [*]) (ctor :: Symbol).
(AppendCtorField x inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor x)
CaseClauseL ((AppendCtorField cf inp :-> out) -> AppendCtorField cf inp :-> out
addDoc AppendCtorField cf inp :-> out
AppendCtorField x inp :-> out
clause) CaseClauseL inp out ('CaseClauseParam ctor cf)
-> Rec (CaseClauseL inp out) rest
-> Rec (CaseClauseL inp out) ('CaseClauseParam ctor cf : rest)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (CaseClauseL inp out) rest -> Rec (CaseClauseL inp out) rest
cont Rec (CaseClauseL inp out) rest
Rec (CaseClauseL inp out) rs
rest
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
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
entryCase_ Proxy entrypointKind
_ = Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
forall dt (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt)) =>
Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
case_ (Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out)
-> (Rec (CaseClauseL inp out) (CaseClauses dt)
-> Rec (CaseClauseL inp out) (CaseClauses dt))
-> Rec (CaseClauseL inp out) (CaseClauses dt)
-> (dt : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a kind (inp :: [*]) (out :: [*]).
DocumentEntrypoints kind a =>
Rec (CaseClauseL inp out) (CaseClauses a)
-> Rec (CaseClauseL inp out) (CaseClauses a)
documentEntrypoints @dt @entrypointKind
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 :: [*]) clauses.
(CaseTC dt out inp clauses,
DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind -> IsoRecTuple clauses -> (dt : inp) :-> out
entryCase Proxy entrypointKind
p = Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
forall dt entrypointKind (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt),
DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
entryCase_ Proxy entrypointKind
p (Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses dt))
-> Rec (CaseClauseL inp out) (CaseClauses dt))
-> IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses dt))
-> (dt : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses dt))
-> Rec (CaseClauseL inp out) (CaseClauses dt)
forall r. RecFromTuple r => IsoRecTuple r -> r
recFromTuple
documentEntrypoint
:: forall kind epName param s out.
( KnownSymbol epName
, DocItem (DEntrypoint kind)
, NiceParameter param
, TypeHasDoc param
)
=> param : s :-> out -> param : s :-> out
documentEntrypoint :: forall kind (epName :: Symbol) param (s :: [*]) (out :: [*]).
(KnownSymbol epName, DocItem (DEntrypoint kind),
NiceParameter param, TypeHasDoc param) =>
((param : s) :-> out) -> (param : s) :-> out
documentEntrypoint (param : s) :-> out
instr =
let entrypointName :: Text
entrypointName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy epName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @epName) in
(SubDoc -> DEntrypoint kind)
-> ((param : s) :-> out) -> (param : s) :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @kind Text
entrypointName) (((param : s) :-> out) -> (param : s) :-> out)
-> ((param : s) :-> out) -> (param : s) :-> out
forall a b. (a -> b) -> a -> b
$
DEntrypointArg -> (param : s) :-> (param : s)
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (forall t. (NiceParameter t, TypeHasDoc t) => DEntrypointArg
mkDEntrypointArgSimple @param) ((param : s) :-> (param : s))
-> ((param : s) :-> out) -> (param : s) :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (param : s) :-> out
instr
class EntryArrow kind name body where
(#->) :: (Label name, Proxy kind) -> body -> body
instance ( name ~ ("e" `AppendSymbol` epName)
, body ~ (param : s :-> out)
, KnownSymbol epName
, DocItem (DEntrypoint kind)
, NiceParameter param
, TypeHasDoc param
, KnownValue param
) => EntryArrow kind name body where
#-> :: (Label name, Proxy kind) -> body -> body
(#->) (Label name, Proxy kind)
_ = forall kind (epName :: Symbol) param (s :: [*]) (out :: [*]).
(KnownSymbol epName, DocItem (DEntrypoint kind),
NiceParameter param, TypeHasDoc param) =>
((param : s) :-> out) -> (param : s) :-> out
documentEntrypoint @kind @epName
finalizeParamCallingDoc'
:: forall cp inp out.
(NiceParameterFull cp, HasCallStack)
=> Proxy cp -> (inp :-> out) -> (inp :-> out)
finalizeParamCallingDoc' :: forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, HasCallStack) =>
Proxy cp -> (inp :-> out) -> inp :-> out
finalizeParamCallingDoc' Proxy cp
_ = ([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
modifyParamBuildingSteps [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps
where
epDescs :: [Some1 EpCallingDesc]
epDescs :: [Some1 EpCallingDesc]
epDescs =
[Some1 EpCallingDesc] -> [Some1 EpCallingDesc]
forall a. [a] -> [a]
reverse ([Some1 EpCallingDesc] -> [Some1 EpCallingDesc])
-> [Some1 EpCallingDesc] -> [Some1 EpCallingDesc]
forall a b. (a -> b) -> a -> b
$ forall cp. ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc]
pepDescsWithDef @cp
modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps [ParamBuildingStep]
pbs
| [ParamBuildingStep] -> DocItemReferencedKind
areFinalizedParamBuildingSteps [ParamBuildingStep]
pbs =
Text -> [ParamBuildingStep]
forall a. HasCallStack => Text -> a
error Text
"Applying finalization second time"
| DocItemReferencedKind
otherwise =
[ParamBuildingStep]
-> Maybe [ParamBuildingStep] -> [ParamBuildingStep]
forall a. a -> Maybe a -> a
fromMaybe [[ParamBuildingStep] -> ParamBuildingStep
PbsUncallable [ParamBuildingStep]
pbs] (Maybe [ParamBuildingStep] -> [ParamBuildingStep])
-> ([Maybe [ParamBuildingStep]] -> Maybe [ParamBuildingStep])
-> [Maybe [ParamBuildingStep]]
-> [ParamBuildingStep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ParamBuildingStep]] -> Maybe [ParamBuildingStep]
forall a. [a] -> Maybe a
listToMaybe ([[ParamBuildingStep]] -> Maybe [ParamBuildingStep])
-> ([Maybe [ParamBuildingStep]] -> [[ParamBuildingStep]])
-> [Maybe [ParamBuildingStep]]
-> Maybe [ParamBuildingStep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [ParamBuildingStep]] -> [[ParamBuildingStep]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [ParamBuildingStep]] -> [ParamBuildingStep])
-> [Maybe [ParamBuildingStep]] -> [ParamBuildingStep]
forall a b. (a -> b) -> a -> b
$
[Some1 EpCallingDesc]
epDescs [Some1 EpCallingDesc]
-> (Some1 EpCallingDesc -> Maybe [ParamBuildingStep])
-> [Maybe [ParamBuildingStep]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Some1 EpCallingDesc
epDesc -> Some1 EpCallingDesc
-> [ParamBuildingStep] -> Maybe [ParamBuildingStep]
tryShortcut Some1 EpCallingDesc
epDesc [ParamBuildingStep]
pbs
match :: [EpCallingStep] -> [ParamBuildingStep] -> Bool
match :: [EpCallingStep] -> [ParamBuildingStep] -> DocItemReferencedKind
match [EpCallingStep]
cSteps [ParamBuildingStep]
pbSteps =
[DocItemReferencedKind] -> Element [DocItemReferencedKind]
forall c.
(Container c, BooleanMonoid (Element c)) =>
c -> Element c
and ([DocItemReferencedKind] -> Element [DocItemReferencedKind])
-> [DocItemReferencedKind] -> Element [DocItemReferencedKind]
forall a b. (a -> b) -> a -> b
$ [EpCallingStep]
-> [Maybe ParamBuildingStep]
-> [(EpCallingStep, Maybe ParamBuildingStep)]
forall a b. [a] -> [b] -> [(a, b)]
zip [EpCallingStep]
cSteps ([ParamBuildingStep] -> [Maybe ParamBuildingStep]
forall a. [a] -> [Maybe a]
prolong [ParamBuildingStep]
pbSteps) [(EpCallingStep, Maybe ParamBuildingStep)]
-> ((EpCallingStep, Maybe ParamBuildingStep)
-> DocItemReferencedKind)
-> [DocItemReferencedKind]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
(EpsWrapIn Text
ctor, Just (PbsWrapIn Text
ctor2 ParamBuildingDesc
_)) | Text
ctor Text -> Text -> DocItemReferencedKind
forall a. Eq a => a -> a -> DocItemReferencedKind
== Text
ctor2 -> DocItemReferencedKind
True
(EpCallingStep, Maybe ParamBuildingStep)
_ -> DocItemReferencedKind
False
where
prolong :: [a] -> [Maybe a]
prolong :: forall a. [a] -> [Maybe a]
prolong [a]
l = (a -> Maybe a) -> [a] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
l [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing
tryShortcut
:: Some1 EpCallingDesc
-> [ParamBuildingStep]
-> Maybe [ParamBuildingStep]
tryShortcut :: Some1 EpCallingDesc
-> [ParamBuildingStep] -> Maybe [ParamBuildingStep]
tryShortcut (Some1 EpCallingDesc{ epcdSteps :: forall arg (name :: Symbol).
EpCallingDesc '(name, arg) -> [EpCallingStep]
epcdSteps = [EpCallingStep]
cSteps, epcdEntrypoint :: forall arg (name :: Symbol). EpCallingDesc '(name, arg) -> EpName
epcdEntrypoint = EpName
ep })
[ParamBuildingStep]
pbSteps
| [EpCallingStep] -> [ParamBuildingStep] -> DocItemReferencedKind
match [EpCallingStep]
cSteps [ParamBuildingStep]
pbSteps =
let truncated :: [ParamBuildingStep]
truncated = Int -> [ParamBuildingStep] -> [ParamBuildingStep]
forall a. Int -> [a] -> [a]
drop ([EpCallingStep] -> Int
forall t. Container t => t -> Int
length [EpCallingStep]
cSteps) [ParamBuildingStep]
pbSteps
callEpStep :: ParamBuildingStep
callEpStep = EpName -> ParamBuildingStep
PbsCallEntrypoint EpName
ep
in [ParamBuildingStep] -> Maybe [ParamBuildingStep]
forall a. a -> Maybe a
Just ([ParamBuildingStep] -> Maybe [ParamBuildingStep])
-> [ParamBuildingStep] -> Maybe [ParamBuildingStep]
forall a b. (a -> b) -> a -> b
$ ParamBuildingStep
callEpStep ParamBuildingStep -> [ParamBuildingStep] -> [ParamBuildingStep]
forall a. a -> [a] -> [a]
: [ParamBuildingStep]
truncated
| DocItemReferencedKind
otherwise = Maybe [ParamBuildingStep]
forall a. Maybe a
Nothing
finalizeParamCallingDoc
:: forall cp inp out.
(NiceParameterFull cp, RequireSumType cp, HasCallStack)
=> (cp : inp :-> out) -> (cp : inp :-> out)
finalizeParamCallingDoc :: forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
((cp : inp) :-> out) -> (cp : inp) :-> out
finalizeParamCallingDoc = Proxy cp -> ((cp : inp) :-> out) -> (cp : inp) :-> out
forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, HasCallStack) =>
Proxy cp -> (inp :-> out) -> inp :-> out
finalizeParamCallingDoc' (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @cp)
where
_needSumType :: Dict (RequireSumType cp)
_needSumType :: Dict (RequireSumType cp)
_needSumType = Dict (RequireSumType cp)
forall (a :: Constraint). a => Dict a
Dict
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> DocItemReferencedKind
areFinalizedParamBuildingSteps =
let
hasFinalizationTraces :: ParamBuildingStep -> DocItemReferencedKind
hasFinalizationTraces = \case
PbsWrapIn{} -> DocItemReferencedKind
False
PbsCallEntrypoint{} -> DocItemReferencedKind
True
PbsCustom{} -> DocItemReferencedKind
False
PbsUncallable{} -> DocItemReferencedKind
True
in (Element [ParamBuildingStep] -> DocItemReferencedKind)
-> [ParamBuildingStep] -> DocItemReferencedKind
forall c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
any Element [ParamBuildingStep] -> DocItemReferencedKind
ParamBuildingStep -> DocItemReferencedKind
hasFinalizationTraces
entryCaseSimple_
:: forall cp out inp.
( InstrCaseC cp
, RMap (CaseClauses cp)
, DocumentEntrypoints PlainEntrypointsKind cp
, RequireFlatParamEps cp
)
=> Rec (CaseClauseL inp out) (CaseClauses cp)
-> cp : inp :-> out
entryCaseSimple_ :: forall cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints PlainEntrypointsKind cp,
RequireFlatParamEps cp) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseSimple_ =
Proxy PlainEntrypointsKind
-> Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
forall dt entrypointKind (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt),
DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
entryCase_ (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @PlainEntrypointsKind)
where
_reqFlat :: Dict (RequireFlatEpDerivation cp (GetParameterEpDerivation cp))
_reqFlat = forall (a :: Constraint). a => Dict a
Dict @(RequireFlatEpDerivation cp (GetParameterEpDerivation cp))
entryCaseSimple
:: forall cp out inp clauses.
( CaseTC cp out inp clauses
, DocumentEntrypoints PlainEntrypointsKind cp
, RequireFlatParamEps cp
)
=> IsoRecTuple clauses -> cp : inp :-> out
entryCaseSimple :: forall cp (out :: [*]) (inp :: [*]) clauses.
(CaseTC cp out inp clauses,
DocumentEntrypoints PlainEntrypointsKind cp,
RequireFlatParamEps cp) =>
IsoRecTuple clauses -> (cp : inp) :-> out
entryCaseSimple = Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
forall cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints PlainEntrypointsKind cp,
RequireFlatParamEps cp) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseSimple_ (Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp))
-> IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> (cp : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp)
forall r. RecFromTuple r => IsoRecTuple r -> r
recFromTuple
entryCaseFlattened_
:: forall cp out inp.
( InstrCaseC cp
, RMap (CaseClauses cp)
, DocumentEntrypoints FlattenedEntrypointsKind cp
)
=> Rec (CaseClauseL inp out) (CaseClauses cp)
-> cp : inp :-> out
entryCaseFlattened_ :: forall cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints FlattenedEntrypointsKind cp) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseFlattened_ =
Proxy FlattenedEntrypointsKind
-> Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
forall dt entrypointKind (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt),
DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
entryCase_ (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @FlattenedEntrypointsKind)
entryCaseFlattened
:: forall cp out inp clauses.
( CaseTC cp out inp clauses
, DocumentEntrypoints FlattenedEntrypointsKind cp
)
=> IsoRecTuple clauses -> cp : inp :-> out
entryCaseFlattened :: forall cp (out :: [*]) (inp :: [*]) clauses.
(CaseTC cp out inp clauses,
DocumentEntrypoints FlattenedEntrypointsKind cp) =>
IsoRecTuple clauses -> (cp : inp) :-> out
entryCaseFlattened = Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
forall cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints FlattenedEntrypointsKind cp) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseFlattened_ (Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp))
-> IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> (cp : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp)
forall r. RecFromTuple r => IsoRecTuple r -> r
recFromTuple
entryCaseFlattenedHiding_
:: forall heps cp out inp.
( InstrCaseC cp
, RMap (CaseClauses cp)
, DocumentEntrypoints (FlattenedEntrypointsKindHiding heps) cp
, HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps
)
=> Rec (CaseClauseL inp out) (CaseClauses cp)
-> cp : inp :-> out
entryCaseFlattenedHiding_ :: forall (heps :: [Symbol]) cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints (FlattenedEntrypointsKindHiding heps) cp,
HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseFlattenedHiding_ =
Proxy (FlattenedEntrypointsKindHiding heps)
-> Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
forall dt entrypointKind (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt),
DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
entryCase_ (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(FlattenedEntrypointsKindHiding heps))
where
_reqHasEps :: Dict (HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps)
_reqHasEps = forall (a :: Constraint). a => Dict a
Dict @(HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps)
entryCaseFlattenedHiding
:: forall heps cp out inp clauses.
( CaseTC cp out inp clauses
, DocumentEntrypoints (FlattenedEntrypointsKindHiding heps) cp
, HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps
)
=> IsoRecTuple clauses -> cp : inp :-> out
entryCaseFlattenedHiding :: forall (heps :: [Symbol]) cp (out :: [*]) (inp :: [*]) clauses.
(CaseTC cp out inp clauses,
DocumentEntrypoints (FlattenedEntrypointsKindHiding heps) cp,
HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps) =>
IsoRecTuple clauses -> (cp : inp) :-> out
entryCaseFlattenedHiding = forall (heps :: [Symbol]) cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
DocumentEntrypoints (FlattenedEntrypointsKindHiding heps) cp,
HasEntrypoints (ParameterEntrypointsDerivation cp) cp heps) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
entryCaseFlattenedHiding_ @heps (Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp))
-> IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> (cp : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (CaseClauses cp))
-> Rec (CaseClauseL inp out) (CaseClauses cp)
forall r. RecFromTuple r => IsoRecTuple r -> r
recFromTuple
type family RequireFlatParamEps cp :: Constraint where
RequireFlatParamEps cp =
( NiceParameterFull cp
, RequireFlatEpDerivation cp (GetParameterEpDerivation cp)
, RequireSumType cp
)
type family RequireFlatEpDerivation cp deriv :: Constraint where
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 "`"
)
type family HasEntrypoints mode cp syms :: Constraint where
HasEntrypoints mode cp (x ': xs) =
FailUnlessElse (IsJust @@ (EpdLookupEntrypoint mode cp @@ x))
('Text "Parameter type " ':<>: 'ShowType cp
':<>: 'Text " does not contain entrypoint " ':<>: 'ShowType x)
(HasEntrypoints mode cp xs)
HasEntrypoints _ _ '[] = ()
mdAddId :: Markdown -> Markdown -> Markdown
mdAddId :: Markdown -> Markdown -> Markdown
mdAddId Markdown
idTxt Markdown
txt = Markdown
"<span id=\"" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
idTxt Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\">" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
txt Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"</span>"