-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Utilities for testing documentations sanity.
--
-- These tests serve to ensure that documentation generation is not broken and
-- that user follows sane documentation structure (e.g. contract should be
-- named, some entities require description, e.t.c).
module Michelson.Doc.Test
  ( DocTest (..)
  , mkDocTest
  , excludeDocTest
  , excludeDocTests
  , runDocTests
  , expectDocTestFailure

    -- * Test predicates
  , testDocBasic

    -- ** Individual test predicates
  , testContractNameAtTop
  , testNoGitInfo
  , testDocNotEmpty
  , testNoAdjacentDescriptions
  , testStorageIsDocumented

    -- * Utilities
  , forEachContractLayer
  , forEachContractDocItem
  ) where

import qualified Data.List as L
import qualified Data.Text as T
import Data.Text.Lazy.Builder (toLazyText)
import Fmt (Buildable(..), blockListF, fmt, nameF, pretty)
import GHC.Stack (SrcLoc)
import Test.HUnit (Assertion, assertBool, assertFailure)
import Test.HUnit.Lang (HUnitFailure(..))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import qualified Text.Show

import Michelson.Doc
import Michelson.Typed.Haskell.Doc

----------------------------------------------------------------------------
-- Framework
----------------------------------------------------------------------------

-- | Test case for contract documentation.
data DocTest = DocTest
  { DocTest -> SrcLoc
dtDeclLoc :: SrcLoc
    -- ^ Declaration location, used to distinguish different test predicates.
    -- This is primarily used in 'excludeDocTest'.
  , DocTest -> String
dtDesc :: String
    -- ^ Description of predicate, which you put to 'testCase'.
  , DocTest -> HasCallStack => ContractDoc -> Assertion
dtSuite :: HasCallStack => ContractDoc -> Assertion
    -- ^ Test itself.
  }

instance Eq DocTest where
  == :: DocTest -> DocTest -> Bool
(==) = SrcLoc -> SrcLoc -> Bool
forall a. Eq a => a -> a -> Bool
(==) (SrcLoc -> SrcLoc -> Bool)
-> (DocTest -> SrcLoc) -> DocTest -> DocTest -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DocTest -> SrcLoc
dtDeclLoc

instance Show DocTest where
  show :: DocTest -> String
show = DocTest -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

instance Buildable DocTest where
  build :: DocTest -> Builder
build DocTest{..} = "Doc test '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall p. Buildable p => p -> Builder
build String
dtDesc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "'"

-- | Construct 'DocTest'.
--
-- Note: you should not declare helpers with this function rather use it
-- directly in every test suite.
mkDocTest
  :: HasCallStack
  => String
  -> (HasCallStack => ContractDoc -> Assertion)
  -> DocTest
mkDocTest :: String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest dtDesc :: String
dtDesc dtSuite :: HasCallStack => ContractDoc -> Assertion
dtSuite = $WDocTest :: SrcLoc
-> String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
DocTest{..}
  where
  (_, dtDeclLoc :: SrcLoc
dtDeclLoc) = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack of
    [] -> Text -> (String, SrcLoc)
forall a. HasCallStack => Text -> a
error "Callstacks operate in a weird way, excluding doc tests won't work"
    layer :: (String, SrcLoc)
layer : _ -> (String, SrcLoc)
layer

-- | Exclude given test suite.
excludeDocTest :: HasCallStack => DocTest -> [DocTest] -> [DocTest]
excludeDocTest :: DocTest -> [DocTest] -> [DocTest]
excludeDocTest toExclude :: DocTest
toExclude tests :: [DocTest]
tests =
  case (DocTest -> Bool) -> [DocTest] -> ([DocTest], [DocTest])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (DocTest -> DocTest -> Bool
forall a. Eq a => a -> a -> Bool
== DocTest
toExclude) [DocTest]
tests of
    ([], _) ->
      Text -> [DocTest]
forall a. HasCallStack => Text -> a
error (Text -> [DocTest]) -> Text -> [DocTest]
forall a b. (a -> b) -> a -> b
$ "Not in the list of doc items: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DocTest -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty DocTest
toExclude
    (_ : _ : _, _) ->
      -- This is possible if someone abused 'mkDocTest' and created a function
      -- which calls it and this function is used to create multiple predicates
      Text -> [DocTest]
