-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Utilities for declaring and documenting entry points.
module Lorentz.Entrypoints.Doc
  ( DEntrypoint (..)
  , DEntrypointReference (..)
  , EntryArrow (..)
  , PlainEntrypointsKind
  , diEntrypointToMarkdown
  , DEntrypointArg (..)
  , DType (..)
  , DeriveCtorFieldDoc (..)
  , ParamBuilder (..)
  , ParamBuildingDesc (..)
  , ParamBuildingStep (..)
  , mkPbsWrapIn
  , clarifyParamBuildingSteps
  , constructDEpArg
  , emptyDEpArg
  , mkUType
  , mkDEpUType
  , mkDEntrypointArgSimple
  , DocumentEntrypoints
  , documentEntrypoint
  , entryCase
  , entryCase_
  , finalizeParamCallingDoc
  , areFinalizedParamBuildingSteps
  , entryCaseSimple_
  , entryCaseSimple
  , RequireFlatParamEps
  , RequireFlatEpDerivation
  ) where

import Control.Lens.Cons (_head)
import Data.Char (toLower)
import Data.Constraint (Dict(..))
import qualified Data.Kind as Kind
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 Michelson.Printer (printUntypedValue)
import Michelson.Printer.Util (RenderDoc(..), needsParens, printDocB)
import Michelson.Typed (pattern DefEpName, EpName, mkUType, sampleValueFromUntype)
import Michelson.Typed.Doc
import Michelson.Typed.Haskell.Doc
import Michelson.Typed.Haskell.Instr
import qualified Michelson.Untyped as Untyped
import Util.Label (Label)
import Util.Markdown
import Util.Type
import Util.TypeLits
import Util.TypeTuple

-- | 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 :: Kind.Type) = DEntrypoint
  { DEntrypoint kind -> Text
depName :: Text
  , DEntrypoint kind -> SubDoc
depSub :: SubDoc
  }

-- | Default implementation of 'docItemToMarkdown' for entry points.
diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown lvl :: HeaderLevel
lvl (DEntrypoint name :: Text
name block :: 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 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

    -- | 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 sub :: DocBlock
sub) subDocMd :: 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 b :: d
b _ ) :| _)) ->
          Markdown -> Markdown -> Markdown
mdFindExampleIdAndReplace
            (HeaderLevel -> d -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdown (Int -> HeaderLevel
HeaderLevel 0) (d -> Markdown) -> d -> Markdown
forall a b. (a -> b) -> a -> b
$ d
b)
            Markdown
subDocMd
        Nothing -> Markdown
subDocMd

    mdFindExampleIdAndReplace :: Markdown -> Markdown -> Markdown
    mdFindExampleIdAndReplace :: Markdown -> Markdown -> Markdown
