{-# LANGUAGE TypeFamilyDependencies, UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Morley.Michelson.Doc
( DocItem (..)
, docItemPosition
, DocItemId (..)
, DocItemPlacementKind (..)
, DocItemPos (..)
, DocItemRef (..)
, DocItemReferencedKind
, DocSectionNameStyle (..)
, SomeDocItem (..)
, SomeDocDefinitionItem (..)
, DocElem (..)
, DocSection (..)
, DocBlock
, SubDoc (..)
, ContractDoc (..)
, DocGrouping
, cdContentsL
, cdDefinitionsL
, cdDefinitionsSetL
, cdDefinitionIdsL
, deIsAtomic
, subDocToMarkdown
, docItemToBlock
, docItemSectionRef
, lookupDocBlockSection
, contractDocToMarkdown
, contractDocToToc
, docGroupContent
, docDefinitionRef
, mdTocFromRef
, WithFinalizedDoc (..)
, finalizedAsIs
, ContainsDoc (..)
, ContainsUpdateableDoc (..)
, buildDoc
, buildMarkdownDoc
, modifyDoc
, docBlockToMarkdown
, DGeneralInfoSection (..)
, DName (..)
, DDescription (..)
, DGitRevision (..)
, GitRepoSettings (..)
, mkDGitRevision
, morleyRepoSettings
, DComment (..)
, DAnchor (..)
, DToc (..)
, DConversionInfo (..)
, attachGitInfo
, attachToc
, attachDocCommons
) where
import Data.Map qualified as M
import Data.Map.Merge.Strict qualified as M
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.Lazy qualified as LT
import Data.Typeable (cast, typeRep)
import Development.GitRev (gitCommitDate, gitHash)
import Fmt (Buildable, build, fmt, (+|), (|+))
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import System.Environment (lookupEnv)
import Text.Show qualified
import Morley.Util.Instances ()
import Morley.Util.Lens
import Morley.Util.Markdown
import Morley.Util.Type
import Morley.Util.Typeable
class (Typeable d, DOrd d) => DocItem d where
docItemPos :: Natural
docItemSectionName :: Maybe Text
docItemSectionDescription :: Maybe Markdown
docItemSectionDescription = Maybe Markdown
forall a. Maybe a
Nothing
docItemSectionNameStyle :: DocSectionNameStyle
docItemSectionNameStyle = DocSectionNameStyle
DocSectionNameBig
type DocItemPlacement d :: DocItemPlacementKind
type DocItemPlacement _ = 'DocItemInlined
type DocItemReferenced d :: DocItemReferencedKind
type DocItemReferenced _ = 'False
docItemRef :: d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
default docItemRef
:: ( DocItemPlacement d ~ 'DocItemInlined
, DocItemReferenced d ~ 'False
)
=> d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
_ = DocItemRef 'DocItemInlined 'False
DocItemRef (DocItemPlacement d) (DocItemReferenced d)
DocItemNoRef
docItemToMarkdown :: HeaderLevel -> d -> Markdown
docItemToToc :: HeaderLevel -> d -> Markdown
docItemToToc HeaderLevel
_ d
_ = Markdown
""
docItemDependencies :: d -> [SomeDocDefinitionItem]
docItemDependencies d
_ = []
docItemsOrder :: [d] -> [d]
docItemsOrder = \case
[] -> []
docItems :: [d]
docItems@(d
someDocItem : [d]
_) -> case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
someDocItem of
DocItemRef (DocItemPlacement d) (DocItemReferenced d)
DocItemNoRef -> [d]
docItems
DocItemRef DocItemId
_ ->
[d] -> [d]
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
[d] -> [d]
docItemsOrderById [d]
docItems
DocItemRefInlined DocItemId
_ ->
[d]
docItems
mdTocFromRef :: (DocItem d, DocItemReferenced d ~ 'True) => HeaderLevel -> Markdown -> d -> Markdown
mdTocFromRef :: forall d.
(DocItem d, DocItemReferenced d ~ 'True) =>
HeaderLevel -> Markdown -> d -> Markdown
mdTocFromRef HeaderLevel
lvl Markdown
text d
d =
HeaderLevel -> Markdown -> Anchor -> Markdown
forall anchor.
ToAnchor anchor =>
HeaderLevel -> Markdown -> anchor -> Markdown
mdToc HeaderLevel
lvl Markdown
text (DocItemRef (DocItemPlacement d) 'True -> Anchor
forall anchor. ToAnchor anchor => anchor -> Anchor
toAnchor (DocItemRef (DocItemPlacement d) 'True -> Anchor)
-> DocItemRef (DocItemPlacement d) 'True -> Anchor
forall a b. (a -> b) -> a -> b
$ d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
d)
docItemPosition :: forall d. DocItem d => DocItemPos
docItemPosition :: forall d. DocItem d => DocItemPos
docItemPosition = (Natural, Text) -> DocItemPos
DocItemPos (forall d. DocItem d => Natural
docItemPos @d, TypeRep -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Proxy d -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy d -> TypeRep) -> Proxy d -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d))
docItemToMarkdownFull :: DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdownFull :: forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdownFull HeaderLevel
l d
d =
Markdown
manchor Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> HeaderLevel -> d -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdown HeaderLevel
l d
d Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"
where
manchor :: Markdown
manchor = case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
d of
DocItemRef DocItemId
docItemId -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => anchor -> Markdown
mdAnchor DocItemId
docItemId
DocItemRefInlined DocItemId
docItemId -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => anchor -> Markdown
mdAnchor DocItemId
docItemId
DocItemRef (DocItemPlacement d) (DocItemReferenced d)
DocItemNoRef -> Markdown
""
docItemsOrderById
:: forall d. (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions)
=> [d] -> [d]
docItemsOrderById :: forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
[d] -> [d]
docItemsOrderById [d]
docItems =
let getDocItemId :: d -> DocItemId
getDocItemId :: d -> DocItemId
getDocItemId d
d = case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
d of { DocItemRef DocItemId
di -> DocItemId
di }
in (d -> DocItemId) -> [d] -> [d]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn d -> DocItemId
getDocItemId [d]
docItems
docDefinitionRef
:: (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions)
=> Markdown -> d -> Markdown
docDefinitionRef :: forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
Markdown -> d -> Markdown
docDefinitionRef Markdown
refText d
d = case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
d of
DocItemRef DocItemId
docItemId -> Markdown -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef Markdown
refText DocItemId
docItemId
newtype DocItemId = DocItemId Text
deriving stock (DocItemId -> DocItemId -> DocItemReferencedKind
(DocItemId -> DocItemId -> DocItemReferencedKind)
-> (DocItemId -> DocItemId -> DocItemReferencedKind)
-> Eq DocItemId
forall a.
(a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind) -> Eq a
/= :: DocItemId -> DocItemId -> DocItemReferencedKind
$c/= :: DocItemId -> DocItemId -> DocItemReferencedKind
== :: DocItemId -> DocItemId -> DocItemReferencedKind
$c== :: DocItemId -> DocItemId -> DocItemReferencedKind
Eq, Eq DocItemId
Eq DocItemId
-> (DocItemId -> DocItemId -> Ordering)
-> (DocItemId -> DocItemId -> DocItemReferencedKind)
-> (DocItemId -> DocItemId -> DocItemReferencedKind)
-> (DocItemId -> DocItemId -> DocItemReferencedKind)
-> (DocItemId -> DocItemId -> DocItemReferencedKind)
-> (DocItemId -> DocItemId -> DocItemId)
-> (DocItemId -> DocItemId -> DocItemId)
-> Ord DocItemId
DocItemId -> DocItemId -> DocItemReferencedKind
DocItemId -> DocItemId -> Ordering
DocItemId -> DocItemId -> DocItemId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DocItemId -> DocItemId -> DocItemId
$cmin :: DocItemId -> DocItemId -> DocItemId
max :: DocItemId -> DocItemId -> DocItemId
$cmax :: DocItemId -> DocItemId -> DocItemId
>= :: DocItemId -> DocItemId -> DocItemReferencedKind
$c>= :: DocItemId -> DocItemId -> DocItemReferencedKind
> :: DocItemId -> DocItemId -> DocItemReferencedKind
$c> :: DocItemId -> DocItemId -> DocItemReferencedKind
<= :: DocItemId -> DocItemId -> DocItemReferencedKind
$c<= :: DocItemId -> DocItemId -> DocItemReferencedKind
< :: DocItemId -> DocItemId -> DocItemReferencedKind
$c< :: DocItemId -> DocItemId -> DocItemReferencedKind
compare :: DocItemId -> DocItemId -> Ordering
$ccompare :: DocItemId -> DocItemId -> Ordering
Ord, Int -> DocItemId -> ShowS
[DocItemId] -> ShowS
DocItemId -> String
(Int -> DocItemId -> ShowS)
-> (DocItemId -> String)
-> ([DocItemId] -> ShowS)
-> Show DocItemId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocItemId] -> ShowS
$cshowList :: [DocItemId] -> ShowS
show :: DocItemId -> String
$cshow :: DocItemId -> String
showsPrec :: Int -> DocItemId -> ShowS
$cshowsPrec :: Int -> DocItemId -> ShowS
Show)
deriving newtype (DocItemId -> Anchor
(DocItemId -> Anchor) -> ToAnchor DocItemId
forall anchor. (anchor -> Anchor) -> ToAnchor anchor
toAnchor :: DocItemId -> Anchor
$ctoAnchor :: DocItemId -> Anchor
ToAnchor)
newtype DocItemPos = DocItemPos (Natural, Text)
deriving stock (DocItemPos -> DocItemPos -> DocItemReferencedKind
(DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> (DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> Eq DocItemPos
forall a.
(a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind) -> Eq a
/= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c/= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
== :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c== :: DocItemPos -> DocItemPos -> DocItemReferencedKind
Eq, Eq DocItemPos
Eq DocItemPos
-> (DocItemPos -> DocItemPos -> Ordering)
-> (DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> (DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> (DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> (DocItemPos -> DocItemPos -> DocItemReferencedKind)
-> (DocItemPos -> DocItemPos -> DocItemPos)
-> (DocItemPos -> DocItemPos -> DocItemPos)
-> Ord DocItemPos
DocItemPos -> DocItemPos -> DocItemReferencedKind
DocItemPos -> DocItemPos -> Ordering
DocItemPos -> DocItemPos -> DocItemPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> DocItemReferencedKind)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DocItemPos -> DocItemPos -> DocItemPos
$cmin :: DocItemPos -> DocItemPos -> DocItemPos
max :: DocItemPos -> DocItemPos -> DocItemPos
$cmax :: DocItemPos -> DocItemPos -> DocItemPos
>= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c>= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
> :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c> :: DocItemPos -> DocItemPos -> DocItemReferencedKind
<= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c<= :: DocItemPos -> DocItemPos -> DocItemReferencedKind
< :: DocItemPos -> DocItemPos -> DocItemReferencedKind
$c< :: DocItemPos -> DocItemPos -> DocItemReferencedKind
compare :: DocItemPos -> DocItemPos -> Ordering
$ccompare :: DocItemPos -> DocItemPos -> Ordering
Ord, Int -> DocItemPos -> ShowS
[DocItemPos] -> ShowS
DocItemPos -> String
(Int -> DocItemPos -> ShowS)
-> (DocItemPos -> String)
-> ([DocItemPos] -> ShowS)
-> Show DocItemPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocItemPos] -> ShowS
$cshowList :: [DocItemPos] -> ShowS
show :: DocItemPos -> String
$cshow :: DocItemPos -> String
showsPrec :: Int -> DocItemPos -> ShowS
$cshowsPrec :: Int -> DocItemPos -> ShowS
Show)
instance Buildable DocItemPos where
build :: DocItemPos -> Markdown
build (DocItemPos (Natural
a, Text
_)) = Natural -> Markdown
forall p. Buildable p => p -> Markdown
build Natural
a
data DocItemPlacementKind
= DocItemInlined
| DocItemInDefinitions
type DocItemReferencedKind = Bool
data DocItemRef (p :: DocItemPlacementKind) (r :: DocItemReferencedKind) where
DocItemRef :: DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRefInlined :: DocItemId -> DocItemRef 'DocItemInlined 'True
DocItemNoRef :: DocItemRef 'DocItemInlined 'False
instance ToAnchor (DocItemRef d 'True) where
toAnchor :: DocItemRef d 'True -> Anchor
toAnchor (DocItemRef DocItemId
ref) = DocItemId -> Anchor
forall anchor. ToAnchor anchor => anchor -> Anchor
toAnchor DocItemId
ref
toAnchor (DocItemRefInlined DocItemId
ref) = DocItemId -> Anchor
forall anchor. ToAnchor anchor => anchor -> Anchor
toAnchor DocItemId
ref
data DocSectionNameStyle
= DocSectionNameBig
| DocSectionNameSmall
data SomeDocItem where
SomeDocItem :: DocItem d => d -> SomeDocItem
instance NFData SomeDocItem where
rnf :: SomeDocItem -> ()
rnf (SomeDocItem d
_) = ()
data SomeDocDefinitionItem where
SomeDocDefinitionItem
:: (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions)
=> d -> SomeDocDefinitionItem
instance Eq SomeDocDefinitionItem where
SomeDocDefinitionItem d
d1 == :: SomeDocDefinitionItem
-> SomeDocDefinitionItem -> DocItemReferencedKind
== SomeDocDefinitionItem d
d2 =
d
d1 d -> d -> DocItemReferencedKind
forall a1 a2.
(Typeable a1, Typeable a2, Eq a1) =>
a1 -> a2 -> DocItemReferencedKind
`eqExt` d
d2
instance Ord SomeDocDefinitionItem where
SomeDocDefinitionItem d
d1 compare :: SomeDocDefinitionItem -> SomeDocDefinitionItem -> Ordering
`compare` SomeDocDefinitionItem d
d2 =
d
d1 d -> d -> Ordering
forall a1 a2.
(Typeable a1, Typeable a2, Ord a1) =>
a1 -> a2 -> Ordering
`compareExt` d
d2
instance Show SomeDocItem where
show :: SomeDocItem -> String
show SomeDocItem
_ = String
"<doc item>"
type family DOrd d :: Constraint where
DOrd d = If (DocItemPlacement d == 'DocItemInDefinitions)
(Ord d) (() :: Constraint)
data DocElem d = DocElem
{ forall d. DocElem d -> d
deItem :: d
, forall d. DocElem d -> Maybe SubDoc
deSub :: Maybe SubDoc
}
deIsAtomic :: DocElem d -> Bool
deIsAtomic :: forall d. DocElem d -> DocItemReferencedKind
deIsAtomic = Maybe SubDoc -> DocItemReferencedKind
forall a. Maybe a -> DocItemReferencedKind
isNothing (Maybe SubDoc -> DocItemReferencedKind)
-> (DocElem d -> Maybe SubDoc)
-> DocElem d
-> DocItemReferencedKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocElem d -> Maybe SubDoc
forall d. DocElem d -> Maybe SubDoc
deSub
data DocSection = forall d. DocItem d => DocSection (NonEmpty $ DocElem d)
unsafeAppendDocSection
:: HasCallStack
=> DocSection -> DocSection -> DocSection
unsafeAppendDocSection :: HasCallStack => DocSection -> DocSection -> DocSection
unsafeAppendDocSection (DocSection NonEmpty $ DocElem d
ls) (DocSection NonEmpty $ DocElem d
rs) =
(NonEmpty $ DocElem d) -> DocSection
forall d. DocItem d => (NonEmpty $ DocElem d) -> DocSection
DocSection ((NonEmpty $ DocElem d) -> DocSection)
-> (NonEmpty $ DocElem d) -> DocSection
forall a b. (a -> b) -> a -> b
$ (NonEmpty $ DocElem d) -> [DocElem d] -> NonEmpty $ DocElem d
forall d1 d2.
(Typeable d1, Typeable d2, HasCallStack) =>
NonEmpty d1 -> [d2] -> NonEmpty d1
unsafeAppendDocSectionImpl NonEmpty $ DocElem d
ls ((NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
rs)
unsafeAppendDocSectionImpl
:: forall d1 d2.
(Typeable d1, Typeable d2, HasCallStack)
=> NonEmpty d1 -> [d2] -> NonEmpty d1
unsafeAppendDocSectionImpl :: forall d1 d2.
(Typeable d1, Typeable d2, HasCallStack) =>
NonEmpty d1 -> [d2] -> NonEmpty d1
unsafeAppendDocSectionImpl (d1
l :| [d1]
ls) [d2]
rs =
let rs' :: [d1]
rs' = [d2]
rs [d2] -> (d2 -> d1) -> [d1]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \d2
r -> d2 -> Maybe d1
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast d2
r Maybe d1 -> d1 -> d1
forall a. Maybe a -> a -> a
?: d1
onTypeMismatch
in d1
l d1 -> [d1] -> NonEmpty d1
forall a. a -> [a] -> NonEmpty a
:| [d1]
ls [d1] -> [d1] -> [d1]
forall a. Semigroup a => a -> a -> a
<> [d1]
rs'
where
onTypeMismatch :: d1
onTypeMismatch =
Text -> d1
forall a. HasCallStack => Text -> a
error (Text -> d1) -> Text -> d1
forall a b. (a -> b) -> a -> b
$ Markdown
"appending doc sections for doc items of different types:"
Markdown -> Markdown -> Text
forall b. FromBuilder b => Markdown -> Markdown -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy d1 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d1)) Text -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
" and "
Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy d2 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d2)) Text -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
""
type DocBlock = Map DocItemPos DocSection
docBlockToMarkdown :: HeaderLevel -> DocBlock -> Markdown
docBlockToMarkdown :: HeaderLevel -> DocBlock -> Markdown
docBlockToMarkdown HeaderLevel
hl DocBlock
block =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ DocBlock -> [DocSection]
forall k a. Map k a -> [a]
M.elems DocBlock
block [DocSection] -> (DocSection -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DocSection items :: NonEmpty $ DocElem d
items@((DocElem d
_ :: DocElem di) :| [DocElem d]
_)) ->
let sectionName :: Maybe Text
sectionName = forall d. DocItem d => Maybe Text
docItemSectionName @di
sectionNameStyle :: DocSectionNameStyle
sectionNameStyle = forall d. DocItem d => DocSectionNameStyle
docItemSectionNameStyle @di
(Markdown
sectionNameFull, HeaderLevel -> HeaderLevel
headerLevelDelta) =
case Maybe Text
sectionName of
Maybe Text
Nothing -> (Markdown
"", HeaderLevel -> HeaderLevel
forall a. a -> a
id)
Just Text
sn ->
let sn' :: Markdown
sn' = Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
sn
in case DocSectionNameStyle
sectionNameStyle of
DocSectionNameStyle
DocSectionNameBig ->
(HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
hl Markdown
sn', HeaderLevel -> HeaderLevel
nextHeaderLevel)
DocSectionNameStyle
DocSectionNameSmall ->
( Markdown -> Markdown
mdSubsectionTitle Markdown
sn' Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n"
, Text -> HeaderLevel -> HeaderLevel
forall a. HasCallStack => Text -> a
error (Text -> HeaderLevel -> HeaderLevel)
-> Text -> HeaderLevel -> HeaderLevel
forall a b. (a -> b) -> a -> b
$ Text
"Using headers is not allowed when section name is set small\n\
\Make sure docItemToMarkdown @" 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 d -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy d -> TypeRep) -> Proxy d -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @di) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"does not use its 'header level' argument"
)
sectionDesc :: Maybe Markdown
sectionDesc = forall d. DocItem d => Maybe Markdown
docItemSectionDescription @di
sectionDescFull :: Markdown
sectionDescFull =
case Maybe Markdown
sectionDesc of
Maybe Markdown
Nothing -> Markdown
""
Just Markdown
sd -> Markdown
sd Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"
resItems :: [d]
resItems = [d] -> [d]
forall d. DocItem d => [d] -> [d]
docItemsOrder ([d] -> [d]) -> [d] -> [d]
forall a b. (a -> b) -> a -> b
$ (DocElem d -> d) -> [DocElem d] -> [d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DocElem d -> d
forall d. DocElem d -> d
deItem ((NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
items)
content :: Markdown
content =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ [d]
resItems [d] -> (d -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \d
di ->
HeaderLevel -> d -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdownFull (HeaderLevel -> HeaderLevel
headerLevelDelta HeaderLevel
hl) d
di
anchor :: Markdown
anchor = Markdown
-> (SectionAnchor -> Markdown) -> Maybe SectionAnchor -> Markdown
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markdown
"" SectionAnchor -> Markdown
forall anchor. ToAnchor anchor => anchor -> Markdown
mdAnchor (forall di. DocItem di => Maybe SectionAnchor
docItemSectionAnchor @di)
in if [d] -> DocItemReferencedKind
forall t. Container t => t -> DocItemReferencedKind
null [d]
resItems
then Markdown
""
else Markdown
anchor Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
sectionNameFull Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
sectionDescFull Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
content
newtype SectionAnchor = SectionAnchor
{ SectionAnchor -> Text
_unSectionAnchor :: Text
}
instance ToAnchor SectionAnchor where
toAnchor :: SectionAnchor -> Anchor
toAnchor (SectionAnchor Text
t) = Text -> Anchor
Anchor (Text
"section-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
docItemSectionAnchor :: forall di. DocItem di => Maybe SectionAnchor
docItemSectionAnchor :: forall di. DocItem di => Maybe SectionAnchor
docItemSectionAnchor = do
case forall d. DocItem d => DocSectionNameStyle
docItemSectionNameStyle @di of
DocSectionNameStyle
DocSectionNameBig -> Maybe ()
forall (f :: * -> *). Applicative f => f ()
pass
DocSectionNameStyle
DocSectionNameSmall -> Maybe ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Text -> SectionAnchor
SectionAnchor (Text -> SectionAnchor) -> Maybe Text -> Maybe SectionAnchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d. DocItem d => Maybe Text
docItemSectionName @di
docItemSectionRef :: forall di. DocItem di => Maybe Markdown
docItemSectionRef :: forall d. DocItem d => Maybe Markdown
docItemSectionRef = do
Text
name <- forall d. DocItem d => Maybe Text
docItemSectionName @di
SectionAnchor
anchor <- forall di. DocItem di => Maybe SectionAnchor
docItemSectionAnchor @di
return $ Markdown -> SectionAnchor -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
name) SectionAnchor
anchor
docBlockToToc :: HeaderLevel -> DocBlock -> Markdown
docBlockToToc :: HeaderLevel -> DocBlock -> Markdown
docBlockToToc HeaderLevel
hl DocBlock
block =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ DocBlock -> [DocSection]
forall k a. Map k a -> [a]
M.elems DocBlock
block [DocSection] -> (DocSection -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DocSection items :: NonEmpty $ DocElem d
items@((DocElem d
_ :: DocElem di) :| [DocElem d]
_)) ->
let sectionName :: Maybe Text
sectionName = forall d. DocItem d => Maybe Text
docItemSectionName @di
(Markdown
sectionNameFull, HeaderLevel -> HeaderLevel
headerLevelDelta) =
case (Maybe Text
sectionName, forall di. DocItem di => Maybe SectionAnchor
docItemSectionAnchor @di) of
(Maybe Text
_, Maybe SectionAnchor
Nothing) -> (Markdown
"", HeaderLevel -> HeaderLevel
forall a. a -> a
id)
(Maybe Text
Nothing, Maybe SectionAnchor
_) -> (Markdown
"", HeaderLevel -> HeaderLevel
forall a. a -> a
id)
(Just Text
"Table of contents", Maybe SectionAnchor
_) -> (Markdown
"", HeaderLevel -> HeaderLevel
forall a. a -> a
id)
(Just Text
sn, Just SectionAnchor
anchor) ->
(HeaderLevel -> Markdown -> SectionAnchor -> Markdown
forall anchor.
ToAnchor anchor =>
HeaderLevel -> Markdown -> anchor -> Markdown
mdToc HeaderLevel
hl (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
sn) SectionAnchor
anchor, HeaderLevel -> HeaderLevel
nextHeaderLevel)
resItems :: [d]
resItems = [d] -> [d]
forall d. DocItem d => [d] -> [d]
docItemsOrder ([d] -> [d]) -> [d] -> [d]
forall a b. (a -> b) -> a -> b
$ (DocElem d -> d) -> [DocElem d] -> [d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DocElem d -> d
forall d. DocElem d -> d
deItem ((NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
items)
content :: Markdown
content =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ [d]
resItems [d] -> (d -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HeaderLevel -> d -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToToc (HeaderLevel -> HeaderLevel
headerLevelDelta HeaderLevel
hl)
in if [d] -> DocItemReferencedKind
forall t. Container t => t -> DocItemReferencedKind
null [d]
resItems
then Markdown
""
else Markdown
sectionNameFull Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
content
docItemToBlockGeneral :: forall di. DocItem di => di -> Maybe SubDoc -> DocBlock
docItemToBlockGeneral :: forall di. DocItem di => di -> Maybe SubDoc -> DocBlock
docItemToBlockGeneral di
di Maybe SubDoc
msub =
OneItem DocBlock -> DocBlock
forall x. One x => OneItem x -> x
one ( forall d. DocItem d => DocItemPos
docItemPosition @di
, (NonEmpty $ DocElem di) -> DocSection
forall d. DocItem d => (NonEmpty $ DocElem d) -> DocSection
DocSection ((NonEmpty $ DocElem di) -> DocSection)
-> (NonEmpty $ DocElem di) -> DocSection
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty $ DocElem di) -> NonEmpty $ DocElem di
forall x. One x => OneItem x -> x
one (di -> Maybe SubDoc -> DocElem di
forall d. d -> Maybe SubDoc -> DocElem d
DocElem di
di Maybe SubDoc
msub)
)
docItemToBlock :: forall di. DocItem di => di -> DocBlock
docItemToBlock :: forall di. DocItem di => di -> DocBlock
docItemToBlock di
di = di -> Maybe SubDoc -> DocBlock
forall di. DocItem di => di -> Maybe SubDoc -> DocBlock
docItemToBlockGeneral di
di Maybe SubDoc
forall a. Maybe a
Nothing
lookupDocBlockSection :: forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection :: forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection DocBlock
block = do
DocSection (NonEmpty (DocElem d)
ds :: NonEmpty (DocElem d')) <- DocItemPos -> DocBlock -> Maybe DocSection
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall d. DocItem d => DocItemPos
docItemPosition @d) DocBlock
block
case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @d @d' of
Maybe (d :~: d)
Nothing -> Text -> Maybe (NonEmpty d)
forall a. HasCallStack => Text -> a
error (Text -> Maybe (NonEmpty d)) -> Text -> Maybe (NonEmpty d)
forall a b. (a -> b) -> a -> b
$ Markdown
"Invalid DocBlock: item of type " Markdown -> Markdown -> Text
forall b. FromBuilder b => Markdown -> Markdown -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy d -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)) Text -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
" \
\under position " Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| forall d. DocItem d => DocItemPos
docItemPosition @d DocItemPos -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
""
Just d :~: d
Refl -> NonEmpty d -> Maybe (NonEmpty d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty d -> Maybe (NonEmpty d))
-> NonEmpty d -> Maybe (NonEmpty d)
forall a b. (a -> b) -> a -> b
$ (DocElem d -> d) -> NonEmpty (DocElem d) -> NonEmpty d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DocElem d -> d
forall d. DocElem d -> d
deItem NonEmpty (DocElem d)
ds
newtype SubDoc = SubDoc DocBlock
subDocToMarkdown :: HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown :: HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown HeaderLevel
hl (SubDoc DocBlock
d) = HeaderLevel -> DocBlock -> Markdown
docBlockToMarkdown HeaderLevel
hl DocBlock
d
subDocToToc :: HeaderLevel -> SubDoc -> Markdown
subDocToToc :: HeaderLevel -> SubDoc -> Markdown
subDocToToc HeaderLevel
hl (SubDoc DocBlock
d) = HeaderLevel -> DocBlock -> Markdown
docBlockToToc HeaderLevel
hl DocBlock
d
data ContractDoc = ContractDoc
{ ContractDoc -> DocBlock
cdContents :: DocBlock
, ContractDoc -> DocBlock
cdDefinitions :: DocBlock
, ContractDoc -> Set SomeDocDefinitionItem
cdDefinitionsSet :: Set SomeDocDefinitionItem
, ContractDoc -> Set DocItemId
cdDefinitionIds :: Set DocItemId
}
makeLensesWith postfixLFields ''ContractDoc
instance Semigroup ContractDoc where
ContractDoc
cd1 <> :: ContractDoc -> ContractDoc -> ContractDoc
<> ContractDoc
cd2 = ContractDoc :: DocBlock
-> DocBlock
-> Set SomeDocDefinitionItem
-> Set DocItemId
-> ContractDoc
ContractDoc
{ cdContents :: DocBlock
cdContents =
SimpleWhenMissing DocItemPos DocSection DocSection
-> SimpleWhenMissing DocItemPos DocSection DocSection
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
-> DocBlock
-> DocBlock
-> DocBlock
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
M.merge
SimpleWhenMissing DocItemPos DocSection DocSection
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing SimpleWhenMissing DocItemPos DocSection DocSection
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
((DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
M.zipWithMatched ((DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection)
-> (DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
forall a b. (a -> b) -> a -> b
$ \DocItemPos
_k DocSection
l DocSection
r -> HasCallStack => DocSection -> DocSection -> DocSection
DocSection -> DocSection -> DocSection
unsafeAppendDocSection DocSection
l DocSection
r)
(ContractDoc -> DocBlock
cdContents ContractDoc
cd1) (ContractDoc -> DocBlock
cdContents ContractDoc
cd2)
, cdDefinitions :: DocBlock
cdDefinitions =
SimpleWhenMissing DocItemPos DocSection DocSection
-> SimpleWhenMissing DocItemPos DocSection DocSection
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
-> DocBlock
-> DocBlock
-> DocBlock
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
M.merge
SimpleWhenMissing DocItemPos DocSection DocSection
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing SimpleWhenMissing DocItemPos DocSection DocSection
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
((DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
M.zipWithMatched ((DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection)
-> (DocItemPos -> DocSection -> DocSection -> DocSection)
-> SimpleWhenMatched DocItemPos DocSection DocSection DocSection
forall a b. (a -> b) -> a -> b
$ \DocItemPos
_k (DocSection NonEmpty $ DocElem d
ls) (DocSection NonEmpty $ DocElem d
rs) ->
let removeDups :: [DocElem d] -> [DocElem d]
removeDups = (DocElem d -> DocItemReferencedKind) -> [DocElem d] -> [DocElem d]
forall a. (a -> DocItemReferencedKind) -> [a] -> [a]
filter ((DocElem d -> DocItemReferencedKind)
-> [DocElem d] -> [DocElem d])
-> (DocElem d -> DocItemReferencedKind)
-> [DocElem d]
-> [DocElem d]
forall a b. (a -> b) -> a -> b
$ DocItemReferencedKind -> DocItemReferencedKind
not (DocItemReferencedKind -> DocItemReferencedKind)
-> (DocElem d -> DocItemReferencedKind)
-> DocElem d
-> DocItemReferencedKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> Set DocItemId -> DocItemReferencedKind
forall d. DocItem d => d -> Set DocItemId -> DocItemReferencedKind
`isDefinedIn` ContractDoc -> Set DocItemId
cdDefinitionIds ContractDoc
cd1) (d -> DocItemReferencedKind)
-> (DocElem d -> d) -> DocElem d -> DocItemReferencedKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocElem d -> d
forall d. DocElem d -> d
deItem
in (NonEmpty $ DocElem d) -> DocSection
forall d. DocItem d => (NonEmpty $ DocElem d) -> DocSection
DocSection ((NonEmpty $ DocElem d) -> DocSection)
-> (NonEmpty $ DocElem d) -> DocSection
forall a b. (a -> b) -> a -> b
$ (NonEmpty $ DocElem d) -> [DocElem d] -> NonEmpty $ DocElem d
forall d1 d2.
(Typeable d1, Typeable d2, HasCallStack) =>
NonEmpty d1 -> [d2] -> NonEmpty d1
unsafeAppendDocSectionImpl NonEmpty $ DocElem d
ls ([DocElem d] -> [DocElem d]
removeDups ([DocElem d] -> [DocElem d]) -> [DocElem d] -> [DocElem d]
forall a b. (a -> b) -> a -> b
$ (NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
rs)
)
(ContractDoc -> DocBlock
cdDefinitions ContractDoc
cd1) (ContractDoc -> DocBlock
cdDefinitions ContractDoc
cd2)
, cdDefinitionsSet :: Set SomeDocDefinitionItem
cdDefinitionsSet =
Set SomeDocDefinitionItem
-> Set SomeDocDefinitionItem -> Set SomeDocDefinitionItem
forall a. Ord a => Set a -> Set a -> Set a
S.union (ContractDoc -> Set SomeDocDefinitionItem
cdDefinitionsSet ContractDoc
cd1) (ContractDoc -> Set SomeDocDefinitionItem
cdDefinitionsSet ContractDoc
cd2)
, cdDefinitionIds :: Set DocItemId
cdDefinitionIds =
Set DocItemId -> Set DocItemId -> Set DocItemId
forall a. Ord a => Set a -> Set a -> Set a
S.union (ContractDoc -> Set DocItemId
cdDefinitionIds ContractDoc
cd1) (ContractDoc -> Set DocItemId
cdDefinitionIds ContractDoc
cd2)
}
where
isDefinedIn :: DocItem d => d -> Set DocItemId -> Bool
isDefinedIn :: forall d. DocItem d => d -> Set DocItemId -> DocItemReferencedKind
isDefinedIn d
di Set DocItemId
defs =
case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
di of
DocItemRef (DocItemPlacement d) (DocItemReferenced d)
DocItemNoRef -> DocItemReferencedKind
False
DocItemRef DocItemId
docItemId -> DocItemId
docItemId DocItemId -> Set DocItemId -> DocItemReferencedKind
forall a. Ord a => a -> Set a -> DocItemReferencedKind
`S.member` Set DocItemId
defs
DocItemRefInlined DocItemId
docItemId -> DocItemId
docItemId DocItemId -> Set DocItemId -> DocItemReferencedKind
forall a. Ord a => a -> Set a -> DocItemReferencedKind
`S.member` Set DocItemId
defs
instance Monoid ContractDoc where
mempty :: ContractDoc
mempty = ContractDoc :: DocBlock
-> DocBlock
-> Set SomeDocDefinitionItem
-> Set DocItemId
-> ContractDoc
ContractDoc
{ cdContents :: DocBlock
cdContents = DocBlock
forall k a. Map k a
M.empty
, cdDefinitions :: DocBlock
cdDefinitions = DocBlock
forall k a. Map k a
M.empty
, cdDefinitionsSet :: Set SomeDocDefinitionItem
cdDefinitionsSet = Set SomeDocDefinitionItem
forall a. Set a
S.empty
, cdDefinitionIds :: Set DocItemId
cdDefinitionIds = Set DocItemId
forall a. Set a
S.empty
}
contractDocToMarkdown :: ContractDoc -> LText
contractDocToMarkdown :: ContractDoc -> Text
contractDocToMarkdown ContractDoc{Set SomeDocDefinitionItem
Set DocItemId
DocBlock
cdDefinitionIds :: Set DocItemId
cdDefinitionsSet :: Set SomeDocDefinitionItem
cdDefinitions :: DocBlock
cdContents :: DocBlock
cdDefinitionIds :: ContractDoc -> Set DocItemId
cdDefinitionsSet :: ContractDoc -> Set SomeDocDefinitionItem
cdDefinitions :: ContractDoc -> DocBlock
cdContents :: ContractDoc -> DocBlock
..} =
let
contents :: Markdown
contents =
HeaderLevel -> DocBlock -> Markdown
docBlockToMarkdown (Int -> HeaderLevel
HeaderLevel Int
1) DocBlock
cdContents Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
"\n\n"
definitions :: Markdown
definitions
| DocBlock -> DocItemReferencedKind
forall t. Container t => t -> DocItemReferencedKind
null DocBlock
cdDefinitions = Markdown
""
| DocItemReferencedKind
otherwise =
Markdown
"# Definitions\n\n" Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| HeaderLevel -> DocBlock -> Markdown
docBlockToMarkdown (Int -> HeaderLevel
HeaderLevel Int
2) DocBlock
cdDefinitions
total :: Text
total = Markdown -> Text
forall b. FromBuilder b => Markdown -> b
fmt (Markdown
contents Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
definitions)
in Text -> Text
LT.strip Text
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
contractDocToToc :: ContractDoc -> Markdown
contractDocToToc :: ContractDoc -> Markdown
contractDocToToc ContractDoc{Set SomeDocDefinitionItem
Set DocItemId
DocBlock
cdDefinitionIds :: Set DocItemId
cdDefinitionsSet :: Set SomeDocDefinitionItem
cdDefinitions :: DocBlock
cdContents :: DocBlock
cdDefinitionIds :: ContractDoc -> Set DocItemId
cdDefinitionsSet :: ContractDoc -> Set SomeDocDefinitionItem
cdDefinitions :: ContractDoc -> DocBlock
cdContents :: ContractDoc -> DocBlock
..} =
let
contents :: Markdown
contents =
HeaderLevel -> DocBlock -> Markdown
docBlockToToc (Int -> HeaderLevel
HeaderLevel Int
1) DocBlock
cdContents
definitions :: Markdown
definitions
| DocBlock -> DocItemReferencedKind
forall t. Container t => t -> DocItemReferencedKind
null DocBlock
cdDefinitions = Markdown
""
| DocItemReferencedKind
otherwise = Markdown
"\n**[Definitions](#definitions)**\n\n"
Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| HeaderLevel -> DocBlock -> Markdown
docBlockToToc (Int -> HeaderLevel
HeaderLevel Int
2) DocBlock
cdDefinitions
in Markdown
contents Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
definitions Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n"
type DocGrouping = SubDoc -> SomeDocItem
instance Show DocGrouping where
show :: DocGrouping -> String
show DocGrouping
_ = String
"<doc grouping>"
docGroupContent :: DocGrouping -> ContractDoc -> ContractDoc
docGroupContent :: DocGrouping -> ContractDoc -> ContractDoc
docGroupContent DocGrouping
grouping ContractDoc
doc =
ContractDoc
doc
{ cdContents :: DocBlock
cdContents =
let sub :: SubDoc
sub = DocBlock -> SubDoc
SubDoc (ContractDoc -> DocBlock
cdContents ContractDoc
doc)
in case DocGrouping
grouping SubDoc
sub of
SomeDocItem d
d -> d -> Maybe SubDoc -> DocBlock
forall di. DocItem di => di -> Maybe SubDoc -> DocBlock
docItemToBlockGeneral d
d (SubDoc -> Maybe SubDoc
forall a. a -> Maybe a
Just SubDoc
sub)
}
class ContainsDoc a where
buildDocUnfinalized :: a -> ContractDoc
class ContainsDoc a => ContainsUpdateableDoc a where
modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> a -> a
newtype WithFinalizedDoc a = WithFinalizedDoc (Identity a)
deriving newtype ((forall a b. (a -> b) -> WithFinalizedDoc a -> WithFinalizedDoc b)
-> (forall a b. a -> WithFinalizedDoc b -> WithFinalizedDoc a)
-> Functor WithFinalizedDoc
forall a b. a -> WithFinalizedDoc b -> WithFinalizedDoc a
forall a b. (a -> b) -> WithFinalizedDoc a -> WithFinalizedDoc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WithFinalizedDoc b -> WithFinalizedDoc a
$c<$ :: forall a b. a -> WithFinalizedDoc b -> WithFinalizedDoc a
fmap :: forall a b. (a -> b) -> WithFinalizedDoc a -> WithFinalizedDoc b
$cfmap :: forall a b. (a -> b) -> WithFinalizedDoc a -> WithFinalizedDoc b
Functor, Functor WithFinalizedDoc
Functor WithFinalizedDoc
-> (forall a. a -> WithFinalizedDoc a)
-> (forall a b.
WithFinalizedDoc (a -> b)
-> WithFinalizedDoc a -> WithFinalizedDoc b)
-> (forall a b c.
(a -> b -> c)
-> WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc c)
-> (forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b)
-> (forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc a)
-> Applicative WithFinalizedDoc
forall a. a -> WithFinalizedDoc a
forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc a
forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
forall a b.
WithFinalizedDoc (a -> b)
-> WithFinalizedDoc a -> WithFinalizedDoc b
forall a b c.
(a -> b -> c)
-> WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc a
$c<* :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc a
*> :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
$c*> :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc c
<*> :: forall a b.
WithFinalizedDoc (a -> b)
-> WithFinalizedDoc a -> WithFinalizedDoc b
$c<*> :: forall a b.
WithFinalizedDoc (a -> b)
-> WithFinalizedDoc a -> WithFinalizedDoc b
pure :: forall a. a -> WithFinalizedDoc a
$cpure :: forall a. a -> WithFinalizedDoc a
Applicative, Applicative WithFinalizedDoc
Applicative WithFinalizedDoc
-> (forall a b.
WithFinalizedDoc a
-> (a -> WithFinalizedDoc b) -> WithFinalizedDoc b)
-> (forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b)
-> (forall a. a -> WithFinalizedDoc a)
-> Monad WithFinalizedDoc
forall a. a -> WithFinalizedDoc a
forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
forall a b.
WithFinalizedDoc a
-> (a -> WithFinalizedDoc b) -> WithFinalizedDoc b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WithFinalizedDoc a
$creturn :: forall a. a -> WithFinalizedDoc a
>> :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
$c>> :: forall a b.
WithFinalizedDoc a -> WithFinalizedDoc b -> WithFinalizedDoc b
>>= :: forall a b.
WithFinalizedDoc a
-> (a -> WithFinalizedDoc b) -> WithFinalizedDoc b
$c>>= :: forall a b.
WithFinalizedDoc a
-> (a -> WithFinalizedDoc b) -> WithFinalizedDoc b
Monad)
finalizedAsIs :: a -> WithFinalizedDoc a
finalizedAsIs :: forall a. a -> WithFinalizedDoc a
finalizedAsIs = Identity a -> WithFinalizedDoc a
forall a. Identity a -> WithFinalizedDoc a
WithFinalizedDoc (Identity a -> WithFinalizedDoc a)
-> (a -> Identity a) -> a -> WithFinalizedDoc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
buildDoc :: ContainsDoc a => WithFinalizedDoc a -> ContractDoc
buildDoc :: forall a. ContainsDoc a => WithFinalizedDoc a -> ContractDoc
buildDoc (WithFinalizedDoc (Identity a
a)) = a -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized a
a
buildMarkdownDoc :: ContainsDoc a => WithFinalizedDoc a -> LText
buildMarkdownDoc :: forall a. ContainsDoc a => WithFinalizedDoc a -> Text
buildMarkdownDoc = ContractDoc -> Text
contractDocToMarkdown (ContractDoc -> Text)
-> (WithFinalizedDoc a -> ContractDoc)
-> WithFinalizedDoc a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithFinalizedDoc a -> ContractDoc
forall a. ContainsDoc a => WithFinalizedDoc a -> ContractDoc
buildDoc
modifyDoc
:: (ContainsUpdateableDoc a, DocItem i1, DocItem i2)
=> (i1 -> Maybe i2) -> a -> a
modifyDoc :: forall a i1 i2.
(ContainsUpdateableDoc a, DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> a -> a
modifyDoc i1 -> Maybe i2
mapper = (SomeDocItem -> SomeDocItem) -> a -> a
forall a.
ContainsUpdateableDoc a =>
(SomeDocItem -> SomeDocItem) -> a -> a
modifyDocEntirely SomeDocItem -> SomeDocItem
untypedMapper
where
untypedMapper :: SomeDocItem -> SomeDocItem
untypedMapper sdi :: SomeDocItem
sdi@(SomeDocItem d
di) = SomeDocItem -> Maybe SomeDocItem -> SomeDocItem
forall a. a -> Maybe a -> a
fromMaybe SomeDocItem
sdi (Maybe SomeDocItem -> SomeDocItem)
-> Maybe SomeDocItem -> SomeDocItem
forall a b. (a -> b) -> a -> b
$ do
i1
di' <- d -> Maybe i1
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast d
di
i2
newDi <- i1 -> Maybe i2
mapper i1
di'
return (i2 -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem i2
newDi)
newtype DGeneralInfoSection = DGeneralInfoSection SubDoc
instance DocItem DGeneralInfoSection where
docItemPos :: Natural
docItemPos = Natural
1
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DGeneralInfoSection -> Markdown
docItemToMarkdown HeaderLevel
lvl (DGeneralInfoSection SubDoc
subDoc) =
HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown HeaderLevel
lvl SubDoc
subDoc
docItemToToc :: HeaderLevel -> DGeneralInfoSection -> Markdown
docItemToToc HeaderLevel
lvl (DGeneralInfoSection SubDoc
subDoc) =
HeaderLevel -> SubDoc -> Markdown
subDocToToc HeaderLevel
lvl SubDoc
subDoc
data DName = DName Text SubDoc
instance DocItem DName where
docItemPos :: Natural
docItemPos = Natural
3
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DName -> Markdown
docItemToMarkdown HeaderLevel
lvl (DName Text
name SubDoc
doc) =
HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
lvl (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
name) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
HeaderLevel -> SubDoc -> Markdown
subDocToMarkdown (HeaderLevel -> HeaderLevel
nextHeaderLevel HeaderLevel
lvl) SubDoc
doc
docItemToToc :: HeaderLevel -> DName -> Markdown
docItemToToc HeaderLevel
lvl (DName Text
_ SubDoc
doc) =
HeaderLevel -> SubDoc -> Markdown
subDocToToc (HeaderLevel -> HeaderLevel
nextHeaderLevel HeaderLevel
lvl) SubDoc
doc
instance (di ~ DName) => IsString (SubDoc -> di) where
fromString :: String -> SubDoc -> di
fromString = Text -> SubDoc -> DName
DName (Text -> SubDoc -> DName)
-> (String -> Text) -> String -> SubDoc -> DName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
data DDescription = DDescription Markdown
instance DocItem DDescription where
docItemPos :: Natural
docItemPos = Natural
10
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DDescription -> Markdown
docItemToMarkdown HeaderLevel
_ (DDescription Markdown
txt) = Markdown -> Markdown
forall p. Buildable p => p -> Markdown
build Markdown
txt
data DGitRevisionInfo = DGitRevisionInfo
{ DGitRevisionInfo -> GitRepoSettings
dgrRepoSettings :: GitRepoSettings
, DGitRevisionInfo -> Text
dgrCommitSha :: Text
, DGitRevisionInfo -> Text
dgrCommitDate :: Text
}
data DGitRevision
= DGitRevisionKnown DGitRevisionInfo
| DGitRevisionUnknown
newtype GitRepoSettings = GitRepoSettings
{ GitRepoSettings -> Text -> Text
grsMkGitRevision :: Text -> Text
}
morleyRepoSettings :: GitRepoSettings
morleyRepoSettings :: GitRepoSettings
morleyRepoSettings = (Text -> Text) -> GitRepoSettings
GitRepoSettings ((Text -> Text) -> GitRepoSettings)
-> (Text -> Text) -> GitRepoSettings
forall a b. (a -> b) -> a -> b
$ \Text
commit ->
Text
"https://gitlab.com/morley-framework/morley/-/tree/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commit
mkDGitRevision :: TH.ExpQ
mkDGitRevision :: ExpQ
mkDGitRevision = [e| \dgrRepoSettings ->
maybe DGitRevisionUnknown DGitRevisionKnown $
$(pickInfo gitHash "MORLEY_DOC_GIT_COMMIT_SHA") >>= \dgrCommitSha ->
$(pickInfo gitCommitDate "MORLEY_DOC_GIT_COMMIT_DATE") >>= \dgrCommitDate ->
return DGitRevisionInfo{..}
|]
where
pickInfo :: ExpQ -> String -> ExpQ
pickInfo ExpQ
a String
b = Maybe String -> ExpQ
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (Maybe String -> ExpQ) -> Q (Maybe String) -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExpQ -> String -> Q (Maybe String)
pickInfo' ExpQ
a String
b
pickInfo' :: TH.ExpQ -> String -> TH.Q (Maybe String)
pickInfo' :: ExpQ -> String -> Q (Maybe String)
pickInfo' ExpQ
askGit String
envKey =
IO (Maybe String) -> Q (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
lookupEnv String
envKey) Q (Maybe String)
-> (Maybe String -> Q (Maybe String)) -> Q (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just String
"UNSPECIFIED" -> Maybe String -> Q (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
Just String
envValue -> Maybe String -> Q (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Q (Maybe String))
-> Maybe String -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
envValue
Maybe String
Nothing -> ExpQ
askGit ExpQ -> (Exp -> Q (Maybe String)) -> Q (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TH.LitE (TH.StringL String
"UNKNOWN") -> do
String -> Q ()
TH.reportWarning (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$
String
"Contract autodoc: \
\Not including git repository info because it cannot be deduced. \
\Either provide repository environment, or pass '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
envKey String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' \
\environmental variable."
return Maybe String
forall a. Maybe a
Nothing
TH.LitE (TH.StringL String
str) -> Maybe String -> Q (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
str)
Exp
value -> Text -> Q (Maybe String)
forall a. HasCallStack => Text -> a
error (Text -> Q (Maybe String)) -> Text -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown value returned by git: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Exp -> Doc
forall a. Ppr a => a -> Doc
TH.ppr Exp
value)
instance DocItem DGitRevision where
docItemPos :: Natural
docItemPos = Natural
2
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DGitRevision -> Markdown
docItemToMarkdown HeaderLevel
_ (DGitRevisionKnown DGitRevisionInfo{Text
GitRepoSettings
dgrCommitDate :: Text
dgrCommitSha :: Text
dgrRepoSettings :: GitRepoSettings
dgrCommitDate :: DGitRevisionInfo -> Text
dgrCommitSha :: DGitRevisionInfo -> Text
dgrRepoSettings :: DGitRevisionInfo -> GitRepoSettings
..}) =
[Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
[ Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Code revision" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
let link :: Text
link = GitRepoSettings -> Text -> Text
grsMkGitRevision GitRepoSettings
dgrRepoSettings Text
dgrCommitSha
in [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
[ Markdown -> Markdown -> Markdown
mdRef (Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
7 Text
dgrCommitSha) (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
link)
, Markdown
" "
, Markdown -> Markdown
mdItalic (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown
"(" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
dgrCommitDate Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
]
]
docItemToMarkdown HeaderLevel
_ DGitRevision
DGitRevisionUnknown = Markdown
""
data = Text
instance DocItem DComment where
docItemPos :: Natural
docItemPos = Natural
0
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DComment -> Markdown
docItemToMarkdown HeaderLevel
_ (DComment Text
commentText) =
Markdown
"<!---\n" Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| Text
commentText Text -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
"\n-->"
data DToc = DToc Markdown
instance DocItem DToc where
docItemPos :: Natural
docItemPos = Natural
11
docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Table of contents"
docItemToMarkdown :: HeaderLevel -> DToc -> Markdown
docItemToMarkdown HeaderLevel
_ (DToc Markdown
toc) = Markdown
toc
data DAnchor = DAnchor Anchor
instance DocItem DAnchor where
docItemPos :: Natural
docItemPos = Natural
4
docItemSectionName :: Maybe Text
docItemSectionName = Maybe Text
forall a. Maybe a
Nothing
docItemToMarkdown :: HeaderLevel -> DAnchor -> Markdown
docItemToMarkdown HeaderLevel
_ (DAnchor Anchor
a) = Anchor -> Markdown
forall anchor. ToAnchor anchor => anchor -> Markdown
mdAnchor Anchor
a
data DConversionInfo = DConversionInfo
instance DocItem DConversionInfo where
docItemPos :: Natural
docItemPos = Natural
15
docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Haskell ⇄ Michelson conversion"
docItemToMarkdown :: HeaderLevel -> DConversionInfo -> Markdown
docItemToMarkdown HeaderLevel
_ DConversionInfo
_ =
Markdown
"This smart contract is developed in Haskell using the \
\[Morley framework](https://gitlab.com/morley-framework/morley). \
\Documentation mentions Haskell types that can be used for interaction with \
\this contract from Haskell, but for each Haskell type we also mention its \
\Michelson representation to make interactions outside of Haskell possible.\n\n\
\There are multiple ways to interact with this contract:\n\n\
\* Use this contract in your Haskell application, thus all operation submissions \
\should be handled separately, e.g. via calling `tezos-client`, which will communicate \
\with the `tezos-node`. In order to be able to call `tezos-client` you'll need to be able \
\to construct Michelson values from Haskell.\n\n\
\ The easiest way to do that is to serialize Haskell value using `lPackValue` function \
\from [`Lorentz.Pack`](https://gitlab.com/morley-framework/morley/-/blob/2441e26bebd22ac4b30948e8facbb698d3b25c6d/code/lorentz/src/Lorentz/Pack.hs) \
\module, encode resulting bytestring to hexadecimal representation using `encodeHex` function. \
\Resulting hexadecimal encoded bytes sequence can be decoded back to Michelson value via \
\`tezos-client unpack michelson data`.\n\n\
\ Reverse conversion from Michelson value to the \
\Haskell value can be done by serializing Michelson value using `tezos-client hash data` command, \
\resulting `Raw packed data` should be decoded from the hexadecimal representation using `decodeHex` \
\and deserialized to the Haskell value via `lUnpackValue` function from \
\[`Lorentz.Pack`](https://gitlab.com/morley-framework/morley/-/blob/2441e26bebd22ac4b30948e8facbb698d3b25c6d/code/lorentz/src/Lorentz/Pack.hs).\n\n\
\* Construct values for this contract directly on Michelson level using types provided in the \
\documentation."
attachGitInfo :: ContainsUpdateableDoc a => DGitRevision -> a -> WithFinalizedDoc a
attachGitInfo :: forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachGitInfo DGitRevision
gitRev = a -> WithFinalizedDoc a
forall a. a -> WithFinalizedDoc a
finalizedAsIs (a -> WithFinalizedDoc a)
-> ((DGitRevision -> Maybe DGitRevision) -> a -> a)
-> (DGitRevision -> Maybe DGitRevision)
-> a
-> WithFinalizedDoc a
forall a b c. SuperComposition a b c => a -> b -> c
... (DGitRevision -> Maybe DGitRevision) -> a -> a
forall a i1 i2.
(ContainsUpdateableDoc a, DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> a -> a
modifyDoc ((DGitRevision -> Maybe DGitRevision) -> a -> WithFinalizedDoc a)
-> (DGitRevision -> Maybe DGitRevision) -> a -> WithFinalizedDoc a
forall a b. (a -> b) -> a -> b
$ \case
DGitRevision
DGitRevisionUnknown -> DGitRevision -> Maybe DGitRevision
forall a. a -> Maybe a
Just DGitRevision
gitRev
DGitRevision
_ -> Maybe DGitRevision
forall a. Maybe a
Nothing
attachToc :: ContainsUpdateableDoc a => DToc -> a -> WithFinalizedDoc a
attachToc :: forall a.
ContainsUpdateableDoc a =>
DToc -> a -> WithFinalizedDoc a
attachToc DToc
toc = a -> WithFinalizedDoc a
forall a. a -> WithFinalizedDoc a
finalizedAsIs (a -> WithFinalizedDoc a)
-> ((DToc -> Maybe DToc) -> a -> a)
-> (DToc -> Maybe DToc)
-> a
-> WithFinalizedDoc a
forall a b c. SuperComposition a b c => a -> b -> c
... (DToc -> Maybe DToc) -> a -> a
forall a i1 i2.
(ContainsUpdateableDoc a, DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> a -> a
modifyDoc ((DToc -> Maybe DToc) -> a -> WithFinalizedDoc a)
-> (DToc -> Maybe DToc) -> a -> WithFinalizedDoc a
forall a b. (a -> b) -> a -> b
$ \case
DToc Markdown
"" -> DToc -> Maybe DToc
forall a. a -> Maybe a
Just DToc
toc
DToc
_ -> Maybe DToc
forall a. Maybe a
Nothing
attachDocCommons :: ContainsUpdateableDoc a => DGitRevision -> a -> WithFinalizedDoc a
attachDocCommons :: forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachDocCommons DGitRevision
gitRev a
code = do
let toc :: DToc
toc = Markdown -> DToc
DToc (Markdown -> DToc) -> Markdown -> DToc
forall a b. (a -> b) -> a -> b
$ ContractDoc -> Markdown
contractDocToToc (a -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized a
code)
a -> WithFinalizedDoc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
code
WithFinalizedDoc a
-> (a -> WithFinalizedDoc a) -> WithFinalizedDoc a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DGitRevision -> a -> WithFinalizedDoc a
forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachGitInfo DGitRevision
gitRev
WithFinalizedDoc a
-> (a -> WithFinalizedDoc a) -> WithFinalizedDoc a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DToc -> a -> WithFinalizedDoc a
forall a.
ContainsUpdateableDoc a =>
DToc -> a -> WithFinalizedDoc a
attachToc DToc
toc