module Test.Cleveland.Doc.Michelson
( testDocBasic
, testContractNameAtTop
, testNoGitInfo
, testDocNotEmpty
, testNoAdjacentDescriptions
, testStorageIsDocumented
, module Test.Cleveland.Doc.Common
) where
import Data.Text qualified as T
import Data.Text.Lazy.Builder (toLazyText)
import Fmt (blockListF, fmt, nameF)
import Test.HUnit (assertBool, assertFailure)
import Morley.Michelson.Doc
import Morley.Michelson.Typed.Haskell.Doc
import Morley.Util.Text (dquotes)
import Test.Cleveland.Doc.Common
testContractNameAtTop :: DocTest
testContractNameAtTop :: DocTest
testContractNameAtTop =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"The whole contract is wrapped into 'DName'" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc -> do
let mSections :: Maybe (NonEmpty DName)
mSections = forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection @DName (ContractDoc -> DocBlock
cdContents ContractDoc
contractDoc)
case Maybe (NonEmpty DName)
mSections of
Maybe (NonEmpty DName)
Nothing -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
"There is no 'DName' at the top"
Just NonEmpty DName
_ -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
testNoGitInfo :: DocTest
testNoGitInfo :: DocTest
testNoGitInfo =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"Git revision is not set in the contract" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc -> do
[()]
found <- [DGitRevision] -> (DGitRevision -> Assertion) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ContractDoc -> [DGitRevision]
forall d. DocItem d => ContractDoc -> [d]
allContractDocItems ContractDoc
contractDoc) ((DGitRevision -> Assertion) -> IO [()])
-> (DGitRevision -> Assertion) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \case
DGitRevision
DGitRevisionUnknown -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DGitRevision
_ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure
String
"Git revision already attached.\n\
\This is considered a bad practice to attach it right in the library\n\
\because updating git info will require more modules to rebuild.\n\n\
\Consider using `DGitRevisionUnknown` in the contract and then\n\
\`attachGitInfo` in executable, or derivative methods."
case [()]
found of
[] -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure
String
"No Git revision placeholder found, Git info won't be included.\n\
\Consider inserting 'contractGeneralDefault' to your contract."
[()] -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
[()]
_ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure
String
"Too many `DGitRevisionUnknown`s in the contract."
testDocNotEmpty :: DocTest
testDocNotEmpty :: DocTest
testDocNotEmpty =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"There is at least one DOC_ITEM" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"No doc items found" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
(Element [(Maybe SomeDocItem, DocBlock)] -> Bool)
-> [(Maybe SomeDocItem, DocBlock)] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any Element [(Maybe SomeDocItem, DocBlock)] -> Bool
forall {t} {a}.
(Container t, Element t ~ DocSection) =>
(a, t) -> Bool
hasDocItem (ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc)
where
hasDocItem :: (a, t) -> Bool
hasDocItem (a
_, t
block) = Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Container t => t -> Bool
null @[()] ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ do
DocSection NonEmpty $ DocElem d
docElems <- t -> [Element t]
forall t. Container t => t -> [Element t]
toList t
block
DocElem d
docElem <- (NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
docElems
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (DocElem d -> Bool
forall d. DocElem d -> Bool
deIsAtomic DocElem d
docElem)
testNoAdjacentDescriptions :: DocTest
testNoAdjacentDescriptions :: DocTest
testNoAdjacentDescriptions =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"No two 'DDescription' appear under the same group" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
[(Maybe SomeDocItem, DocBlock)]
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ (ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc) ((Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion)
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall a b. (a -> b) -> a -> b
$ \(Maybe SomeDocItem
_, DocBlock
block) ->
case forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection @DDescription DocBlock
block of
Just ds :: NonEmpty DDescription
ds@(DDescription
_ :| DDescription
_ : [DDescription]
_) ->
let txts :: NonEmpty Builder
txts = NonEmpty DDescription
ds NonEmpty DDescription
-> (DDescription -> Builder) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DDescription Builder
txt) -> Builder
txt
in String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (Builder -> String) -> Builder -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Assertion) -> Builder -> Assertion
forall a b. (a -> b) -> a -> b
$
Builder -> Builder -> Builder
nameF Builder
"Found multiple adjacent descriptions" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
NonEmpty Builder -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF (NonEmpty Builder -> Builder) -> NonEmpty Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder) -> NonEmpty Builder -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
dquotes NonEmpty Builder
txts
Maybe (NonEmpty DDescription)
_ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
testDescriptionsAreWellFormatted :: DocTest
testDescriptionsAreWellFormatted :: DocTest
testDescriptionsAreWellFormatted =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"Descriptions are well-formatted" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
let res :: [Either String ()]
res =
ContractDoc -> [DDescription]
forall d. DocItem d => ContractDoc -> [d]
allContractDocItems ContractDoc
contractDoc [DDescription]
-> (DDescription -> Either String ()) -> [Either String ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DDescription Builder
desc) ->
Text -> Either String ()
check (Text -> Text
forall a. ToText a => a -> Text
toText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText Builder
desc)
in case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Either String ()] -> [String]
forall a b. [Either a b] -> [a]
lefts [Either String ()]
res) of
Maybe (NonEmpty String)
Nothing -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
Just NonEmpty String
errs -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (Builder -> String) -> Builder -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Assertion) -> Builder -> Assertion
forall a b. (a -> b) -> a -> b
$
Builder
"Some descripions are not well formatted:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty String -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF NonEmpty String
errs
where
check :: Text -> Either String ()
check Text
desc
| Text -> Bool
T.null Text
desc =
String -> Either String ()
forall a b. a -> Either a b
Left String
"Empty description."
| Text -> Char
T.last (Text -> Text
T.stripEnd Text
desc) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.' =
String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Description does not end with a dot:\n\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
Text -> String
forall a. ToString a => a -> String
toString Text
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""
| Bool
otherwise = Either String ()
forall (f :: * -> *). Applicative f => f ()
pass
testStorageIsDocumented :: DocTest
testStorageIsDocumented :: DocTest
testStorageIsDocumented =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"Storage documentation is included" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"No documentation for storage in the contract.\
\Consider using `dStorage` to attach it." (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not (Bool -> Bool)
-> ([DStorageType] -> Bool) -> [DStorageType] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DStorageType] -> Bool
forall t. Container t => t -> Bool
null ([DStorageType] -> Bool) -> [DStorageType] -> Bool
forall a b. (a -> b) -> a -> b
$ forall d. DocItem d => ContractDoc -> [d]
allContractDocItems @DStorageType ContractDoc
contractDoc
testDocBasic :: [DocTest]
testDocBasic :: [DocTest]
testDocBasic =
[ DocTest
testContractNameAtTop
, DocTest
testNoGitInfo
, DocTest
testDocNotEmpty
, DocTest
testNoAdjacentDescriptions
, DocTest
testDescriptionsAreWellFormatted
, DocTest
testStorageIsDocumented
]