-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | Utilities for declaring and documenting entry points.
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, rappend)
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

-- | Gathers information about single entrypoint.
--
-- We assume that entry points might be of different kinds,
-- which is designated by phantom type parameter.
-- For instance, you may want to have several groups of entry points
-- corresponding to various parts of a contract - specifying different @kind@
-- type argument for each of those groups will allow you defining different
-- 'DocItem' instances with appropriate custom descriptions for them.
data DEntrypoint (kind :: Type) = DEntrypoint
  { forall kind. DEntrypoint kind -> Text
depName :: Text
  , forall kind. DEntrypoint kind -> SubDoc
depSub :: SubDoc
  }

-- | Pattern that checks whether given 'SomeDocItem' hides 'DEntrypoint' inside
-- (of any entrypoint kind).
--
-- In case a specific kind is necessary, use plain @(cast -> Just DEntrypoint{..})@
-- construction instead.
pattern DEntrypointDocItem :: DEntrypoint kind -> SomeDocItem
pattern $mDEntrypointDocItem :: forall {r}.
SomeDocItem
-> (forall {kind}. DEntrypoint kind -> r) -> (Void# -> r) -> r
DEntrypointDocItem dep <- SomeDocItem (castIgnoringPhantom -> Just dep)

-- | Default implementation of 'docItemToMarkdown' for entrypoints.
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

    -- | Modify 'SubDoc' of an entrypoint to replace its example value with the one defined in
    -- 'DEntrypointExample' in an ad-hoc way.
    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"

-- | Describes location of entrypoints of the given kind.
--
-- All such entrypoints will be placed under the same "entrypoints" section,
-- and this instance defines characteristics of this section.
class Typeable ep => EntrypointKindHasDoc (ep :: Type) where
  -- | Can be used to make a kind equivalent to some other kind;
  -- if changing this, 'entrypointKindPos' and 'entrypointKindSectionName'
  -- will be ignored.
  type EntrypointKindOverride ep
  type EntrypointKindOverride ep = ep

  -- | Implement this when specifying 'EntrypointKindOverride'.
  -- This should never be normally used, but because @MINIMAL@ pragma
  -- can't specify type families, we use this hack.
  --
  -- Default implementation is a bottom (i.e. a runtime error).
  --
  -- If implemented, it should be
  --
  -- > entrypointKindOverrideSpecified = Dict
  entrypointKindOverrideSpecified :: Dict ((EntrypointKindOverride ep == ep) ~ False)
  entrypointKindOverrideSpecified = Text -> Dict ((EntrypointKindOverride ep == ep) ~ 'False)
forall a. HasCallStack => Text -> a
error Text
"Called entrypointKindOverrideSpecified"

  -- | Position of the respective entrypoints section in the doc.
  -- This shares the same positions space with all other doc items.
  entrypointKindPos :: Natural
  default entrypointKindPos :: EntrypointKindHasDoc (EntrypointKindOverride ep) => Natural
  entrypointKindPos = forall ep. EntrypointKindHasDoc ep => Natural
entrypointKindPos @(EntrypointKindOverride ep)

  -- | Name of the respective entrypoints section.
  entrypointKindSectionName :: Text
  default entrypointKindSectionName :: EntrypointKindHasDoc (EntrypointKindOverride ep) => Text
  entrypointKindSectionName = forall ep. EntrypointKindHasDoc ep => Text
entrypointKindSectionName @(EntrypointKindOverride ep)

  -- | Description in the respective entrypoints section.
  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

-- | Mark code as part of entrypoint with given name.
--
-- This is automatically called at most of the appropriate situations, like
-- 'entryCase' calls.
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)

-- | Default value for 'DEntrypoint' type argument.
data PlainEntrypointsKind

instance EntrypointKindHasDoc PlainEntrypointsKind where
  entrypointKindPos :: Natural
entrypointKindPos = Natural
1000
  entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Entrypoints"

-- | Special entrypoint kind that flattens one level of recursive entrypoints.
--
-- With 'EpdRecursive', intermediary nodes are hidden from documentation.
--
-- With 'EpdDelegate', intermediary nodes will still be shown.
--
-- Any entrypoints can be omitted from docs by listing those in the type
-- parameter (which is especially helpful with 'EpdDelegate').
--
-- For other entrypoint derivation strategies (e.g. 'EpdPlain'), behaves like
-- 'PlainEntrypointsKind' (with the exception of hiding entrypoints from docs)
--
-- If you have several levels of recursion, each level will need to have this
-- kind.
--
-- Note that list of entrypoints to be hidden is not checked by default. Use
-- 'entryCaseFlattenedHiding' to have a static check that entrypoints to be
-- hidden do indeed exist.
data FlattenedEntrypointsKindHiding (hiddenEntrypoints :: [Symbol])

-- | A convenience type synonym for 'FlattenedEntrypointsKindHiding' not hiding
-- any entrypoitns.
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

-- | Describes the behaviour common for all entrypoints.
--
-- For instance, if your contract runs some checks before calling any
-- entrypoint, you probably want to wrap those checks into
-- @entrypointSection "Prior checks" (Proxy \@CommonContractBehaviourKind)@.
data CommonContractBehaviourKind

instance EntrypointKindHasDoc CommonContractBehaviourKind where
  entrypointKindPos :: Natural
entrypointKindPos = Natural
1800
  entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Common for all contract's entrypoints"

-- | Describes the behaviour common for entrypoints of given kind.
--
-- This has very special use cases, like contracts with mix of upgradeable
-- and permanent 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."

-- | Inserts a reference to an existing entrypoint.
--
-- This helps to avoid duplication in the generated documentation, in order not
-- to overwhelm the reader.
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."

-- | When describing the way of parameter construction - piece of incremental
-- builder for this description.
newtype ParamBuilder = ParamBuilder
  { ParamBuilder -> Markdown -> Markdown
unParamBuilder :: Markdown -> Markdown
    -- ^ Argument stands for previously constructed parameter piece, and
    -- returned value - a piece constructed after our step.
  }

-- | Show what given 'ParamBuilder' does on a sample.
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
    -- ^ Plain english description of this step.
  , ParamBuildingDesc -> ParamBuilder
pbdHaskell :: ParamBuilder
    -- ^ How to construct parameter in Haskell code.
  , ParamBuildingDesc -> ParamBuilder
pbdMichelson :: ParamBuilder
    -- ^ How to construct parameter working on raw Michelson.
  } 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)