forall a. HasCallStack => Text -> a
error "Running invalid doc predicates: multiple ones were considered equal"
    ([_], notExcluded :: [DocTest]
notExcluded) ->
      [DocTest]
notExcluded

-- | Calling @excludeDocTests tests toExclude@ returns all test suites from
-- @tests@ which are not present in @toExclude@.
excludeDocTests :: [DocTest] -> [DocTest] -> [DocTest]
excludeDocTests :: [DocTest] -> [DocTest] -> [DocTest]
excludeDocTests = (Element [DocTest] -> [DocTest] -> [DocTest])
-> [DocTest] -> [DocTest] -> [DocTest]
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr HasCallStack => DocTest -> [DocTest] -> [DocTest]
Element [DocTest] -> [DocTest] -> [DocTest]
excludeDocTest

-- | Finalize test suites.
runDocTests :: HasCallStack => [DocTest] -> ContractDoc -> [TestTree]
runDocTests :: [DocTest] -> ContractDoc -> [TestTree]
runDocTests tests :: [DocTest]
tests contract :: ContractDoc
contract =
  [DocTest]
tests [DocTest] -> (DocTest -> TestTree) -> [TestTree]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DocTest{..} ->
    String -> Assertion -> TestTree
testCase String
dtDesc (HasCallStack => ContractDoc -> Assertion
ContractDoc -> Assertion
dtSuite ContractDoc
contract)

-- | Ensure that 'DocTest' check fires on given contract.
-- Used in tests on this module.
expectDocTestFailure :: DocTest -> ContractDoc -> Assertion
expectDocTestFailure :: DocTest -> ContractDoc -> Assertion
expectDocTestFailure DocTest{..} contract :: ContractDoc
contract = do
  Bool