mdFindExampleIdAndReplace replaceTxt :: Markdown
replaceTxt inputText :: 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
$ (\w :: Text
w ->  case Text -> Text -> Bool
T.isInfixOf ("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
w of
        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
forall a. Semigroup a => a -> a -> a
<>
          Markdown -> Markdown -> Markdown
mdSubsection "Example" (Markdown -> Markdown -> Markdown
mdAddId Markdown
exampleId (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> Markdown
mdTicked Markdown
replaceTxt)
        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 = "example-id"

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

instance Show (DEntrypoint PlainEntrypointsKind) where
  show :: DEntrypoint PlainEntrypointsKind -> String
show (DEntrypoint name :: Text
name _) = Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
name
instance Eq (DEntrypoint PlainEntrypointsKind) where
  (DEntrypoint a1 :: Text
a1 _) == :: DEntrypoint PlainEntrypointsKind
-> DEntrypoint PlainEntrypointsKind -> Bool
== (DEntrypoint a2 :: Text
a2 _) = Text
a1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a2
instance Ord (DEntrypoint PlainEntrypointsKind) where
  (DEntrypoint a1 :: Text
a1 _) compare :: DEntrypoint PlainEntrypointsKind
-> DEntrypoint PlainEntrypointsKind -> Ordering
`compare` (DEntrypoint a2 :: Text
a2 _) = Text
a1 Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
a2

instance DocItem (DEntrypoint PlainEntrypointsKind) where
  type DocItemPlacement (DEntrypoint PlainEntrypointsKind) = 'DocItemInlined
  type DocItemReferenced (DEntrypoint PlainEntrypointsKind) = 'True
  docItemRef :: DEntrypoint PlainEntrypointsKind
-> DocItemRef
     (DocItemPlacement (DEntrypoint PlainEntrypointsKind))
     (DocItemReferenced (DEntrypoint PlainEntrypointsKind))
docItemRef (DEntrypoint name :: Text
name _) = DocItemId
-> DocItemRef
     (DocItemPlacement (DEntrypoint PlainEntrypointsKind))
     (DocItemReferenced (DEntrypoint PlainEntrypointsKind))
DocItemId -> DocItemRef 'DocItemInlined 'True
DocItemRefInlined (DocItemId
 -> DocItemRef
      (DocItemPlacement (DEntrypoint PlainEntrypointsKind))
      (DocItemReferenced (DEntrypoint PlainEntrypointsKind)))
-> DocItemId
-> DocItemRef
     (DocItemPlacement (DEntrypoint PlainEntrypointsKind))
     (DocItemReferenced (DEntrypoint PlainEntrypointsKind))
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId ("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 = 1000
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just "Entrypoints"
  docItemToMarkdown :: HeaderLevel -> DEntrypoint PlainEntrypointsKind -> Markdown
docItemToMarkdown = HeaderLevel -> DEntrypoint PlainEntrypointsKind -> Markdown
forall level. HeaderLevel -> DEntrypoint level -> Markdown
diEntrypointToMarkdown
  docItemToToc :: HeaderLevel -> DEntrypoint PlainEntrypointsKind -> Markdown
docItemToToc lvl :: HeaderLevel
lvl d :: DEntrypoint PlainEntrypointsKind
d@(DEntrypoint name :: Text
name _) =
    HeaderLevel
-> Markdown -> DEntrypoint PlainEntrypointsKind -> 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 PlainEntrypointsKind
d

data DEntrypointReference = DEntrypointReference Text Anchor

instance DocItem DEntrypointReference where
  docItemPos :: Natural
docItemPos = 13
  docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
  docItemToMarkdown :: HeaderLevel -> DEntrypointReference -> Markdown
docItemToMarkdown _ (DEntrypointReference name :: Text
name anchor :: Anchor
anchor) =
    "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
<>
    " 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 b :: Markdown -> Markdown
b) = Markdown -> Markdown
b "·"

instance Buildable ParamBuilder where
  build :: ParamBuilder -> Markdown
build = ParamBuilder -> Markdown
pbSample

instance Show ParamBuilder where
  show :: ParamBuilder -> String
show (ParamBuilder pb :: Markdown -> Markdown
pb) =
    -- Using @'x'@ symbol here because unicode does not render well in 'show'
    "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 "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
    -- ^ 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 (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)

-- | 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 (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 ctor :: Text
ctor _desc :: ParamBuildingDesc
_desc -> "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
<> "`"
    PbsCallEntrypoint ep :: EpName
ep -> "Call entrypoint " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> EpName -> Markdown
forall p. Buildable p => p -> Markdown
build EpName
ep
    PbsCustom desc :: ParamBuildingDesc
desc -> "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
<> "\""
    PbsUncallable steps :: [ParamBuildingStep]
steps -> "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 ctorName :: Text
ctorName michDesc :: ParamBuilder
michDesc =
  Text -> ParamBuildingDesc -> ParamBuildingStep
PbsWrapIn Text
ctorName $WParamBuildingDesc :: Markdown -> ParamBuilder -> ParamBuilder -> ParamBuildingDesc
ParamBuildingDesc
    { pbdEnglish :: Markdown
pbdEnglish = "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
<> " constructor."
    , pbdHaskell :: ParamBuilder
pbdHaskell = (Markdown -> Markdown) -> ParamBuilder
ParamBuilder ((Markdown -> Markdown) -> ParamBuilder)
-> (Markdown -> Markdown) -> ParamBuilder
forall a b. (a -> b) -> a -> b
$ \p :: 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
forall a. Semigroup a => a -> a -> a
<> Markdown
p Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> ")"
    , pbdMichelson :: ParamBuilder
pbdMichelson = ParamBuilder
michDesc
    }

-- | Describes argument of an entrypoint.
data DEntrypointArg =
  DEntrypointArg
  { DEntrypointArg -> Maybe DType
epaArg :: Maybe DType
    -- ^ 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.
  , DEntrypointArg -> Type
epaType :: Untyped.Type
    -- ^ Untyped representation of entrypoint, used for printing its michelson
    -- type representation.
  }

constructDEpArg
  :: forall arg.
     ( TypeHasDoc arg
     , HasAnnotation arg
     , KnownValue arg
     )
  => DEntrypointArg
constructDEpArg :: DEntrypointArg
constructDEpArg = $WDEntrypointArg :: Maybe DType -> [ParamBuildingStep] -> Type -> DEntrypointArg
DEntrypointArg
  { epaArg :: Maybe DType
epaArg = DType -> Maybe DType
forall a. a -> Maybe a
Just (DType -> Maybe DType) -> DType -> Maybe DType
forall a b. (a -> b) -> a -> b
$ Proxy arg -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy arg
forall k (t :: k). Proxy t
Proxy @arg)
  , epaBuilding :: [ParamBuildingStep]
epaBuilding = []
  , epaType :: Type
epaType = (KnownValue arg, HasAnnotation arg) => Type
forall t. (KnownValue t, HasAnnotation t) => Type
mkDEpUType @arg
  }

emptyDEpArg :: DEntrypointArg
emptyDEpArg :: DEntrypointArg
emptyDEpArg = $WDEntrypointArg :: Maybe DType -> [ParamBuildingStep] -> Type -> DEntrypointArg
DEntrypointArg
  { epaArg :: Maybe DType
epaArg = Maybe DType
forall a. Maybe a
Nothing
  , epaBuilding :: [ParamBuildingStep]
epaBuilding = []
  , epaType :: Type
epaType = T -> TypeAnn -> Type
Untyped.Type T
Untyped.TUnit TypeAnn
forall k (a :: k). Annotation a
Untyped.noAnn
  }

mkDEpUType :: forall t. (KnownValue t, HasAnnotation t) => Untyped.Type
mkDEpUType :: Type
mkDEpUType = Notes (ToT t) -> Type
forall (x :: T). SingI x => Notes x -> Type
mkUType (FollowEntrypointFlag -> Notes (ToT t)
forall a. HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a)
getAnnotation @t FollowEntrypointFlag
FollowEntrypoint)

mkDEntrypointArgSimple
  :: forall t.
     ( KnownValue t
     , HasAnnotation t
     , TypeHasDoc t
     )
  => DEntrypointArg
mkDEntrypointArgSimple :: DEntrypointArg
mkDEntrypointArgSimple = $WDEntrypointArg :: Maybe DType -> [ParamBuildingStep] -> Type -> DEntrypointArg
DEntrypointArg
  { epaArg :: Maybe DType
epaArg = DType -> Maybe DType
forall a. a -> Maybe a
Just (DType -> Maybe DType) -> DType -> Maybe DType
forall a b. (a -> b) -> a -> b
$ Proxy t -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy t
forall k (t :: k). Proxy t
Proxy @t)
  , epaBuilding :: [ParamBuildingStep]
epaBuilding = []
  , epaType :: Type
epaType = (KnownValue t, HasAnnotation t) => Type
forall t. (KnownValue t, HasAnnotation t) => Type
mkDEpUType @t
  }

-- | Go over contract code and update every occurrence of 'DEntrypointArg'
-- documentation item, modifying param building steps.
modifyParamBuildingSteps
  :: ([ParamBuildingStep] -> [ParamBuildingStep])
  -> (inp :-> out)
  -> (inp :-> out)
modifyParamBuildingSteps :: ([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
modifyParamBuildingSteps f :: [ParamBuildingStep] -> [ParamBuildingStep]
f =
  (forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out
forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode ((forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
 -> (inp :-> out) -> inp :-> out)
-> (forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out)
-> inp :-> out
forall a b. (a -> b) -> a -> b
$
  (DEntrypointArg -> Maybe DEntrypointArg)
-> Instr (ToTs inp) o' -> Instr (ToTs inp) o'
forall i1 i2 (inp :: [T]) (out :: [T]).
(DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> Instr inp out -> Instr inp out
modifyInstrDoc (\di :: 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 :: ParamBuildingStep -> (inp :-> out) -> inp :-> out
clarifyParamBuildingSteps pbs :: 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 = 20
  docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
  docItemDependencies :: DEntrypointArg -> [SomeDocDefinitionItem]
docItemDependencies (DEntrypointArg mdty :: Maybe DType
mdty _ _) =
    [DType -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem DType
dty | Just dty :: DType
dty <- Maybe DType -> [Maybe DType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DType
mdty]
  docItemToMarkdown :: HeaderLevel -> DEntrypointArg -> Markdown
docItemToMarkdown _ (DEntrypointArg mdty :: Maybe DType
mdty psteps :: [ParamBuildingStep]
psteps et :: Type
et) =
    [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
<> "\n\n") ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
      [ Markdown -> Markdown -> Markdown
mdSubsection "Argument" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
          case Maybe DType
mdty of
            Nothing -> "none (pass unit)"
            Just (DType (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 "\n" ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
              [ Markdown
forall a. Monoid a => a
mempty
              , "  + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
                Markdown -> Markdown -> Markdown
mdSubsection "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
forall a. Semigroup a => a -> a -> a
<>
                Markdown -> Markdown -> Markdown
mdSubsection "In Michelson"
                  (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Bool -> Doc -> Markdown
printDocB Bool
False (Doc -> Markdown) -> (Type -> Doc) -> Type -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> Type -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens (Type -> Markdown) -> Type -> Markdown
forall a b. (a -> b) -> a -> b
$ Type
et)
              , "    + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
                Markdown -> Markdown -> Markdown
mdSubsection "Example"
                  (Markdown -> Markdown -> Markdown
mdAddId "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' ExpandedOp -> Text
forall op. RenderDoc op => Bool -> Value' op -> Text
printUntypedValue Bool
True
                    (Value' ExpandedOp -> Text) -> Value' ExpandedOp -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Type -> Value' ExpandedOp
Type -> Value' ExpandedOp
sampleValueFromUntype Type
et
                  )
              ],
          Markdown -> Markdown -> Markdown
mdSpoiler "How to call this entrypoint" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
            "\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 "\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 ("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 _ pbd :: ParamBuildingDesc
pbd ->
              ParamBuildingDesc -> Markdown
renderPbDesc ParamBuildingDesc
pbd
            PbsCallEntrypoint ep :: EpName
ep -> case EpName
ep of
              DefEpName ->
                "Call the contract (default entrypoint) with the constructed \
                \argument."
              _ ->
                "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
<> " entrypoint \
                \passing the constructed argument."
            PbsCustom pbd :: ParamBuildingDesc
pbd ->
              ParamBuildingDesc -> Markdown
renderPbDesc ParamBuildingDesc
pbd
            PbsUncallable _ ->
              "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] -> 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 "\n" ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
        [ Markdown
pbdEnglish
        , "    + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
          Markdown -> Markdown -> Markdown
mdSubsection "In Haskell" (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ ParamBuilder -> Markdown
pbSample ParamBuilder
pbdHaskell)
        , "    + " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
          Markdown -> Markdown -> Markdown
mdSubsection "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
    (TypeHasDoc ty, HasAnnotation ty, KnownValue ty, KnownSymbol con)
  =>
    DeriveCtorFieldDoc con ('OneField ty)
  where
  deriveCtorFieldDoc :: DEntrypointArg
deriveCtorFieldDoc = (TypeHasDoc ty, HasAnnotation ty, KnownValue ty) => DEntrypointArg
forall arg.
(TypeHasDoc arg, HasAnnotation arg, KnownValue arg) =>
DEntrypointArg
constructDEpArg @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 :: 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)

-- | Constraint for 'documentEntrypoints'.
type DocumentEntrypoints kind a =
  (Generic a, GDocumentEntrypoints kind (G.Rep 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 (kind :: Kind.Type) (x :: Kind.Type -> Kind.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 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 michDesc :: Markdown -> Markdown
michDesc) clauses :: Rec (CaseClauseL inp out) (GCaseClauses (x :+: y))
clauses =
    let (lclauses :: Rec (CaseClauseL inp out) (GCaseClauses x)
lclauses, rclauses :: 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
$ \a :: Markdown
a -> Markdown -> Markdown
michDesc (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ "Left (" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
a Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> ")")
         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
$ \a :: Markdown
a -> Markdown -> Markdown
michDesc (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ "Right (" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
a Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> ")")
         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 michDesc :: ParamBuilder
michDesc (CaseClauseL clause :: AppendCtorField x inp :-> out
clause :& 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 instr :: 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
$
          DocGrouping
-> (AppendCtorField cf inp :-> out)
-> AppendCtorField cf inp :-> out
forall (inp :: [*]) (out :: [*]).
DocGrouping -> (inp :-> out) -> inp :-> out
docGroup (DEntrypoint kind -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem (DEntrypoint kind -> SomeDocItem)
-> (SubDoc -> DEntrypoint kind) -> DocGrouping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

-- | 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_ :: Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt & inp) :-> out
entryCase_ _ = 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

-- | 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 :: Proxy entrypointKind -> IsoRecTuple clauses -> (dt & inp) :-> out
entryCase p :: 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

-- | 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)
     , TypeHasDoc param
     , HasAnnotation param
     , KnownValue param
     )
  => param & s :-> out -> param & s :-> out
documentEntrypoint :: ((param & s) :-> out) -> (param & s) :-> out
documentEntrypoint instr :: (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
    DocGrouping -> ((param & s) :-> out) -> (param & s) :-> out
forall (inp :: [*]) (out :: [*]).
DocGrouping -> (inp :-> out) -> inp :-> out
docGroup (DEntrypoint kind -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem (DEntrypoint kind -> SomeDocItem)
-> (SubDoc -> DEntrypoint kind) -> DocGrouping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ((TypeHasDoc param, HasAnnotation param, KnownValue param) =>
DEntrypointArg
forall arg.
(TypeHasDoc arg, HasAnnotation arg, KnownValue 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

-- | 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)
         , TypeHasDoc param
         , HasAnnotation param
         , KnownValue param
         ) => EntryArrow kind name body where
  #-> :: (Label name, Proxy kind) -> body -> body
(#->) _ = forall param (s :: [*]) (out :: [*]).
(KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param,
 HasAnnotation param, KnownValue param) =>
((param & s) :-> out) -> (param & s) :-> out
forall kind (epName :: Symbol) param (s :: [*]) (out :: [*]).
(KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param,
 HasAnnotation param, KnownValue 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.
finalizeParamCallingDoc
  :: forall cp inp out.
     (NiceParameterFull cp, RequireSumType cp, HasCallStack)
  => (cp : inp :-> out) -> (cp : inp :-> out)
finalizeParamCallingDoc :: ((cp : inp) :-> out) -> (cp : inp) :-> out
finalizeParamCallingDoc = ([ParamBuildingStep] -> [ParamBuildingStep])
-> ((cp : inp) :-> out) -> (cp : inp) :-> out
forall (inp :: [*]) (out :: [*]).
([ParamBuildingStep] -> [ParamBuildingStep])
-> (inp :-> out) -> inp :-> out
modifyParamBuildingSteps [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps
  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

    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
$ ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc]
forall cp. ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc]
pepDescsWithDef @cp

    modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
    modifySteps :: [ParamBuildingStep] -> [ParamBuildingStep]
modifySteps pbs :: [ParamBuildingStep]
pbs
      | [ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps [ParamBuildingStep]
pbs =
          Text -> [ParamBuildingStep]
forall a. HasCallStack => Text -> a
error "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
<&> \epDesc :: 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] -> Bool
match cSteps :: [EpCallingStep]
cSteps pbSteps :: [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 ctor :: Text
ctor, Just (PbsWrapIn ctor2 :: Text
ctor2 _)) | Text
ctor Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ctor2 -> Bool
True
        _ -> Bool
False
      where
        prolong :: [a] -> [Maybe a]
        prolong :: [a] -> [Maybe a]
prolong l :: [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 })
                pbSteps :: [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

-- | Whether 'finalizeParamCallingDoc' has already been applied to these steps.
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool
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 -> 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
     , NiceParameterFull cp
     , RequireFlatParamEps cp
     )
  => Rec (CaseClauseL inp out) (CaseClauses cp)
  -> cp & inp :-> out
entryCaseSimple_ :: Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp & inp) :-> out
entryCaseSimple_ =
  ((cp & inp) :-> out) -> (cp & inp) :-> out
forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
((cp : inp) :-> out) -> (cp : inp) :-> out
finalizeParamCallingDoc (((cp & inp) :-> out) -> (cp & inp) :-> out)
-> (Rec (CaseClauseL inp out) (CaseClauses cp)
    -> (cp & inp) :-> out)
-> Rec (CaseClauseL inp out) (CaseClauses cp)
-> (cp & inp) :-> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))

-- | Version of 'entryCase' for contracts with flat parameter, use it when you
-- need only one 'entryCase' all over the contract implementation.
--
-- This method calls 'finalizeParamCallingDoc' inside.
entryCaseSimple
  :: forall cp out inp clauses.
     ( CaseTC cp out inp clauses
     , DocumentEntrypoints PlainEntrypointsKind cp
     , NiceParameterFull 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, NiceParameterFull 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 =
    ( 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 "`"
    )

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

-- | Surrouned a markdown text in a span tag with given id.
mdAddId :: Markdown -> Markdown -> Markdown
mdAddId :: Markdown -> Markdown -> Markdown
mdAddId idTxt :: Markdown
idTxt txt :: Markdown
txt = "<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
forall a. Semigroup a => a -> a -> a
<> Markdown
txt Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> "</span>"