-- | Describes a parameter building step.
--
-- This can be wrapping into (Haskell) constructor, or a more complex
-- transformation.
data ParamBuildingStep
    -- | Wraps something into constructor with given name.
    -- Constructor should be the one which corresponds to an entrypoint
    -- defined via field annotation, for more complex cases use 'PbsCustom'.
  = PbsWrapIn Text ParamBuildingDesc
    -- | Directly call an entrypoint marked with a field annotation.
  | PbsCallEntrypoint EpName
    -- | Other action.
  | PbsCustom ParamBuildingDesc
    -- | This entrypoint cannot be called, which is possible when an explicit
    -- default entrypoint is present. This is not a true entrypoint but just some
    -- intermediate node in @or@ tree and neither it nor any of its parents
    -- are marked with a field annotation.
    --
    -- It contains dummy 'ParamBuildingStep's which were assigned before
    -- entrypoints were taken into account.
  | 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

-- | Make a 'ParamBuildingStep' that tells about wrapping an argument into
-- a constructor with given name and uses given 'ParamBuilder' as description of
-- Michelson part.
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
    }

-- | Entrypoint argument type in typed representation.
data SomeEntrypointArg =
  forall a. (NiceParameter a, TypeHasDoc a) => SomeEntrypointArg (Proxy a)

-- | Describes argument of an entrypoint.
data DEntrypointArg =
  DEntrypointArg
  { DEntrypointArg -> Maybe SomeEntrypointArg
epaArg :: Maybe SomeEntrypointArg
    -- ^ Argument of the entrypoint. Pass 'Nothing' if no argument is required.
  , DEntrypointArg -> [ParamBuildingStep]
epaBuilding :: [ParamBuildingStep]
    -- ^ Describes a way to lift an entrypoint argument into full parameter
    -- which can be passed to the contract.
    --
    -- Steps are supposed to be applied in the order opposite to one in which
    -- they are given.
    -- E.g. suppose that an entrypoint is called as @Run (Service1 arg)@;
    -- then the first step (actual last) should describe wrapping into @Run@
    -- constructor, and the second step (actual first) should be about wrapping
    -- into @Service1@ constructor.
  }

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 = []
  }

-- | Go over contract code and update every occurrence of 'DEntrypointArg'
-- documentation item, modifying param building steps.
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) })