passed <- (HasCallStack => ContractDoc -> Assertion
ContractDoc -> Assertion
dtSuite ContractDoc
contract Assertion -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) IO Bool -> (HUnitFailure -> IO Bool) -> IO Bool
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \HUnitFailure{} -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
passed (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure "Test didn't fail unexpectedly"

----------------------------------------------------------------------------
-- Test predicates
----------------------------------------------------------------------------

-- Utilities
----------------------------------------------------------------------------

-- | Apply given function to each group (created with 'DocGroup' instruction)
-- recursively.
-- This function will accept grouping doc item itself and its subcontents.
forEachLayer :: DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forEachLayer :: DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forEachLayer block :: DocBlock
block f :: SomeDocItem -> DocBlock -> r
f = do
  DocSection docElems :: NonEmpty $ DocElem d
docElems <- DocBlock -> [Element DocBlock]
forall t. Container t => t -> [Element t]
toList DocBlock
block
  DocElem{..} <- (NonEmpty $ DocElem d) -> [Element (NonEmpty $ DocElem d)]
forall t. Container t => t -> [Element t]
toList NonEmpty $ DocElem d
docElems
  Just (SubDoc sub :: DocBlock
sub) <- Maybe SubDoc -> [Maybe SubDoc]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SubDoc
deSub
  SomeDocItem -> DocBlock -> r
f (d -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem d
deItem) DocBlock
sub r -> [r] -> [r]
forall a. a -> [a] -> [a]
: DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forall r. DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forEachLayer DocBlock
sub SomeDocItem -> DocBlock -> r
f

-- | Apply given function to each group (created with 'DocGroup' instruction)
-- within a contract recursively.
-- This function will accept grouping doc item itself (unless we are at root)
-- and its subcontents.
forEachContractLayer :: ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer :: ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer contract :: ContractDoc
contract f :: Maybe SomeDocItem -> DocBlock -> r
f =
  let contents :: DocBlock
contents = ContractDoc -> DocBlock
cdContents ContractDoc
contract
  in Maybe SomeDocItem -> DocBlock -> r
f Maybe SomeDocItem
forall a. Maybe a
Nothing DocBlock
contents
   r -> [r] -> [r]
forall a. a -> [a] -> [a]
: DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forall r. DocBlock -> (SomeDocItem -> DocBlock -> r) -> [r]
forEachLayer DocBlock
contents (\sdi :: SomeDocItem
sdi blk :: DocBlock
blk -> Maybe SomeDocItem -> DocBlock -> r
f (SomeDocItem -> Maybe SomeDocItem
forall a. a -> Maybe a
Just SomeDocItem
sdi) DocBlock
blk)

-- | Apply given function to each doc item within a contract.
forEachContractDocItem :: DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem :: ContractDoc -> (d -> r) -> [r]
forEachContractDocItem contract :: ContractDoc
contract f :: d -> r
f =
  [[r]] -> [r]
forall t. (Container t, Monoid (Element t)) => t -> Element t
fold ([[r]] -> [r])
-> ((Maybe SomeDocItem -> DocBlock -> [r]) -> [[r]])
-> (Maybe SomeDocItem -> DocBlock -> [r])
-> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc -> (Maybe SomeDocItem -> DocBlock -> [r]) -> [[r]]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contract ((Maybe SomeDocItem -> DocBlock -> [r]) -> [r])
-> (Maybe SomeDocItem -> DocBlock -> [r]) -> [r]
forall a b. (a -> b) -> a -> b
$ \_ block :: DocBlock
block ->
    (d -> r) -> [d] -> [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap d -> r
f ([d] -> [r])
-> (Maybe (NonEmpty d) -> [d]) -> Maybe (NonEmpty d) -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [d] -> (NonEmpty d -> [d]) -> Maybe (NonEmpty d) -> [d]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty d -> [d]
forall t. Container t => t -> [Element t]
toList (Maybe (NonEmpty d) -> [r]) -> Maybe (NonEmpty d) -> [r]
forall a b. (a -> b) -> a -> b
$ DocBlock -> Maybe (NonEmpty d)
forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection DocBlock
block

-- Basic predicates
----------------------------------------------------------------------------

-- | Check that contract documentation is wrapped with 'contractName'.
testContractNameAtTop :: DocTest
testContractNameAtTop :: DocTest
testContractNameAtTop =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "The whole contract is wrapped into 'DName'" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
  \contractDoc :: ContractDoc
contractDoc -> do
    let mSections :: Maybe (NonEmpty DName)
mSections = DocBlock -> Maybe (NonEmpty DName)
forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection @DName (ContractDoc -> DocBlock
cdContents ContractDoc
contractDoc)
    case Maybe (NonEmpty DName)
mSections of
      Nothing -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure "There is no 'DName' at the top"
      Just _ -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check that contracts themselves do not set the git revision. It is supposed to be filled only
-- in the executable.
testNoGitInfo :: DocTest
testNoGitInfo :: DocTest
testNoGitInfo =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "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
contractDoc -> do
    [()]
assertions <- [Assertion] -> IO [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Assertion] -> IO [()]) -> [Assertion] -> IO [()]
forall a b. (a -> b) -> a -> b
$ ContractDoc -> (DGitRevision -> Assertion) -> [Assertion]
forall d r. DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem ContractDoc
contractDoc ((DGitRevision -> Assertion) -> [Assertion])
-> (DGitRevision -> Assertion) -> [Assertion]
forall a b. (a -> b) -> a -> b
$ \case
      DGitRevisionUnknown -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      _ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure "Unexpected Git revision"
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool "No Git revision placeholder found or more than one" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
      ([()] -> Int
forall t. Container t => t -> Int
length [()]
assertions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1)

-- | Check that there is at least one non-grouping doc item.
--
-- If there is no such, rendered documentation will be empty which signals about
-- most of the documentation pieces being lost.
testDocNotEmpty :: DocTest
testDocNotEmpty :: DocTest
testDocNotEmpty =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "There is at least one DOC_ITEM" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
  \contractDoc :: ContractDoc
contractDoc ->
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool "No doc items found" (Bool -> Assertion) -> ([Bool] -> Bool) -> [Bool] -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or ([Bool] -> Assertion) -> [Bool] -> Assertion
forall a b. (a -> b) -> a -> b
$
      ContractDoc -> (Maybe SomeDocItem -> DocBlock -> Bool) -> [Bool]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contractDoc Maybe SomeDocItem -> DocBlock -> Bool
forall t p. (Container t, Element t ~ DocSection) => p -> t -> Bool
hasDocItem
  where
    hasDocItem :: p -> t -> Bool
hasDocItem _ block :: t
block = Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Container [()] => [()] -> Bool
forall t. Container t => t -> Bool
null @[()] ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ do
      DocSection docElems :: 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)

