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

{-# OPTIONS_GHC -Wno-orphans #-}

module Lorentz.Doc
  ( doc
  , docGroup
  , dStorage
  , docStorage
  , buildLorentzDoc
  , buildLorentzDocWithGitRev
  , renderLorentzDoc
  , renderLorentzDocWithGitRev
  , contractName
  , contractGeneral
  , 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.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)
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 :: 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 :: (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)

-- | Insert documentation of the contract storage type. The type
-- should be passed using type applications.
{-# DEPRECATED docStorage "Use `doc (dStorage @storage)` instead." #-}
docStorage :: forall storage s. TypeHasDoc storage => s :-> s
docStorage :: s :-> s
docStorage = DStorageType -> s :-> s
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (DStorageType -> s :-> s) -> DStorageType -> s :-> s
forall a b. (a -> b) -> a -> b
$ DType -> DStorageType
DStorageType (DType -> DStorageType) -> DType -> DStorageType
forall a b. (a -> b) -> a -> b
$ Proxy storage -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy storage -> DType) -> Proxy storage -> DType
forall a b. (a -> b) -> a -> b
$ Proxy storage
forall k (t :: k). Proxy t
Proxy @storage

-- | Give a name to given contract. Apply it to the whole contract code.
{-# DEPRECATED contractName "Use `docGroup name` instead." #-}
contractName :: Text -> (inp :-> out) -> (inp :-> out)
contractName :: Text -> (inp :-> out) -> inp :-> out
contractName Text
name = (SubDoc -> DName) -> (inp :-> out) -> inp :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (Text -> SubDoc -> DName
DName Text
name)

{-# DEPRECATED buildLorentzDoc "Use 'buildDoc' instead." #-}
buildLorentzDoc :: inp :-> out -> ContractDoc
buildLorentzDoc :: (inp :-> out) -> ContractDoc
buildLorentzDoc = (inp :-> out) -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized

-- | Takes an instruction that inserts documentation items with
-- general information about the contract. Inserts it into general
-- section. See 'DGeneralInfoSection'.
{-# DEPRECATED contractGeneral "Use `docGroup DGeneralInfoSection` instead." #-}
contractGeneral :: (inp :-> out) -> (inp :-> out)
contractGeneral :: (inp :-> out) -> inp :-> out
contractGeneral = (SubDoc -> DGeneralInfoSection) -> (inp :-> out) -> inp :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup SubDoc -> DGeneralInfoSection
DGeneralInfoSection

-- | 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. 'buildLorentzDocWithGitRev'.
contractGeneralDefault :: s :-> s
contractGeneralDefault :: 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 (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) }

{-# DEPRECATED buildLorentzDocWithGitRev
    "Use `buildDoc . attachDocCommons gitRev` instead."
  #-}
buildLorentzDocWithGitRev :: DGitRevision -> inp :-> out -> ContractDoc
buildLorentzDocWithGitRev :: DGitRevision -> (inp :-> out) -> ContractDoc
buildLorentzDocWithGitRev DGitRevision
gitRev = WithFinalizedDoc (inp :-> out) -> ContractDoc
forall a. ContainsDoc a => WithFinalizedDoc a -> ContractDoc
buildDoc (WithFinalizedDoc (inp :-> out) -> ContractDoc)
-> ((inp :-> out) -> WithFinalizedDoc (inp :-> out))
-> (inp :-> out)
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DGitRevision -> (inp :-> out) -> WithFinalizedDoc (inp :-> out)
forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachDocCommons DGitRevision
gitRev

{-# DEPRECATED renderLorentzDoc "Use 'buildMarkdownDoc' instead." #-}
renderLorentzDoc :: inp :-> out -> LText
renderLorentzDoc :: (inp :-> out) -> LText
renderLorentzDoc = WithFinalizedDoc (inp :-> out) -> LText
forall a. ContainsDoc a => WithFinalizedDoc a -> LText
buildMarkdownDoc (WithFinalizedDoc (inp :-> out) -> LText)
-> ((inp :-> out) -> WithFinalizedDoc (inp :-> out))
-> (inp :-> out)
-> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inp :-> out) -> WithFinalizedDoc (inp :-> out)
forall a. a -> WithFinalizedDoc a
finalizedAsIs

{-# DEPRECATED renderLorentzDocWithGitRev
    "Use `buildMarkdownDoc . attachDocCommons gitRev` instead."
  #-}
renderLorentzDocWithGitRev :: DGitRevision -> inp :-> out -> LText
renderLorentzDocWithGitRev :: DGitRevision -> (inp :-> out) -> LText
renderLorentzDocWithGitRev DGitRevision
gitRev = ContractDoc -> LText
contractDocToMarkdown (ContractDoc -> LText)
-> ((inp :-> out) -> ContractDoc) -> (inp :-> out) -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DGitRevision -> (inp :-> out) -> ContractDoc
forall (inp :: [*]) (out :: [*]).
DGitRevision -> (inp :-> out) -> ContractDoc
buildLorentzDocWithGitRev DGitRevision
gitRev

-- | 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 :: (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 (i :-> o) where
  typeDocName :: Proxy (i :-> o) -> Text
typeDocName Proxy (i :-> o)
_ = Text
"Code (extended lambda)"
  typeDocMdReference :: Proxy (i :-> o) -> WithinParens -> Markdown
typeDocMdReference Proxy (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 (i :-> o) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (i :-> o)
tp)
        refToThis :: Markdown
refToThis = Markdown -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef (Markdown -> Markdown
mdTicked Markdown
"Code") 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, ReifyList TypeHasDoc i => Markdown
forall (s :: [*]). ReifyList TypeHasDoc s => Markdown
refToStack @i, ReifyList TypeHasDoc o => Markdown
forall (s :: [*]). ReifyList TypeHasDoc s => Markdown
refToStack @o]
    where
    refToStack :: forall s. ReifyList TypeHasDoc s => Markdown
    refToStack :: Markdown
refToStack =
      let stack :: [Markdown]
stack = (forall a. TypeHasDoc a => Proxy a -> Markdown) -> [Markdown]
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 (Bool -> WithinParens
WithinParens Bool
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
"`Code 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 (i :-> o) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (i :-> o)
_ = [[SomeDocDefinitionItem]] -> [SomeDocDefinitionItem]
forall a. Monoid a => [a] -> a
mconcat
    [ (forall a. TypeHasDoc a => Proxy a -> SomeDocDefinitionItem)
-> [SomeDocDefinitionItem]
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 a. TypeHasDoc a => Proxy a -> SomeDocDefinitionItem)
-> [SomeDocDefinitionItem]
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
    , [ TypeHasDoc Integer => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer
      , TypeHasDoc Natural => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Natural
      , TypeHasDoc MText => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText
      ]
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (i :-> o)
typeDocHaskellRep Proxy (i :-> o)
_ FieldDescriptionsV
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (i :-> o)
typeDocMichelsonRep Proxy (i :-> o)
_ =
    ( DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just DocTypeRepLHS
"Code [Integer, Natural, MText, ()] [ByteString]"
    , (SingKind T,
 SingI (ToT ('[Integer, Natural, MText, ()] :-> '[ByteString]))) =>
Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
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 (Proxy p
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 (Proxy vd
forall k (t :: k). Proxy t
Proxy @vd))
          (Proxy vd -> DViewDesc
forall vd. ViewsDescriptorHasDoc vd => Proxy vd -> DViewDesc
DViewDesc (Proxy vd
forall k (t :: k). Proxy t
Proxy @vd))
      ]
  typeDocDependencies :: Proxy (TAddress p vd) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (TAddress p vd)
_ =
    [ TypeHasDoc () => SomeDocDefinitionItem
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 (Proxy vd
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 b.
(Typeable (TAddress () ()), KnownIsoT (TAddress () ()),
 HaveCommonTypeCtor b (TAddress () ())) =>
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)
_ = [TypeHasDoc () => SomeDocDefinitionItem
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 b.
(Typeable (FutureContract ()), KnownIsoT (FutureContract ()),
 HaveCommonTypeCtor b (FutureContract ())) =>
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) =
    LText -> Markdown
forall p. Buildable p => p -> Markdown
build (LText -> Markdown) -> LText -> Markdown
forall a b. (a -> b) -> a -> b
$ Bool -> Value' ExpandedOp -> LText
forall op. RenderDoc op => Bool -> Value' op -> LText
printUntypedValue Bool
True (Value' ExpandedOp -> LText) -> Value' ExpandedOp -> LText
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 :: a -> DEntrypointExample
mkDEntrypointExample a
v =
  (((SingI (ToT a), WellTyped (ToT a),
   FailOnOperationFound (ContainsOp (ToT a)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT a))),
  KnownValue a)
 :- ParameterScope (ToT a))
-> (ParameterScope (ToT a) => DEntrypointExample)
-> DEntrypointExample
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (((SingI (ToT a), WellTyped (ToT a),
  FailOnOperationFound (ContainsOp (ToT a)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT a))),
 KnownValue a)
:- ParameterScope (ToT a)
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 (Bool -> WithinParens
WithinParens Bool
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 (Bool -> WithinParens
WithinParens Bool
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
$ (KnownSymbol name, HasCallStack) => ViewName
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 (Proxy arg
forall k (t :: k). Proxy t
Proxy @arg) (Bool -> WithinParens
WithinParens Bool
False)
      , Markdown
"    * Michelson: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy arg -> Markdown
forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep (Proxy arg
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 (Proxy ret
forall k (t :: k). Proxy t
Proxy @ret) (Bool -> WithinParens
WithinParens Bool
False)
      , Markdown
"    * Michelson: " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Proxy ret -> Markdown
forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep (Proxy ret
forall k (t :: k). Proxy t
Proxy @ret)
      , Markdown
""
      ]
    , Proxy vs -> Markdown
forall (vs :: [ViewTyInfo]).
RenderViewsImpl vs =>
Proxy vs -> Markdown
renderViewsDocImpl (Proxy vs
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 (GTypeName (Rep vd)) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (GTypeName (Rep vd))
forall k (t :: k). Proxy t
Proxy @(GenericTypeName vd))
    where _reallyNeedGenerics :: Dict (Generic vd)
_reallyNeedGenerics = Generic vd => Dict (Generic vd)
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 (Proxy (RevealViews vd)
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 -> Bool
(==) = (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
Prelude.EQ) (Ordering -> Bool)
-> (DViewDesc -> DViewDesc -> Ordering)
-> DViewDesc
-> DViewDesc
-> Bool
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
    ]