DocTest.hs

-- | Tests on doc test framework.
module Test.DocTest
  ( test_Predicates_work
  , test_Exclusion_works
  ) where

import Test.HUnit ((@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Lorentz (( # ), (/->))
import qualified Lorentz as L
import Lorentz.EntryPoints.Doc
import Lorentz.Test.Doc
import Michelson.Doc

-- A bad contract because it uses 'caseT' instead of 'entryCase'
contract1 :: L.ContractCode (Either Integer Natural) Integer
contract1 = L.car # L.caseT
  ( #cLeft /->
      L.doc (DDescription "Handles left") #
      L.nop
  , #cRight /->
      L.doc (DDescription "Handles right") #
      L.int
  ) # L.nil # L.pair

contractDoc1 :: ContractDoc
contractDoc1 = L.buildLorentzDoc contract1

contract2 :: L.ContractCode (Either Integer Natural) Integer
contract2 = L.car # L.entryCase (Proxy @PlainEntryPointsKind)
  ( #cLeft /-> L.nop
  , #cRight /-> L.int
  ) # L.nil # L.pair

contractDoc2 :: ContractDoc
contractDoc2 = L.buildLorentzDoc contract2

test_Predicates_work :: [TestTree]
test_Predicates_work =
  [ testCase "Name at top absence is detected" $
      expectDocTestFailure testContractNameAtTop contractDoc1
  , testCase "Multiple adjacent descriptions are detected" $
      expectDocTestFailure testNoAdjacentDescriptions contractDoc1
  , testCase "Absence of parameter description is detected" $
      expectDocTestFailure testDeclaresParameter contractDoc1
  , testCase "Absence of entrypoint description is detected" $
      expectDocTestFailure testEachEntrypointIsDescribed contractDoc2
  ]

-- Normally doc test suites should not be declared with 'HasCallStack', but
-- this may potentially break 'excludeDocTests' so we try this here.
testDummyWithCallStack :: HasCallStack => DocTest
testDummyWithCallStack = mkDocTest "dummy" $ \_ -> pass

test_Exclusion_works :: [TestTree]
test_Exclusion_works =
  [ testCase "Exclusion removes only expected things" $
      [ testContractNameAtTop
      , testDocNotEmpty
      , testNoAdjacentDescriptions
      , testDummyWithCallStack
      ]
      `excludeDocTests`
      [ testDocNotEmpty
      , testDummyWithCallStack
      ]
      @?=
      [ testContractNameAtTop
      , testNoAdjacentDescriptions
      ]
  ]