-- | Go over contract code and update every occurrence of 'DEntrypointArg'
-- documentation item, adding the given step to its "how to build parameter"
-- description.
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). 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 re-enumerates enumerated lists automatically
        (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."
              -- We could hide such entrypoints, but then in case of incorrect
              -- use of 'entryCase's or a bug in documentation, understanding
              -- what's going on would be hard

      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)
        ]

-- | Pick a type documentation from 'CtorField'.
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

-- | Add necessary documentation to entry points.
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 =
  forall (ept :: EPTree) kind (x :: * -> *) (inp :: [*])
       (out :: [*]).
GDocumentEntrypoints ept kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @(BuildEPTree' a) @kind @(G.Rep a) (ParamBuilder
 -> Rec (CaseClauseL inp out) (GCaseClauses (Rep a))
 -> Rec (CaseClauseL inp out) (GCaseClauses (Rep a)))
-> ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep a))
-> Rec (CaseClauseL inp out) (GCaseClauses (Rep a))
forall a b. (a -> b) -> a -> b
$
    (Markdown -> Markdown) -> ParamBuilder
ParamBuilder Markdown -> Markdown
forall a. a -> a
id

-- | Constraint for 'documentEntrypoints'.
type DocumentEntrypoints kind a =
  (Generic a, GDocumentEntrypoints (BuildEPTree' a) kind (G.Rep a))

type BuildEPTree' a = BuildEPTree (GetParameterEpDerivation a) a

-- | Traverse entry points and add parameter building step (which describes
-- necessity to wrap parameter into some constructor of the given datatype)
-- to all parameters described within given code.
class GDocumentEntrypoints (ept :: EPTree) (kind :: Type) (x :: Type -> Type) where
  -- | Add corresponding parameter building step.
  --
  -- First argument is accumulator for Michelson description of the building step.
  gDocumentEntrypoints
    :: ParamBuilder
    -> Rec (CaseClauseL inp out) (GCaseClauses x)
    -> Rec (CaseClauseL inp out) (GCaseClauses x)

instance GDocumentEntrypoints ept kind x => GDocumentEntrypoints ept kind (G.D1 i x) where
  gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x))
-> Rec (CaseClauseL inp out) (GCaseClauses (D1 i x))
gDocumentEntrypoints = forall (ept :: EPTree) kind (x :: * -> *) (inp :: [*])
       (out :: [*]).
GDocumentEntrypoints ept kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @ept @kind @x

instance ( GDocumentEntrypoints eptl kind x, GDocumentEntrypoints eptr kind y
         , RSplit (GCaseClauses x) (GCaseClauses y)
         ) =>
         GDocumentEntrypoints ('EPNode eptl eptr) kind (x :+: y) where
  gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
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) = 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 forall (ept :: EPTree) kind (x :: * -> *) (inp :: [*])
       (out :: [*]).
