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

-- | Testing predicates for documentation of Michelson contracts
module Test.Cleveland.Doc.Michelson
  ( testDocBasic

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

    -- ** Re-exports
  , 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

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

-- 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 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 ()

-- | 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 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."

-- | 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 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 c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
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
forall a. Boolean a => a -> a
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)

-- | 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 'Lorentz.caseT' instead of 'Lorentz.entryCase').
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

-- | Check that all descriptions are proper.
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

-- | 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 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
forall a. Boolean a => a -> a
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

-- | 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
  ]