Doc.hs

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

    -- * Individual test predicates
  , testDeclaresParameter
  , testEachEntrypointIsDescribed
  , testParamBuildingStepsAreFinalized
  , testAllEntrypointsAreCallable

  , module Michelson.Doc.Test
  ) where

import Fmt (Buildable(..), blockListF, fmt, nameF, pretty)
import Test.HUnit (assertBool, assertFailure)

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

-- | All ways of describing an entrypoint behaviour.
data DocEpDescription
  = DocEpDescription DDescription
  | DocEpReference DEntryPointReference

instance Buildable DocEpDescription where
  build = \case
    DocEpDescription (DDescription txt) ->
      "description: " <> txt
    DocEpReference (DEntryPointReference name (Anchor anchor)) ->
      "reference \"" <> build name <> "\" (" <> build anchor <> ")"

-- | Extract 'DocEpDescription's of a documentation block.
lookupDocEpDescription :: DocBlock -> [DocEpDescription]
lookupDocEpDescription block = mconcat
  [ map DocEpDescription . maybe [] toList $ lookupDocBlockSection block
  , map DocEpReference . maybe [] toList $ lookupDocBlockSection block
  ]

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

-- | Check that no group contains two 'DDescription' or 'DEntryPointReference'
-- items.
--
-- This is a stricter version of 'testNoAdjacentDescriptions' test.
testNoAdjacentEpDescriptions :: DocTest
testNoAdjacentEpDescriptions =
  mkDocTest "No two 'DDescription' appear under the same group" $
  \contractDoc ->
    sequence_ . forEachContractLayer contractDoc $ \_ block ->
      case lookupDocEpDescription block of
        ds@(_ : _ : _) ->
          assertFailure . fmt $
             nameF "Found multiple adjacent entrypoint descriptions" $
             blockListF $ map (quotes . build) (toList ds)
        _ -> pass
    where
      quotes t = "\"" <> t <> "\""

-- | 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
        [] <- pure $ lookupDocEpDescription block
        MaybeT . assertFailure $
          "Entrypoint '" <> pretty (depName dep) <> "' does not contain \
          \any description.\n\
          \Put e.g. `doc $ DDescription \"text\"` in the entrypoint logic to \
          \fix this."

-- | Check that 'finalizeParamCallingDoc' is applied to the contract as it
-- always should.
testParamBuildingStepsAreFinalized :: DocTest
testParamBuildingStepsAreFinalized =
  mkDocTest "'finalizeParamCallingDoc' is applied" $
  \contractDoc ->
    sequence_ . forEachContractDocItem contractDoc $ \DEntryPointArg{..} ->
      unless (areFinalizedParamBuildingSteps epaBuilding) $
        assertFailure
          "Found unfinalized param building steps, \
          \'How to call this entrypoint' section may be incorrect.\n\
          \Have you applied 'finalizeParamCallingDoc' to your contract?"

-- | Check that all documented entrypoints are callable.
--
-- Sometimes having such an entrypoint is fine, e.g. when you have an explicit
-- default entrypoint deep in one arm then other arms (entire arms, not
-- individual entrypoints within them) are uncallable unless also assigned a
-- field annotation; for example see [doc for uncallable entrypoints] note.
-- If this is your case, exclude this test suite with 'excludeDocTest'.
-- But such situations are rare.
--
-- More often, this test failure indicates that entrypoints are documented
-- incorrectly, e.g. `caseT` is used in some place instead of `entryCase`.
-- Check whether printed building steps are correct.
--
-- NB: another, simplified example of case when disabling this test is
-- justified:
--
-- @
-- data SubParam1 = Do1 | Default
-- data SubParam2 = Do2 | Do3
-- data Param = Arm1 SubParam1 | Arm2 SubParam2
--   -- ^ with entrypoints derived via 'EpdRecursive'
-- @
--
-- In this case entire @Arm1@ and @Arm2@ are not true entrypoints, only @Default@
-- and @Do{1,2,3}@ are, but @Arm1@ and @Arm2@ will still appear in documentation
-- as entrypoints.
testAllEntrypointsAreCallable :: DocTest
testAllEntrypointsAreCallable =
  mkDocTest "All entrypoints are callable" $
  \contractDoc ->
    sequence_ . forEachContractDocItem contractDoc $ \DEntryPointArg{..} ->
      forM_ epaBuilding $ \case
        PbsUncallable pbs ->
          assertFailure . fmt $
            "Found an uncallable entrypoint.\n\
            \Dummy parameter building steps for it: " <> blockListF (reverse pbs)
        _ -> pass

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