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

{-# OPTIONS_GHC -Wno-orphans #-}

module Lorentz.Doc
  ( doc
  , docGroup
  , dStorage
  , contractGeneralDefault
  , cutLorentzNonDoc

    -- * Views
  , DView (..)
  , DViewArg (..)
  , DViewRet (..)
  , DViewDesc (..)
  , ViewsDescriptorHasDoc (..)

    -- * Re-exports
  , Markdown
  , DocElem(..)
  , DocItem (..)
  , docItemPosition
  , DocItemId (..)
  , DocItemPlacementKind (..)
  , DocItemPos(..)
  , DocItemRef (..)
  , DocSection(..)
  , DocSectionNameStyle (..)
  , SomeDocItem (..)
  , SomeDocDefinitionItem (..)
  , SubDoc (..)
  , DocGrouping
  , ContractDoc (..)
  , DGeneralInfoSection (..)
  , DName (..)
  , DDescription (..)
  , DEntrypointExample (..)
  , mkDEntrypointExample
  , DGitRevision (..)
  , GitRepoSettings (..)
  , mkDGitRevision
  , morleyRepoSettings
  , DComment (..)
  , DAnchor (..)
  , DType (..)
  , dTypeDep
  , docDefinitionRef
  , contractDocToMarkdown
  , subDocToMarkdown
  , docItemSectionRef
  , ContainsDoc (..)
  , ContainsUpdateableDoc (..)
  , WithFinalizedDoc
  , finalizedAsIs
  , buildDoc
  , buildMarkdownDoc
  , modifyDoc
  , attachDocCommons

  , TypeHasDoc (..)
  , SomeTypeWithDoc (..)
  , typeDocBuiltMichelsonRep

  , HaveCommonTypeCtor
  , IsHomomorphic
  , genericTypeDocDependencies
  , customTypeDocMdReference
  , homomorphicTypeDocMdReference
  , poly1TypeDocMdReference
  , poly2TypeDocMdReference
  , homomorphicTypeDocHaskellRep
  , concreteTypeDocHaskellRep
  , unsafeConcreteTypeDocHaskellRep
  , haskellAddNewtypeField
  , haskellRepNoFields
  , haskellRepStripFieldPrefix
  , homomorphicTypeDocMichelsonRep
  , concreteTypeDocMichelsonRep
  , unsafeConcreteTypeDocMichelsonRep
  , mdTocFromRef
  ) where

import Data.Singletons (demote)
import Data.Typeable (typeRep)
import Fmt (Buildable(..), Builder, pretty)

import Lorentz.Base
import Lorentz.Constraints
import Lorentz.Lambda
import Lorentz.Value
import Lorentz.ViewBase
import Lorentz.Zip ()
import Morley.Michelson.Doc
import Morley.Michelson.Optimizer
import Morley.Michelson.Printer
import Morley.Michelson.Typed hiding (Contract, ContractCode, ContractCode'(..))
import Morley.Util.Generic
import Morley.Util.Markdown
import Morley.Util.Type
import Morley.Util.TypeLits

-- | Put a document item.
doc :: DocItem di => di -> s :-> s
doc :: forall di (s :: [*]). DocItem di => di -> s :-> s
doc = Instr (ToTs s) (ToTs s) -> s :-> s
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I (Instr (ToTs s) (ToTs s) -> s :-> s)
-> (di -> Instr (ToTs s) (ToTs s)) -> di -> s :-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. di -> Instr (ToTs s) (ToTs s)
forall di (s :: [T]). DocItem di => di -> Instr s s
docInstr

-- | Group documentation built in the given piece of code
-- into block dedicated to one thing, e.g. to one entrypoint.
--
-- Examples of doc items you can pass here: 'DName', 'DGeneralInfoSection'.
docGroup :: DocItem di => (SubDoc -> di) -> (inp :-> out) -> (inp :-> out)
docGroup :: forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup SubDoc -> di
gr = (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 (DocGrouping -> Instr (ToTs inp) o' -> Instr (ToTs inp) o'
forall (inp :: [T]) (out :: [T]).
DocGrouping -> Instr inp out -> Instr inp out
DocGroup (DocGrouping -> Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> DocGrouping -> Instr (ToTs inp) o' -> Instr (ToTs inp) o'
forall a b. (a -> b) -> a -> b
$ di -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem (di -> SomeDocItem) -> (SubDoc -> di) -> DocGrouping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubDoc -> di
gr)

-- | Inserts general information about the contract using the default format.
--
-- This includes git revision and some other information common
-- for all contracts.
-- Git revision is left unknown in the library code and is supposed
-- to be updated in an executable using e.g. 'attachDocCommons'.
contractGeneralDefault :: s :-> s
contractGeneralDefault :: forall (s :: [*]). s :-> s
contractGeneralDefault =
  ((SubDoc -> DGeneralInfoSection) -> (s :-> s) -> s :-> s
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup SubDoc -> DGeneralInfoSection
DGeneralInfoSection ((s :-> s) -> s :-> s) -> (s :-> s) -> s :-> s
forall a b. (a -> b) -> a -> b
$
     DGitRevision -> s :-> s
forall di (s :: [*]). DocItem di => di -> s :-> s
doc DGitRevision
DGitRevisionUnknown
  ) (s :-> s) -> (s :-> s) -> s :-> s
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  DToc -> s :-> s
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (Markdown -> DToc
DToc Markdown
"") (s :-> s) -> (s :-> s) -> s :-> s
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  DConversionInfo -> s :-> s
forall di (s :: [*]). DocItem di => di -> s :-> s
doc DConversionInfo
DConversionInfo

instance ContainsDoc (i :-> o) where
  buildDocUnfinalized :: (i :-> o) -> ContractDoc
buildDocUnfinalized = Instr (ToTs i) (ToTs o) -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized (Instr (ToTs i) (ToTs o) -> ContractDoc)
-> ((i :-> o) -> Instr (ToTs i) (ToTs o))
-> (i :-> o)
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i :-> o) -> Instr (ToTs i) (ToTs o)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode
instance ContainsUpdateableDoc (i :-> o) where
  modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> (i :-> o) -> i :-> o
modifyDocEntirely SomeDocItem -> SomeDocItem
how = (forall (o' :: [T]). Instr (ToTs i) o' -> Instr (ToTs i) o')
-> (i :-> o) -> i :-> o
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 i) o' -> Instr (ToTs i) o')
 -> (i :-> o) -> i :-> o)
-> (forall (o' :: [T]). Instr (ToTs i) o' -> Instr (ToTs i) o')
-> (i :-> o)
-> i :-> o
forall a b. (a -> b) -> a -> b
$ (SomeDocItem -> SomeDocItem)
-> Instr (ToTs i) o' -> Instr (ToTs i) o'
forall a.
ContainsUpdateableDoc a =>
(SomeDocItem -> SomeDocItem) -> a -> a
modifyDocEntirely SomeDocItem -> SomeDocItem
how

instance ContainsDoc (ContractCode i o) where
  buildDocUnfinalized :: ContractCode i o -> ContractDoc
buildDocUnfinalized = Instr
  '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)]
-> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized (Instr
   '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)]
 -> ContractDoc)
-> (ContractCode i o
    -> Instr
         '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)])
-> ContractCode i o
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ('[(i, o)] :-> ContractOut o)
-> Instr
     '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)]
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode (('[(i, o)] :-> ContractOut o)
 -> Instr
      '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)])
-> (ContractCode i o -> '[(i, o)] :-> ContractOut o)
-> ContractCode i o
-> Instr
     '[ 'TPair (ToT i) (ToT o)] '[ 'TPair ('TList 'TOperation) (ToT o)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractCode i o -> '[(i, o)] :-> ContractOut o
forall cp st. ContractCode cp st -> '[(cp, st)] :-> ContractOut st
unContractCode
instance ContainsUpdateableDoc (ContractCode i o) where
  modifyDocEntirely :: (SomeDocItem -> SomeDocItem)
-> ContractCode i o -> ContractCode i o
modifyDocEntirely SomeDocItem -> SomeDocItem
how (ContractCode '[(i, o)] :-> ContractOut o
x) = ('[(i, o)] :-> ContractOut o) -> ContractCode i o
forall cp st.
('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
ContractCode (('[(i, o)] :-> ContractOut o) -> ContractCode i o)
-> ('[(i, o)] :-> ContractOut o) -> ContractCode i o
forall a b. (a -> b) -> a -> b
$
    (forall (o' :: [T]).
 Instr (ToTs '[(i, o)]) o' -> Instr (ToTs '[(i, o)]) o')
-> ('[(i, o)] :-> ContractOut o) -> '[(i, o)] :-> ContractOut o
forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode ((SomeDocItem -> SomeDocItem)
-> Instr '[ 'TPair (ToT i) (ToT o)] o'
-> Instr '[ 'TPair (ToT i) (ToT o)] o'
forall a.
ContainsUpdateableDoc a =>
(SomeDocItem -> SomeDocItem) -> a -> a
modifyDocEntirely SomeDocItem -> SomeDocItem
how) '[(i, o)] :-> ContractOut o
x

instance ContainsDoc (Contract cp st vd) where
  buildDocUnfinalized :: Contract cp st vd -> ContractDoc
buildDocUnfinalized =
    ContractCode cp st -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized (ContractCode cp st -> ContractDoc)
-> (Contract cp st vd -> ContractCode cp st)
-> Contract cp st vd
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st vd -> ContractCode cp st
forall cp st vd. Contract cp st vd -> ContractCode cp st
cDocumentedCode
instance ContainsUpdateableDoc (Contract cp st vd) where
  modifyDocEntirely :: (SomeDocItem -> SomeDocItem)
-> Contract cp st vd -> Contract cp st vd
modifyDocEntirely SomeDocItem -> SomeDocItem
how Contract cp st vd
c =
    Contract cp st vd
c{ cDocumentedCode :: ContractCode cp st
cDocumentedCode = (SomeDocItem -> SomeDocItem)
-> ContractCode cp st -> ContractCode cp st
forall a.
ContainsUpdateableDoc a =>
(SomeDocItem -> SomeDocItem) -> a -> a
modifyDocEntirely SomeDocItem -> SomeDocItem
how (Contract cp st vd -> ContractCode cp st
forall cp st vd. Contract cp st vd -> ContractCode cp st
cDocumentedCode Contract cp st vd
c) }

-- | Leave only instructions related to documentation.
--
-- This function is useful when your method executes a lambda coming from outside,
-- but you know its properties and want to propagate its documentation to your
-- contract code.
cutLorentzNonDoc :: (inp :-> out) -> (s :-> s)
cutLorentzNonDoc :: forall (inp :: [*]) (out :: [*]) (s :: [*]).
(inp :-> out) -> s :-> s
cutLorentzNonDoc ((inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode -> Instr (ToTs inp) (ToTs out)
code) = Instr (ToTs s) (ToTs s) -> s :-> s
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I (Instr (ToTs s) (ToTs s) -> s :-> s)
-> Instr (ToTs s) (ToTs s) -> s :-> s
forall a b. (a -> b) -> a -> b
$ (forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr (ToTs inp) (ToTs out) -> Instr (ToTs s) (ToTs s)
forall (inp :: [T]) (out :: [T]) (s :: [T]).
(forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out -> Instr s s
cutInstrNonDoc forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
optimize Instr (ToTs inp) (ToTs out)
code

instance Each [Typeable, ReifyList TypeHasDoc] [i, o] => TypeHasDoc (WrappedLambda i o) where
  typeDocName :: Proxy (WrappedLambda i o) -> Text
typeDocName Proxy (WrappedLambda i o)
_ = Text
"WrappedLambda (extended lambda)"
  typeDocMdReference :: Proxy (WrappedLambda i o) -> WithinParens -> Markdown
typeDocMdReference Proxy (WrappedLambda i o)
tp WithinParens
wp =
    let DocItemRef DocItemId
ctorDocItemId = DType
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef (Proxy (WrappedLambda i o) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (WrappedLambda i o)
tp)
        refToThis :: Markdown
refToThis = Markdown -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef (Markdown -> Markdown
mdTicked Markdown
"WrappedLambda") DocItemId
ctorDocItemId
    in WithinParens -> Markdown -> Markdown
applyWithinParens WithinParens
wp (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
      [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
intersperse Markdown
" " [Markdown
refToThis, forall (s :: [*]). ReifyList TypeHasDoc s => Markdown
refToStack @i, forall (s :: [*]). ReifyList TypeHasDoc s => Markdown
refToStack @o]
    where
    refToStack :: forall s. ReifyList TypeHasDoc s => Markdown
    refToStack :: forall (s :: [*]). ReifyList TypeHasDoc s => Markdown
refToStack =
      let stack :: [Markdown]
stack = forall k (c :: k -> Constraint) (l :: [k]) r.
ReifyList c l =>
(forall (a :: k). c a => Proxy a -> r) -> [r]
reifyList @_ @TypeHasDoc @s (\Proxy a
p -> Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
p (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False))
      in [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
          [ Markdown -> Markdown
mdBold Markdown
"["
          , case [Markdown]
stack of
              [] -> Markdown
" "
              [Markdown]
st -> [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
intersperse (Markdown -> Markdown
mdBold Markdown
"," Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" ") [Markdown]
st
          , Markdown -> Markdown
mdBold Markdown
"]"
          ]

  typeDocMdDescription :: Markdown
typeDocMdDescription =
    Markdown
"`WrappedLambda i o` stands for a sequence of instructions which accepts stack \
    \of type `i` and returns stack of type `o`.\n\n\
    \When both `i` and `o` are of length 1, this primitive corresponds to \
    \the Michelson lambda. In more complex cases code is surrounded with `pair`\
    \and `unpair` instructions until fits into mentioned restriction.\
    \"
  typeDocDependencies :: Proxy (WrappedLambda i o) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (WrappedLambda i o)
_ = [[SomeDocDefinitionItem]] -> [SomeDocDefinitionItem]
forall a. Monoid a => [a] -> a
mconcat
    [ forall k (c :: k -> Constraint) (l :: [k]) r.
ReifyList c l =>
(forall (a :: k). c a => Proxy a -> r) -> [r]
reifyList @_ @TypeHasDoc @i forall a. TypeHasDoc a => Proxy a -> SomeDocDefinitionItem
dTypeDepP
    , forall k (c :: k -> Constraint) (l :: [k]) r.
ReifyList c l =>
(forall (a :: k). c a => Proxy a -> r) -> [r]
reifyList @_ @TypeHasDoc @o forall a. TypeHasDoc a => Proxy a -> SomeDocDefinitionItem
dTypeDepP
    , [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer
      , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Natural
      , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText
      ]
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (WrappedLambda i o)
typeDocHaskellRep Proxy (WrappedLambda i o)
_ FieldDescriptionsV
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (WrappedLambda i o)
typeDocMichelsonRep Proxy (WrappedLambda i o)
_ =
    ( DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just DocTypeRepLHS
"Code [Integer, Natural, MText, ()] [ByteString]"
    , forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT ([Integer, Natural, MText, ()] :-> '[ByteString]))
    )

instance (TypeHasDoc p, ViewsDescriptorHasDoc vd) => TypeHasDoc (TAddress p vd) where
  typeDocMdDescription :: Markdown
typeDocMdDescription = [md|
    A typed version of address primitive.

    Type in `TAddress` denotes parameter type of the target contract.

    This is not assumed to carry an entrypoint name.
    |]
  typeDocMdReference :: Proxy (TAddress p vd) -> WithinParens -> Markdown
typeDocMdReference Proxy (TAddress p vd)
pa =
    (Text, DType)
-> [WithinParens -> Markdown] -> WithinParens -> Markdown
customTypeDocMdReference' (Text
"TAddress", Proxy (TAddress p vd) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (TAddress p vd)
pa)
      [ Proxy p -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p)
      , \WithinParens
_wp -> Markdown -> DViewDesc -> Markdown
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
Markdown -> d -> Markdown
docDefinitionRef
          (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> (Text -> Markdown) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Proxy vd -> Text
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> Text
viewsDescriptorName (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vd))
          (Proxy vd -> DViewDesc
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> DViewDesc
DViewDesc (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vd))
      ]
  typeDocDependencies :: Proxy (TAddress p vd) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (TAddress p vd)
_ =
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @()
    , DViewDesc -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (DViewDesc -> SomeDocDefinitionItem)
-> DViewDesc -> SomeDocDefinitionItem
forall a b. (a -> b) -> a -> b
$ Proxy vd -> DViewDesc
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> DViewDesc
DViewDesc (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vd)
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (TAddress p vd)
typeDocHaskellRep Proxy (TAddress p vd)
_ FieldDescriptionsV
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (TAddress p vd)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(TAddress () ())

instance TypeHasDoc p => TypeHasDoc (FutureContract p) where
  typeDocName :: Proxy (FutureContract p) -> Text
typeDocName Proxy (FutureContract p)
_ = Text
"FutureContract"
  typeDocMdDescription :: Markdown
typeDocMdDescription = [md|
    A typed version of address primitive.

    Type in `FutureContract` denotes argument type of the target _entrypoint_.
    This address can carry an entrypoint name.

    We use `FutureContract` as a replacement for Michelson's `contract`, since
    places where the latter can appear are severely restricted.
    |]
  typeDocMdReference :: Proxy (FutureContract p) -> WithinParens -> Markdown
typeDocMdReference = Proxy (FutureContract p) -> WithinParens -> Markdown
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (FutureContract p) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (FutureContract p)
_ = [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @()]
  typeDocHaskellRep :: TypeDocHaskellRep (FutureContract p)
typeDocHaskellRep Proxy (FutureContract p)
_ FieldDescriptionsV
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (FutureContract p)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(FutureContract ())

-- | Modify the example value of an entrypoint
data DEntrypointExample = forall t . ParameterScope t => DEntrypointExample (Value t)

instance DocItem DEntrypointExample where
  docItemPos :: Natural
docItemPos = Natural
10000
  docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
  docItemToMarkdown :: HeaderLevel -> DEntrypointExample -> Markdown
docItemToMarkdown HeaderLevel
_ (DEntrypointExample Value t
val) =
    Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ DocItemReferencedKind -> Value' ExpandedOp -> Text
forall op.
RenderDoc op =>
DocItemReferencedKind -> Value' op -> Text
printUntypedValue DocItemReferencedKind
True (Value' ExpandedOp -> Text) -> Value' ExpandedOp -> Text
forall a b. (a -> b) -> a -> b
$ Value t -> Value' ExpandedOp
forall (t :: T). HasNoOp t => Value' Instr t -> Value' ExpandedOp
untypeValue Value t
val

mkDEntrypointExample :: forall a. NiceParameter a => a -> DEntrypointExample
mkDEntrypointExample :: forall a. NiceParameter a => a -> DEntrypointExample
mkDEntrypointExample a
v =
  (NiceParameter a :- ParameterScope (ToT a))
-> (ParameterScope (ToT a) => DEntrypointExample)
-> DEntrypointExample
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @a) ((ParameterScope (ToT a) => DEntrypointExample)
 -> DEntrypointExample)
-> (ParameterScope (ToT a) => DEntrypointExample)
-> DEntrypointExample
forall a b. (a -> b) -> a -> b
$
    Value (ToT a) -> DEntrypointExample
forall (t :: T). ParameterScope t => Value t -> DEntrypointExample
DEntrypointExample (Value (ToT a) -> DEntrypointExample)
-> Value (ToT a) -> DEntrypointExample
forall a b. (a -> b) -> a -> b
$ a -> Value (ToT a)
forall a. IsoValue a => a -> Value (ToT a)
toVal a
v

----------------------------------------------------------------------------
-- Views documentation
----------------------------------------------------------------------------

-- View doc items
----------------------------------------------------------------------------

-- | Renders to a view section.
data DView = DView
  { DView -> ViewName
dvName :: ViewName
  , DView -> SubDoc
dvSub :: SubDoc
  }

-- | Renders to a line mentioning the view's argument.
data DViewArg =
  forall a. (NiceViewable a, TypeHasDoc a) => DViewArg (Proxy a)

-- | Renders to a line mentioning the view's argument.
data DViewRet =
  forall a. (NiceViewable a, TypeHasDoc a) => DViewRet (Proxy a)

instance DocItem DViewArg where
  docItemPos :: Natural
docItemPos = Natural
20
  docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
  docItemDependencies :: DViewArg -> [SomeDocDefinitionItem]
docItemDependencies (DViewArg Proxy a
p) =
    [ 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
p) ]
  docItemToMarkdown :: HeaderLevel -> DViewArg -> Markdown
docItemToMarkdown HeaderLevel
_ (DViewArg Proxy a
p) =
    Markdown
"Argument type: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
p (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"

instance DocItem DViewRet where
  docItemPos :: Natural
docItemPos = Natural
21
  docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
  docItemDependencies :: DViewRet -> [SomeDocDefinitionItem]
docItemDependencies (DViewRet Proxy a
p) =
    [ 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
p) ]
  docItemToMarkdown :: HeaderLevel -> DViewRet -> Markdown
docItemToMarkdown HeaderLevel
_ (DViewRet Proxy a
p) =
    Markdown
"Return type: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
p (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"

instance DocItem DView where
  type DocItemPlacement DView = 'DocItemInlined
  type DocItemReferenced DView = 'True
  docItemRef :: DView
-> DocItemRef (DocItemPlacement DView) (DocItemReferenced DView)
docItemRef (DView ViewName
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
"views-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ViewName
name)
  docItemPos :: Natural
docItemPos = Natural
12000
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Contract views"
  docItemSectionDescription :: Maybe Markdown
docItemSectionDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just
    Markdown
"On-chain views of the contract."
  docItemToMarkdown :: HeaderLevel -> DView -> Markdown
docItemToMarkdown HeaderLevel
lvl (DView ViewName
name SubDoc
block) = [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
    [ HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
lvl (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown -> Markdown
mdTicked (ViewName -> Markdown
forall p. Buildable p => p -> Markdown
build ViewName
name)
    , HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown (HeaderLevel -> HeaderLevel
nextHeaderLevel HeaderLevel
lvl) SubDoc
block
    ]

-- View list
----------------------------------------------------------------------------

-- | Helper typeclass to renders information about view interface.
class RenderViewsImpl (vs :: [ViewTyInfo]) where
  renderViewsDocImpl :: Proxy vs -> Builder

instance RenderViewsImpl '[] where
  renderViewsDocImpl :: Proxy '[] -> Markdown
renderViewsDocImpl Proxy '[]
_ = Markdown
forall a. Monoid a => a
mempty

instance ( KnownSymbol name, TypeHasDoc arg, TypeHasDoc ret
         , RenderViewsImpl vs
         ) =>
         RenderViewsImpl ('ViewTyInfo name arg ret ': vs) where
  renderViewsDocImpl :: Proxy ('ViewTyInfo name arg ret : vs) -> Markdown
renderViewsDocImpl Proxy ('ViewTyInfo name arg ret : vs)
_ = [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
    [ [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ (Markdown -> Markdown) -> [Markdown] -> [Markdown]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n")
      [ Markdown
"* " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown -> Markdown
mdTicked (ViewName -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (ViewName -> Markdown) -> ViewName -> Markdown
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol).
(KnownSymbol name, HasCallStack) =>
ViewName
demoteViewName @name)
      , Markdown
"  + Parameter type: "
      , Markdown
"    * Haskell representation: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy arg -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg) (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False)
      , Markdown
"    * Michelson: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy arg -> Markdown
forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @arg)
      , Markdown
"  + Return type: "
      , Markdown
"    * Haskell representation: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy ret -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ret) (DocItemReferencedKind -> WithinParens
WithinParens DocItemReferencedKind
False)
      , Markdown
"    * Michelson: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy ret -> Markdown
forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ret)
      , Markdown
""
      ]
    , Proxy vs -> Markdown
forall (vs :: [ViewTyInfo]).
RenderViewsImpl vs =>
Proxy vs -> Markdown
renderViewsDocImpl (forall {t :: [ViewTyInfo]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs)
    ]

-- | Provides documentation for views descriptor.
--
-- Note that views descriptors may describe views that do not belong to the
-- current contract, e.g. @TAddress@ may refer to an external contract provided
-- by the user in which we want to call a view.
class (Typeable vd, RenderViewsImpl (RevealViews vd)) =>
      ViewsDescriptorHasDoc (vd :: Type) where

  viewsDescriptorName :: Proxy vd -> Text
  default viewsDescriptorName
    :: (Generic vd, KnownSymbol (GenericTypeName vd))
    => Proxy vd -> Text
  viewsDescriptorName Proxy vd
_ = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy (GenericTypeName vd) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @(GenericTypeName vd))
    where _reallyNeedGenerics :: Dict (Generic vd)
_reallyNeedGenerics = forall (a :: Constraint). a => Dict a
Dict @(Generic vd)

  renderViewsDescriptorDoc :: Proxy vd -> Builder
  renderViewsDescriptorDoc Proxy vd
_ =
    Markdown
"Contract having this type must contain the following views:\n"
    Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy (RevealViews vd) -> Markdown
forall (vs :: [ViewTyInfo]).
RenderViewsImpl vs =>
Proxy vs -> Markdown
renderViewsDocImpl (forall {t :: [ViewTyInfo]}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RevealViews vd))

-- | Renders to documentation of view descriptor.
data DViewDesc = forall vd. ViewsDescriptorHasDoc vd => DViewDesc (Proxy vd)

instance Eq DViewDesc where
  == :: DViewDesc -> DViewDesc -> DocItemReferencedKind
(==) = (Ordering -> Ordering -> DocItemReferencedKind
forall a. Eq a => a -> a -> DocItemReferencedKind
== Ordering
Prelude.EQ) (Ordering -> DocItemReferencedKind)
-> (DViewDesc -> DViewDesc -> Ordering)
-> DViewDesc
-> DViewDesc
-> DocItemReferencedKind
forall a b c. SuperComposition a b c => a -> b -> c
... DViewDesc -> DViewDesc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord DViewDesc where
  compare :: DViewDesc -> DViewDesc -> Ordering
compare = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeRep -> TypeRep -> Ordering)
-> (DViewDesc -> TypeRep) -> DViewDesc -> DViewDesc -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(DViewDesc Proxy vd
p) -> Proxy vd -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy vd
p)

instance DocItem DViewDesc where
  type DocItemPlacement DViewDesc = 'DocItemInDefinitions
  type DocItemReferenced DViewDesc = 'True
  docItemRef :: DViewDesc
-> DocItemRef
     (DocItemPlacement DViewDesc) (DocItemReferenced DViewDesc)
docItemRef (DViewDesc Proxy vd
p) = DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRef (DocItemId -> DocItemRef 'DocItemInDefinitions 'True)
-> DocItemId -> DocItemRef 'DocItemInDefinitions 'True
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId (Text
"views-descs-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Proxy vd -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy vd
p))
  docItemPos :: Natural
docItemPos = Natural
18010
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Referenced views descriptors"
  docItemSectionDescription :: Maybe Markdown
docItemSectionDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just
    Markdown
"All the mentioned views descriptors.\n\
    \Each descriptor stands for a set of views"
  docItemToMarkdown :: HeaderLevel -> DViewDesc -> Markdown
docItemToMarkdown HeaderLevel
lvl (DViewDesc Proxy vd
p) =
    [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
    [ Markdown
mdSeparator
    , HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
lvl (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 (Proxy vd -> Text
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> Text
viewsDescriptorName Proxy vd
p)
    , Markdown
"\n\n"
    , Proxy vd -> Markdown
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> Markdown
renderViewsDescriptorDoc Proxy vd
p
    ]