tasty-checklist-1.0.2.0: test/TestChecklist.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Main where

import Data.Parameterized.Context ( pattern Empty, pattern (:>) )
import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.HUnit
import Test.Tasty.Checklist


main :: IO ()
main = defaultMain $ testGroup "Checklist testing"
       [
         expectFailBecause "3 failed checks" $
         testCase "simple checklist" $
         withChecklist "simple" $ do
           let tst :: Int -> Bool
               tst = (> 3)
           check "one" tst 1
           check "two" tst 2
           check "five" tst 5
           check "three" tst 3
           check "four" tst 4

       , expectFailBecause "2 failed checks" $
         testCase "simple checklist with retraction" $
         withChecklist "simple retracted" $ do
           let tst :: Int -> Bool
               tst = (> 3)
           check "one" tst 1
           check "two" tst 2
           check "five" tst 5
           check "three" tst 3
           check "four" tst 4
           discardCheck "two"

       , expectFailBecause "3 failed checks and assert" $
         testCase "simple checklist and assert" $
         withChecklist "simple" $ do
           let tst :: Int -> Bool
               tst = (> 3)
           check "one" tst 1
           check "two" tst 2
           check "five" tst 5
           check "three" tst 3
           check "four" tst 4
           3 @=? (4 :: Int)

       , testCase "someFun 7 result is good" $
         -- everything should pass, no check failures
         withChecklist "someFun 7" $
         someFun 7 `checkValues`
         (Empty
          :> Val "foo" foo 42
          :> Val "baz" baz "The answer to the universe"
          :> Val "shown" show "The answer to the universe is 42!"
          :> Val "odd answer" oddAnswer False
         )

       , expectFailBecause "2 values don't match" $
         testCase "someFun 3 result" $
         withChecklist "someFun" $
         someFun 3 `checkValues`
         (Empty
          :> Val "foo" foo 42
          :> Val "baz" baz "The answer to the universe"
          :> Val "shown" show "The answer to the universe is 42!"
          :> Val "odd answer" oddAnswer False
         )

       , expectFailBecause "assertion" $
         testCase "normal assert failure" $
         withChecklist "asserts" $ do
           3 @=? (5 :: Int)

       , expectFailBecause "2 values don't match and assertion" $
         testCase "someFun 3 result and assert" $
         withChecklist "someFun" $ do
           someFun 3 `checkValues`
             (Empty
              :> Val "foo" foo 42
              :> Val "baz" baz "The answer to the universe"
              :> Val "shown" show "The answer to the universe is 42!"
              :> Val "odd answer" oddAnswer False
              :> Got "even answer" (not . oddAnswer)
             )
           3 @=? (5 :: Int)

       , testCase "object w/o Show is OK" $
         -- The test object has a TestShow instance but no Show
         -- instance.  The test should pass, no checks or failures
         withChecklist "opaque object" $
         genOpaque `checkValues`
         (Empty
          :> Val "displayed" display "[[19]]"
          :> Val "answer" answer 19
          :> Val "revealed" reveal 19
          :> Val "the answer" answer 19
         )

       , expectFailBecause "revealed test check fails" $
         -- The test object has a TestShow but no Show
         testCase "object w/o Show bad comparison" $
         withChecklist "opaque object bad expected" $
         genOpaque `checkValues`
         (Empty
          :> Val "displayed" display "[[19]]"
          :> Val "answer" answer 19
          :> Val "revealed" reveal 18
          :> Val "the answer" answer 19
         )

       ]

----------------------------------------------------------------------

data Struct = MyStruct { foo :: Int
                       , bar :: Char
                       , baz :: String }

instance Show Struct where
   show s = baz s <> " is " <> (show $ foo s) <> (bar s : [])

instance TestShow Struct  -- uses the Show instance

someFun :: Int -> Struct
someFun n = MyStruct (n * 6)
              (if n * 6 == 42 then '!' else '?')
              "The answer to the universe"

oddAnswer :: Struct -> Bool
oddAnswer = odd . foo

----------------------------------------------------------------------

data Opaque = Hidden { answer :: Int }

genOpaque :: Opaque
genOpaque = Hidden 19

reveal :: Opaque -> Int
reveal = answer

display :: Opaque -> String
display o = "[[" <> show (answer o) <> "]]"

-- Note that Opaque doesn't have a standard Show instance, but a
-- TestShow can be provided to suffice for testing.

instance TestShow Opaque where
  testShow = display