Doc.hs

-- | Testing predicates for documentation of Lorentz contracts.
module Lorentz.Test.Doc
  ( -- * Test predicates
    testLorentzDoc

    -- * Individual test predicates
  , testDeclaresParameter
  , testEachEntrypointIsDescribed

  , module Michelson.Doc.Test
  ) where

import Fmt (pretty)
import Test.HUnit (assertBool, assertFailure)

import Lorentz.EntryPoints.Doc
import Michelson.Doc
import Michelson.Doc.Test
import Util.Typeable

-- | Check that contract documents its parameter.
testDeclaresParameter :: DocTest
testDeclaresParameter =
  mkDocTest "Contract parameter is documented" $
  \contractDoc ->
    assertBool "No doc items describing contract parameter found" $
      or $ forEachContractLayer contractDoc check
  where
    check Nothing _ = False
    check (Just sdi) _ =
      -- Currently the only way to document parameter (mentioning type of each arm)
      -- is using 'entryCase'. This may not suit for small contracts, then
      -- someone needs to invent another way to document parameter and also mention
      -- it below.
      case sdi of
        SomeDocItem (castIgnoringPhantom -> Just DEntryPoint{}) -> True
        _ -> False

-- | It's a common issue to forget to describe an entrypoint.
testEachEntrypointIsDescribed :: DocTest
testEachEntrypointIsDescribed =
  mkDocTest "Each entrypoint has 'DDescription'" $
  \contractDoc ->
    sequence_ . forEachContractLayer contractDoc $ \mDocItem block ->
      runMaybeT $ do
        SomeDocItem docItem <- MaybeT . pure $ mDocItem
        dep@DEntryPoint{} <- MaybeT . pure $ castIgnoringPhantom docItem
        Nothing <- pure $ lookupDocBlockSection @DDescription block
        MaybeT . assertFailure $
          "Entrypoint '" <> pretty (depName dep) <> "' does not contain \
          \description.\n\
          \Put `doc $ DDescription \"text\"` in the entrypoint logic to fix this."

-- | Tests all properties.
testLorentzDoc :: [DocTest]
testLorentzDoc = mconcat
  [ testDocBasic
  , [ testDeclaresParameter
    , testEachEntrypointIsDescribed
    ]
  ]