GDocumentEntrypoints ept kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @eptl @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`
       forall (ept :: EPTree) kind (x :: * -> *) (inp :: [*])
       (out :: [*]).
GDocumentEntrypoints ept kind x =>
ParamBuilder
-> Rec (CaseClauseL inp out) (GCaseClauses x)
-> Rec (CaseClauseL inp out) (GCaseClauses x)
gDocumentEntrypoints @eptr @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 {-# 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) where
  gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
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 (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) '[]
-> 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

instance ( 'CaseClauseParam ctor cf ~ GCaseBranchInput ctor x
         , KnownSymbol ctor
         ) =>
         GDocumentEntrypoints ('EPNode a b) (FlattenedEntrypointsKindHiding _heps)
            (G.C1 ('G.MetaCons ctor _1 _2) x) where
  gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
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 (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) '[]
-> 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

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) where
  gDocumentEntrypoints :: forall (inp :: [*]) (out :: [*]).
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 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) '[]
-> 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

-- | Like 'case_', to be used for pattern-matching on a parameter
-- or its part.
--
-- Modifies documentation accordingly. Including description of
-- entrypoints' arguments, thus for them you will need to supply
-- 'TypeHasDoc' instance.
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

-- | Version of 'entryCase_' for tuples.
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

-- | Wrapper for documenting single entrypoint which parameter
-- isn't going to be unwrapped from some datatype.
--
-- @entryCase@ unwraps a datatype, however, sometimes we want to
-- have entrypoint parameter to be not wrapped into some datatype.
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

-- | Provides arror for convenient entrypoint documentation
class EntryArrow kind name body where
  -- | Lift entrypoint implementation.
  --
  -- Entrypoint names should go with "e" prefix.
  (#->) :: (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

-- | Modify param building steps with respect to entrypoints that given
-- parameter declares.
--
-- Each contract with entrypoints should eventually call this function,
-- otherwise, in case if contract uses built-in entrypoints feature,
-- the resulting parameter building steps in the generated documentation
-- will not consider entrypoints and thus may be incorrect.
--
-- Calling this twice over the same code is also prohibited.
--
-- This method is for internal use, if you want to apply it to a contract
-- manually, use 'finalizeParamCallingDoc'.
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 =
      -- Reversing the list because if element @e1@ of this list is prefix of
      -- another element @e2@, we want @e2@ to appear eariler than @e1@ to
      -- match against it first. But without reverse exactly the opposite
      -- holds due to [order of entrypoints children] property.
      [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

    -- Further we check whether given 'EpCallingStep's form prefix of
    -- 'ParamBuildingStep's; if so, we can apply only part of building
    -- steps and then call the entrypoint directly

    match :: [EpCallingStep] -> [ParamBuildingStep] -> Bool
    match :: [EpCallingStep] -> [ParamBuildingStep] -> DocItemReferencedKind
match [EpCallingStep]
cSteps [ParamBuildingStep]
pbSteps =
      [DocItemReferencedKind] -> DocItemReferencedKind
forall t.
(Container t, Element t ~ DocItemReferencedKind) =>
t -> DocItemReferencedKind
and ([DocItemReferencedKind] -> DocItemReferencedKind)
-> [DocItemReferencedKind] -> 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

-- | Version of 'finalizeParamCallingDoc\'' more convenient for manual call in
-- a contract.
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
    -- We do not actually need it, requiring this constraint only to avoid
    -- misapplication of our function.
    _needSumType :: Dict (RequireSumType cp)
    _needSumType :: Dict (RequireSumType cp)
_needSumType = Dict (RequireSumType cp)
forall (a :: Constraint). a => Dict a
Dict

-- | Whether 'finalizeParamCallingDoc' has already been applied to these steps.
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> DocItemReferencedKind
areFinalizedParamBuildingSteps =
  -- Currently, 'finalizeParamCallingDoc' puts either 'PbsCallEntrypoint' or
  -- 'PbsUncallable' to list, and only it, and we rely on this behaviour here.
  -- If something changes so that these heuristics do not work, we can always
  -- insert special markers which would tell us whether finalization has been
  -- applied.
  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 t.
Container t =>
(Element t -> DocItemReferencedKind) -> t -> DocItemReferencedKind
any Element [ParamBuildingStep] -> DocItemReferencedKind
ParamBuildingStep -> DocItemReferencedKind
hasFinalizationTraces

-- | Version of 'entryCase_' for contracts with flat parameter.
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))

-- | Version of 'entryCase' for contracts with flat parameter.
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

-- | Version of 'entryCase_' for contracts with recursive parameter that needs
-- to be flattened. Use it with 'EpdRecursive' when you don't need intermediary
-- nodes in autodoc.
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)

-- | Version of 'entryCase' for contracts with recursive parameter that needs
-- to be flattened. Use it with 'EpdRecursive' when you don't need intermediary
-- nodes in autodoc.
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

-- | Version of 'entryCase_' for contracts with recursive delegate parameter that needs
-- to be flattened. Use it with 'EpdDelegate' when you don't need hierarchical
-- entrypoints in autodoc. You can also hide particular entrypoints with the
-- type parameter. Consider using 'entryCaseFlattened_' if you don't want
-- to hide any entrypoints.
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)

-- | Version of 'entryCase' for contracts with recursive delegate parameter that needs
-- to be flattened. Use it with 'EpdDelegate' when you don't need hierarchical
-- entrypoints in autodoc. You can also hide particular entrypoints with the
-- first type parameter. Consider using 'entryCaseFlattened' if you don't want
-- to hide any entrypoints.
--
-- @
--  entryCaseFlattenedHiding @'["Ep1", "Ep2"] ...
-- @
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
    )

-- Checking this is not strictly necessary, but let's try it
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 _ _ '[] = ()

---------------------------
-- Helper
---------------------------

-- | Surrouned a markdown text in a span tag with given id.
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>"