Property based testing & multistep test cases.

MultiStepPropTesting.hs

module Main where

import           Test.Tasty             (TestTree, defaultMain, testGroup)
import           Test.Tasty.Hedgehog    (testProperty)
import           Test.Tasty.HUnit       (assertBool, assertFailure,
                                         testCaseSteps)

import           Hedgehog
import qualified Hedgehog.Gen           as Gen
import qualified Hedgehog.Range         as Range

import           Control.Monad.IO.Class (MonadIO)

import System.Exit (ExitCode (ExitSuccess))
import Control.Exception (catch,throwIO)

main :: IO ()
main = defaultMain $ testGroup "I SAY WABBIT SEASON"
  [ testProperty "reverse involutive" prop_reverse_involutive
  , testProperty "Better Multi Step" betterMultiStepWithProperties
  , testProperty "Mediocre Multi Step" mediocreMultiStepWithProperties
  , standardHUnitMultiStep
  ]

genShuffed :: [a] -> Gen [a]
genShuffed = Gen.shuffle

prop_reverse_involutive :: Property
prop_reverse_involutive = property $ do
  xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
  reverse (reverse xs) === xs

runCombinedTestStepsProps t = evalIO $ defaultMain t `catch` (\e -> if e == ExitSuccess then pure () else throwIO e)

betterMultiStepWithProperties :: Property
betterMultiStepWithProperties = property $ do
  xs <- forAll $ Gen.list (Range.linear 0 20) Gen.alpha
  annotate "Running Part 1"
  -- do something
  xs' <- Gen.sample $ genShuffed xs

  annotate "Running Part 2"
  evalIO $ putStrLn "Do something databasey?"
  -- do something
  _ <- reverse (reverse xs') === xs'
  footnote "Reverse isn't involutive for our shuffled sample!"

  annotate "Running Part 3"

  footnote "Ruh roh" >> failure

mediocreMultiStepWithProperties :: Property
mediocreMultiStepWithProperties = property $ do
  xs <- forAll $ Gen.list (Range.linear 0 20) Gen.alpha
  runCombinedTestStepsProps $ testCaseSteps "Props wut WHY!?" $ \step -> do
    step "Running part 1"
    xs' <- Gen.sample $ genShuffed xs

    step "Running part 2"
    -- do something

    step "Running part 3"
    -- do something

    b <- check . property $ reverse (reverse xs') === xs'

    step "Running part 4"
    -- do something

    assertBool "Shuffed Okay" b

standardHUnitMultiStep :: TestTree
standardHUnitMultiStep = testCaseSteps "Multi-step test" $ \step -> do
  step "Preparing..."
  putStrLn "OH ON, IO!"
  -- do something

  step "Running part 1"
  -- do something

  step "Running part 2"
  -- do something
  assertFailure "BAM!"

  step "Running part 3"
  -- do something