DocTest.hs

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

-- | 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 Morley.Michelson.Doc
import Test.Cleveland.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

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

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

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