tasty-tags.md

1-unit-test.hs

testCase "Example test case" $ do
  assertBool "arithmetic is still sane" $ 2 + 2 == 4

10-database-option.hs

-- | Option describing if tests using the database are enabled or not
newtype Database = Database Bool deriving (Eq, Show)

instance IsOption Database where
  defaultValue = Database False
  parseValue = fmap Database . safeReadBool
  optionName = pure "database"
  optionHelp = pure "set the --database option to enable database tests"
  optionCLParser = flagCLParser Nothing (Database True)

11-with-database-1.hs

withDatabase :: TestTree -> TestTree
withDatabase t = askOption $ \Database doIt ->
  if doIt then t else testGroup "empty" []

12-with-database-2.hs

withDatabase $ testCase "connect to the DB" $ do
  connected <- connect "127.0.0.1" 5432
  assertBool True connected

13-test-database.sh

sh> stack test --test-arguments '--database'

14-custom-options.hs

data CustomOptions
  = CustomOptions
      { _database :: Database,
        _tracing :: Tracing,
        _slow :: Slow,
        _combineWith :: CombineWith
      }
  deriving (Eq, Show)

data CombineWith = All | Any deriving (Eq, Show)

15-custom-options-is-option.hs

instance IsOption CustomOptions where

  -- we get the default values for each option
  defaultValue = CustomOptions
    { _database = defaultValue,
      _tracing = defaultValue,
      _slow = defaultValue,
      _combineWith = All
    }

  parseValue =
    fmap (\b -> defaultValue {_combineWith = if b then Any else All}) .
      safeReadBool

  optionName = pure "any"

  optionHelp = pure "set the --any option to run tests having any of the other flags set"

  optionCLParser =
    flag' defaultValue {_combineWith = Any}
      ( long (untag (optionName :: Tagged CustomOptions String))
          <> help (untag (optionHelp :: Tagged CustomOptions String))
          <> (foldMap short Nothing)
      )

16-custom-options-with-database.hs

withDatabase :: TestTree -> TestTree
withDatabase t = askOption $ \custom ->
  localOption (custom {_database = Database True}) t

17-collect-custom-options.hs

withCustomOptions :: TestTree -> TestTree
withCustomOptions t =
  askOption $ \(database :: Database) ->
    askOption $ \(tracing :: Tracing) ->
      askOption $ \(slow :: Slow) ->
        askOption $ \CustomOptions {..} ->

18-select-tests.hs

 -- a list of conditions to be true when --any is not specified
 allMatches =
   [ case (_database, database) of (Database a, Database b) -> a == b,
     case (_tracing, tracing) of (Tracing a, Tracing b) -> a == b,
     case (_slow, slow) of (Slow a, Slow b) -> a == b
   ]

 -- a list of conditions to be true when --any is specified
 anyMatches =
   [ database == Database True && _database == Database True,
     tracing == Tracing True && _tracing == Tracing True,
     slow == Slow True && _slow == Slow True
   ]

 -- for OR any condition in the orMatches list must be true
 -- for AND all the conditions in the andMatches list must be true
 enabled =
   case _combineWith of
     All -> all (== True) allMatches
     Any -> any (== True) anyMatches
 if enabled then t else testGroup "empty" []

19-default-options.hs

let defaultOptions =
      [ database == Database False,
        tracing == Tracing False,
        slow == Slow False
      ]

    defaultMatches =
      [ _database == Database False,
        _tracing == Tracing False,
        _slow == Slow False
      ]

    -- note that we also need a new option, `NoTag` set to True by default on all tests
    -- and set to false as soon as another option is set
    --
    -- then anyMatches becomes
    anyMatches =
      [ database == Database True && _database == Database True,
        sailfish == Sailfish True && _sailfish == Sailfish True,
        slow == Slow True && _slow == Slow True,
        noTag == NoTag True && all (== True) defaultMatches
      ]

-- some code ...

  enabled =
    if all (== True) defaultOptions
    then all (== True) defaultMatches
    else
      case _combineWith of
        All -> all (== True) allMatches
        Any -> any (== True) anyMatches

2-bdd.hs

testSpec "testing lists" $`
  describe "Prelude.head" $ do
    it "returns the first element of a list" $ do
      head [23 ..] `shouldBe` (23 :: Int)

    it "throws an exception if the list is empty" $
      head [] `shouldThrow` anyException

3-property.hs

testProperty "reverse a list" $ do
  xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
  reverse (reverse xs) === xs

4-test-tree.hs

tests :: TestTree
tests = testGroup "simple assertions"
  [ testCase "2+2=4" $
      2+2 @?= 4
  , testCase "7 is even" $
      assertBool "Oops, 7 is odd" (even 7)
  ]

5-select-tests.sh

sh> stack test --test-arguments '--pattern "simple assertions"'

6-test-group.hs

testGroup "One" [ testGroup "Two" [ testCase "Three" _ ] ]

7-pattern-1.sh

sh> stack test --test-arguments '--pattern "$0 ~ /Two/"'

8-pattern-2.sh

sh> stack test --test-arguments '--pattern "$1 !~ /SKIP/"'

9-hedgehog-option.sh

sh> stack test --test-arguments '--hedgehog-tests 10000'