-- | Check that no group contains two 'DDescription' items.
--
-- Normally such behaviour is allowed and can be exploited, but often it is not
-- and multiple descriptions appearence under the same group signals about
-- missing grouping wrapper (e.g. use of 'caseT' instead of 'entryCase').
testNoAdjacentDescriptions :: DocTest
testNoAdjacentDescriptions :: DocTest
testNoAdjacentDescriptions =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "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
contractDoc ->
    [Assertion] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Assertion] -> Assertion)
-> ((Maybe SomeDocItem -> DocBlock -> Assertion) -> [Assertion])
-> (Maybe SomeDocItem -> DocBlock -> Assertion)
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc
-> (Maybe SomeDocItem -> DocBlock -> Assertion) -> [Assertion]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contractDoc ((Maybe SomeDocItem -> DocBlock -> Assertion) -> Assertion)
-> (Maybe SomeDocItem -> DocBlock -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \_ block :: DocBlock
block ->
      case DocBlock -> Maybe (NonEmpty DDescription)
forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection @DDescription DocBlock
block of
        Just ds :: NonEmpty DDescription
ds@(_ :| _ : _) ->
          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 txt :: 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 "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
quotes NonEmpty Builder
txts
        _ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
    where
      quotes :: a -> a
quotes t :: a
t = "\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "\""

-- | Check that all descriptions are proper.
testDescriptionsAreWellFormatted :: DocTest
testDescriptionsAreWellFormatted :: DocTest
testDescriptionsAreWellFormatted =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "Descriptions are well-formatted" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
  \contractDoc :: ContractDoc
contractDoc ->
    [Assertion] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Assertion] -> Assertion)
-> ((DDescription -> Assertion) -> [Assertion])
-> (DDescription -> Assertion)
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc -> (DDescription -> Assertion) -> [Assertion]
forall d r. DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem ContractDoc
contractDoc ((DDescription -> Assertion) -> Assertion)
-> (DDescription -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \(DDescription desc :: Builder
desc) ->
      Text -> Assertion
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)
  where
    check :: Text -> Assertion
check desc :: Text
desc
      | Text -> Bool
T.null Text
desc =
          String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure "Empty description."
      | Text -> Char
T.last (Text -> Text
T.stripEnd Text
desc) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.' =
          String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ "Description does not end with a dot:\n\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                          Text -> String
forall a. ToString a => a -> String
toString Text
desc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\""
      | Bool
otherwise = Assertion
forall (f :: * -> *). Applicative f => f ()
pass

-- | Test whether storage documentation is included in the contract's documentation.
testStorageIsDocumented :: DocTest
testStorageIsDocumented :: DocTest
testStorageIsDocumented =
  HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "Storage documentation is included" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
  \contractDoc :: ContractDoc
contractDoc -> HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool "No documentation for storage in the contract." (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ContractDoc -> (DStorageType -> Bool) -> [Bool]
forall d r. DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem ContractDoc
contractDoc ((DStorageType -> Bool) -> [Bool])
-> (DStorageType -> Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ \(DStorageType _) -> Bool
True

-- | Base properties which should comply for all documentations.
testDocBasic :: [DocTest]
testDocBasic :: [DocTest]
testDocBasic =
  [ DocTest
testContractNameAtTop
  , DocTest
testNoGitInfo
  , DocTest
testDocNotEmpty
  , DocTest
testNoAdjacentDescriptions
  , DocTest
testDescriptionsAreWellFormatted
  , DocTest
testStorageIsDocumented
  ]