{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Lorentz.Entrypoints.Doc
( DEntrypoint (..)
, pattern DEntrypointDocItem
, EntrypointKindHasDoc (..)
, entrypointSection
, DEntrypointReference (..)
, EntryArrow (..)
, PlainEntrypointsKind
, CommonContractBehaviourKind
, CommonEntrypointsBehaviourKind
, diEntrypointToMarkdown
, SomeEntrypointArg (..)
, DEntrypointArg (..)
, DType (..)
, DeriveCtorFieldDoc (..)
, ParamBuilder (..)
, ParamBuildingDesc (..)
, ParamBuildingStep (..)
, mkPbsWrapIn
, clarifyParamBuildingSteps
, constructDEpArg
, emptyDEpArg
, mkUType
, mkDEpUType
, mkDEntrypointArgSimple
, DocumentEntrypoints
, documentEntrypoint
, entryCase
, entryCase_
, finalizeParamCallingDoc
, finalizeParamCallingDoc'
, areFinalizedParamBuildingSteps
, entryCaseSimple_
, entryCaseSimple
, RequireFlatParamEps
, RequireFlatEpDerivation
) where
import Control.Lens.Cons (_head)
import Data.Char (toLower)
import Data.Constraint (Dict(..))
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Vinyl.Core (RMap, rappend)
import Fmt (Buildable(..), build, fmt, listF)
import GHC.Generics ((:+:))
import qualified GHC.Generics as G
import qualified Text.Show
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 qualified Morley.Michelson.Typed as T
import Morley.Michelson.Typed.Haskell.Doc
import Morley.Michelson.Typed.Haskell.Instr
import qualified Morley.Michelson.Untyped 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
{ DEntrypoint kind -> Text
depName :: Text
, 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 :: 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 (DocItem DEntrypointExample => DocItemPos
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 (DocItem DEntrypointExample => DocItemPos
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 -> Bool
T.isInfixOf (Text
"id=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Markdown -> Text
forall b. FromBuilder b => Markdown -> b
fmt @Text Markdown
exampleId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") Text
w of
Bool
True -> FromBuilder Text => Markdown -> Text
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)
Bool
False -> Text
w
)
(Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
lines (Markdown -> Text
forall b. FromBuilder b => Markdown -> b
fmt @Text Markdown
inputText)
where
exampleId :: Markdown
exampleId = Markdown
"example-id"
class Typeable ep => EntrypointKindHasDoc (ep :: Type) where
entrypointKindPos :: Natural
entrypointKindSectionName :: Text
entrypointKindSectionDescription :: Maybe Markdown
entrypointKindSectionDescription = Maybe Markdown
forall a. Maybe a
Nothing
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 = EntrypointKindHasDoc ep => Natural
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
$ EntrypointKindHasDoc ep => Text
forall ep. EntrypointKindHasDoc ep => Text
entrypointKindSectionName @ep
docItemSectionDescription :: Maybe Markdown
docItemSectionDescription = EntrypointKindHasDoc ep => Maybe Markdown
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 :: 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 (Text -> SubDoc -> DEntrypoint kind
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 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 = EntrypointKindHasDoc kind => Natural
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
<> EntrypointKindHasDoc kind => Text
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 = DocItem (DEntrypoint kind) => Maybe Markdown
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 Show ParamBuilder where
show :: ParamBuilder -> String
show (ParamBuilder Markdown -> Markdown
pb) =
String
"ParamBuilder " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Markdown -> String
forall b a. (Show a, IsString b) => a -> b
show (Markdown -> Markdown
pb Markdown
"x")
instance Eq ParamBuilder where
== :: ParamBuilder -> ParamBuilder -> Bool
(==) = Markdown -> Markdown -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Markdown -> Markdown -> Bool)
-> (ParamBuilder -> Markdown)
-> ParamBuilder
-> ParamBuilder
-> Bool
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 (Int -> ParamBuildingDesc -> ShowS
[ParamBuildingDesc] -> ShowS
ParamBuildingDesc -> String
(Int -> ParamBuildingDesc -> ShowS)
-> (ParamBuildingDesc -> String)
-> ([ParamBuildingDesc] -> ShowS)
-> Show ParamBuildingDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamBuildingDesc] -> ShowS
$cshowList :: [ParamBuildingDesc] -> ShowS
show :: ParamBuildingDesc -> String
$cshow :: ParamBuildingDesc -> String
showsPrec :: Int -> ParamBuildingDesc -> ShowS
$cshowsPrec :: Int -> ParamBuildingDesc -> ShowS
Show, ParamBuildingDesc -> ParamBuildingDesc -> Bool
(ParamBuildingDesc -> ParamBuildingDesc -> Bool)
-> (ParamBuildingDesc -> ParamBuildingDesc -> Bool)
-> Eq ParamBuildingDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamBuildingDesc -> ParamBuildingDesc -> Bool
$c/= :: ParamBuildingDesc -> ParamBuildingDesc -> Bool
== :: ParamBuildingDesc -> ParamBuildingDesc -> Bool
$c== :: ParamBuildingDesc -> ParamBuildingDesc -> Bool
Eq)
data ParamBuildingStep
= PbsWrapIn Text ParamBuildingDesc
| PbsCallEntrypoint EpName
| PbsCustom ParamBuildingDesc
| PbsUncallable [ParamBuildingStep]
deriving stock (Int -> ParamBuildingStep -> ShowS
[ParamBuildingStep] -> ShowS
ParamBuildingStep -> String
(Int -> ParamBuildingStep -> ShowS)
-> (ParamBuildingStep -> String)
-> ([ParamBuildingStep] -> ShowS)
-> Show ParamBuildingStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamBuildingStep] -> ShowS
$cshowList :: [ParamBuildingStep] -> ShowS
show :: ParamBuildingStep -> String
$cshow :: ParamBuildingStep -> String
showsPrec :: Int -> ParamBuildingStep -> ShowS
$cshowsPrec :: Int -> ParamBuildingStep -> ShowS
Show, ParamBuildingStep -> ParamBuildingStep -> Bool
(ParamBuildingStep -> ParamBuildingStep -> Bool)
-> (ParamBuildingStep -> ParamBuildingStep -> Bool)
-> Eq ParamBuildingStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamBuildingStep -> ParamBuildingStep -> Bool
$c/= :: ParamBuildingStep -> ParamBuildingStep -> Bool
== :: ParamBuildingStep -> ParamBuildingStep -> Bool
$c== :: ParamBuildingStep -> ParamBuildingStep -> Bool
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]
}
constructDEpArg
:: forall arg.
( NiceParameter arg
, TypeHasDoc arg
)
=> DEntrypointArg
constructDEpArg :: DEntrypointArg
constructDEpArg = 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 arg -> SomeEntrypointArg
forall a.
(NiceParameter a, TypeHasDoc a) =>
Proxy a -> SomeEntrypointArg
SomeEntrypointArg (Proxy arg
forall k (t :: k). Proxy t
Proxy @arg)
, epaBuilding :: [ParamBuildingStep]
epaBuilding = []
}
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. (KnownValue t, HasAnnotation t) => Untyped.Ty
mkDEpUType :: Ty
mkDEpUType = Notes (ToT t) -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType (FollowEntrypointFlag -> Notes (ToT t)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @t FollowEntrypointFlag
FollowEntrypoint)
mkDEntrypointArgSimple
:: forall t.
( NiceParameter t
, TypeHasDoc t
)
=> DEntrypointArg
mkDEntrypointArgSimple :: 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 (Proxy t
forall k (t :: k). Proxy t
Proxy @t)
, epaBuilding :: [ParamBuildingStep]
epaBuilding = []
}
modifyParamBuildingSteps
:: ([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out)
-> (inp :-> out)
modifyParamBuildingSteps :: ([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 :: 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
$ Proxy a
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 (Bool -> WithinParens
WithinParens Bool
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
$ Bool -> Doc -> Markdown
printDocB Bool
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
$
SingI (ToT a) => Ty
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). Sing t -> Maybe (Value t)
sampleTypedValue (SingI (ToT a) => Sing (ToT a)
forall k (a :: k). 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
$ Bool -> Value (ToT a) -> Text
forall (t :: T).
ProperUntypedValBetterErrors t =>
Bool -> Value t -> Text
printTypedValue Bool
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 = (NiceParameter ty, TypeHasDoc ty) => DEntrypointArg
forall arg. (NiceParameter arg, TypeHasDoc arg) => DEntrypointArg
constructDEpArg @ty
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)
-> Rec (CaseClauseL inp out) (CaseClauses a)
documentEntrypoints = ParamBuilder
-> Rec (CaseClauseL inp out) (CaseClauses a)
-> Rec (CaseClauseL inp out) (CaseClauses a)
forall kind (x :: * -> *) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @kind @(G.Rep a) ((Markdown -> Markdown) -> ParamBuilder
ParamBuilder Markdown -> Markdown
forall a. a -> a
id)
type DocumentEntrypoints kind a =
(Generic a, GDocumentEntrypoints kind (G.Rep a))
class GDocumentEntrypoints (kind :: Type) (x :: Type -> Type) where
gDocumentEntrypoints
:: ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
instance GDocumentEntrypoints kind x => GDocumentEntrypoints kind (G.D1 i x) where
gDocumentEntrypoints :: ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x))
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x))
gDocumentEntrypoints = forall (inp :: [*]) (out :: [*]).
GDocumentEntrypoints kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
forall kind (x :: * -> *) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @kind @x
instance ( GDocumentEntrypoints kind x, GDocumentEntrypoints kind y
, RSplit (GCaseClauses x) (GCaseClauses y)
) =>
GDocumentEntrypoints kind (x :+: y) where
gDocumentEntrypoints :: ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (x :+: y))
-> Rec (CaseClauseL inp out) (GCaseClauses (x :+: y))
gDocumentEntrypoints (ParamBuilder Markdown -> Markdown
michDesc) Rec (CaseClauseL inp out) (GCaseClauses (x :+: y))
clauses =
let (Rec (CaseClauseL inp out) (GCaseClauses x)
lclauses, Rec (CaseClauseL inp out) (GCaseClauses y)
rclauses) = Rec (CaseClauseL inp out) (GCaseClauses x ++ GCaseClauses y)
-> (Rec (CaseClauseL inp out) (GCaseClauses x),
Rec (CaseClauseL inp out) (GCaseClauses y))
forall k (l :: [k]) (r :: [k]) (f :: k -> *).
RSplit l r =>
Rec f (l ++ r) -> (Rec f l, Rec f r)
rsplit @CaseClauseParam @(GCaseClauses x) Rec (CaseClauseL inp out) (GCaseClauses x ++ GCaseClauses y)
Rec (CaseClauseL inp out) (GCaseClauses (x :+: y))
clauses
in ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
forall kind (x :: * -> *) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @kind @x
((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
")")
Rec (CaseClauseL inp out) (GCaseClauses x)
lclauses
Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses y)
-> Rec (CaseClauseL inp out) (GCaseClauses x ++ GCaseClauses y)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`rappend`
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses y)
-> Rec (CaseClauseL inp out) (GCaseClauses y)
forall kind (x :: * -> *) (inp :: [*]) (out :: [*]).
GDocumentEntrypoints kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @kind @y
((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
")")
Rec (CaseClauseL inp out) (GCaseClauses y)
rclauses
instance ( 'CaseClauseParam ctor cf ~ GCaseBranchInput ctor x
, KnownSymbol ctor
, DocItem (DEntrypoint kind)
, DeriveCtorFieldDoc ctor cf
) =>
GDocumentEntrypoints kind (G.C1 ('G.MetaCons ctor _1 _2) x) where
gDocumentEntrypoints :: ParamBuilder
-> Rec
(CaseClauseL inp out) (GCaseClauses (C1 ('MetaCons ctor _1 _2) x))
-> Rec
(CaseClauseL inp out) (GCaseClauses (C1 ('MetaCons ctor _1 _2) x))
gDocumentEntrypoints ParamBuilder
michDesc (CaseClauseL AppendCtorField x inp :-> out
clause :& Rec (CaseClauseL inp out) rs
RNil) =
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 (Proxy ctor
forall k (t :: k). 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 kind)
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (Text -> SubDoc -> DEntrypoint kind
forall kind. Text -> SubDoc -> DEntrypoint kind
DEntrypoint @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 (DeriveCtorFieldDoc ctor cf => DEntrypointArg
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) '[]
-> Rec (CaseClauseL inp out) '[ 'CaseClauseParam ctor cf]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (CaseClauseL inp out) '[]
forall u (a :: u -> *). Rec a '[]
RNil
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
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 (inp :: [*]) (out :: [*]).
DocumentEntrypoints entrypointKind dt =>
Rec (CaseClauseL inp out) (CaseClauses dt)
-> Rec (CaseClauseL inp out) (CaseClauses dt)
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 :: Proxy entrypointKind -> IsoRecTuple clauses -> (dt : inp) :-> out
entryCase Proxy entrypointKind
p = Proxy entrypointKind
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep 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) (GCaseClauses (Rep dt))
-> (dt : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep dt)))
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep dt)))
-> IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep dt)))
-> (dt : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep dt)))
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep 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 :: ((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 (Proxy epName
forall k (t :: k). 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 (Text -> SubDoc -> DEntrypoint kind
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 ((NiceParameter param, TypeHasDoc param) => DEntrypointArg
forall arg. (NiceParameter arg, TypeHasDoc arg) => DEntrypointArg
constructDEpArg @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 param (s :: [*]) (out :: [*]).
(KnownSymbol epName, DocItem (DEntrypoint kind),
NiceParameter param, TypeHasDoc param) =>
((param : s) :-> out) -> (param : s) :-> out
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' :: 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
$ ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc]
forall cp. ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc]
pepDescsWithDef @cp
modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps [ParamBuildingStep]
pbs
| [ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps [ParamBuildingStep]
pbs =
Text -> [ParamBuildingStep]
forall a. HasCallStack => Text -> a
error Text
"Applying finalization second time"
| Bool
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] -> Bool
match [EpCallingStep]
cSteps [ParamBuildingStep]
pbSteps =
[Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
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) -> Bool) -> [Bool]
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 -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ctor2 -> Bool
True
(EpCallingStep, Maybe ParamBuildingStep)
_ -> Bool
False
where
prolong :: [a] -> [Maybe a]
prolong :: [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 (name :: Symbol) arg.
EpCallingDesc '(name, arg) -> [EpCallingStep]
epcdSteps = [EpCallingStep]
cSteps, epcdEntrypoint :: forall (name :: Symbol) arg. EpCallingDesc '(name, arg) -> EpName
epcdEntrypoint = EpName
ep })
[ParamBuildingStep]
pbSteps
| [EpCallingStep] -> [ParamBuildingStep] -> Bool
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
| Bool
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 :: ((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' (Proxy cp
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] -> Bool
areFinalizedParamBuildingSteps =
let
hasFinalizationTraces :: ParamBuildingStep -> Bool
hasFinalizationTraces = \case
PbsWrapIn{} -> Bool
False
PbsCallEntrypoint{} -> Bool
True
PbsCustom{} -> Bool
False
PbsUncallable{} -> Bool
True
in (Element [ParamBuildingStep] -> Bool)
-> [ParamBuildingStep] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any Element [ParamBuildingStep] -> Bool
ParamBuildingStep -> Bool
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_ :: 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_ (Proxy PlainEntrypointsKind
forall k (t :: k). Proxy t
Proxy @PlainEntrypointsKind)
where
_reqFlat :: Dict (RequireFlatEpDerivation cp (GetParameterEpDerivation cp))
_reqFlat = RequireFlatEpDerivation cp (GetParameterEpDerivation cp) =>
Dict (RequireFlatEpDerivation cp (GetParameterEpDerivation cp))
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 :: IsoRecTuple clauses -> (cp : inp) :-> out
entryCaseSimple = Rec (CaseClauseL inp out) (GCaseClauses (Rep 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) (GCaseClauses (Rep cp))
-> (cp : inp) :-> out)
-> (IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep cp)))
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep cp)))
-> IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep cp)))
-> (cp : inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsoRecTuple (Rec (CaseClauseL inp out) (GCaseClauses (Rep cp)))
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep 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 "`"
)
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>"