{-# OPTIONS_GHC -Wno-orphans #-}
module Lorentz.Doc
( doc
, docGroup
, buildLorentzDoc
, renderLorentzDoc
, contractName
, cutLorentzNonDoc
, Markdown
, DocItem (..)
, docItemPosition
, DocItemId (..)
, DocItemPlacementKind (..)
, DocItemRef (..)
, DocSectionNameStyle (..)
, SomeDocItem (..)
, SomeDocDefinitionItem (..)
, SubDoc (..)
, DocGrouping
, ContractDoc (..)
, DDescription (..)
, DGitRevision (..)
, GitRepoSettings (..)
, mkDGitRevision
, morleyRepoSettings
, DComment (..)
, DType (..)
, docDefinitionRef
, contractDocToMarkdown
, subDocToMarkdown
, TypeHasDoc (..)
, SomeTypeWithDoc (..)
, HaveCommonTypeCtor
, IsHomomorphic
, genericTypeDocDependencies
, customTypeDocMdReference
, homomorphicTypeDocMdReference
, poly1TypeDocMdReference
, poly2TypeDocMdReference
, homomorphicTypeDocHaskellRep
, concreteTypeDocHaskellRep
, concreteTypeDocHaskellRepUnsafe
, haskellRepNoFields
, haskellRepStripFieldPrefix
, homomorphicTypeDocMichelsonRep
, concreteTypeDocMichelsonRep
, concreteTypeDocMichelsonRepUnsafe
) where
import Data.Singletons (demote)
import Lorentz.Base
import Lorentz.Value
import Lorentz.Zip ()
import Michelson.Doc
import Michelson.Optimizer
import Michelson.Typed
import Util.Markdown
import Util.Type
doc :: DocItem di => di -> s :-> s
doc = I . Ext . DOC_ITEM . SomeDocItem
docGroup :: DocGrouping -> (inp :-> out) -> (inp :-> out)
docGroup gr = iMapAnyCode (DocGroup gr)
contractName :: Text -> (inp :-> out) -> (inp :-> out)
contractName name = docGroup (SomeDocItem . DName name)
buildLorentzDoc :: inp :-> out -> ContractDoc
buildLorentzDoc (iAnyCode -> code) = buildInstrDoc code
renderLorentzDoc :: inp :-> out -> LText
renderLorentzDoc = contractDocToMarkdown . buildLorentzDoc
cutLorentzNonDoc :: (inp :-> out) -> (s :-> s)
cutLorentzNonDoc (iAnyCode -> code) = I $ cutInstrNonDoc optimize code
instance Each [Typeable, ReifyList TypeHasDoc] [i, o] =>
TypeHasDoc (i :-> o) where
typeDocName _ = "Code (extended lambda)"
typeDocMdReference tp wp =
let DocItemRef (DocItemId ctorDocItemId) = docItemRef (DType tp)
refToThis = mdLocalRef (mdTicked "Code") ctorDocItemId
in applyWithinParens wp $
mconcat $ intersperse " " [refToThis, refToStack @i, refToStack @o]
where
refToStack :: forall s. ReifyList TypeHasDoc s => Markdown
refToStack =
let stack = reifyList @_ @TypeHasDoc @s (\p -> typeDocMdReference p (WithinParens False))
in mconcat
[ mdBold "["
, case stack of
[] -> " "
st -> mconcat $ intersperse (mdBold "," <> " ") st
, mdBold "]"
]
typeDocMdDescription =
"`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 _ = mconcat
[ reifyList @_ @TypeHasDoc @i SomeTypeWithDoc
, reifyList @_ @TypeHasDoc @o SomeTypeWithDoc
, [ SomeTypeWithDoc (Proxy @Integer)
, SomeTypeWithDoc (Proxy @Natural)
, SomeTypeWithDoc (Proxy @MText)
]
]
typeDocHaskellRep _ = Nothing
typeDocMichelsonRep _ =
( Just "Code [Integer, Natural, MText, ()] [ByteString]"
, demote @(ToT ([Integer, Natural, MText, ()] :-> '[ByteString]))
)