cabal-testsuite/src/Test/Cabal/TestCode.hs

   1 {-# LANGUAGE CPP                #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 -- | Exception type like 'ExitCode' but with more information
   4 -- than just integer.
   5 module Test.Cabal.TestCode (
   6     -- * TestCode
   7     TestCode (..),
   8     displayTestCode,
   9     isTestCodeSkip,
  10 ) where
  11
  12 import Control.Exception (Exception (..))
  13 import Data.Typeable     (Typeable)
  14
  15 -------------------------------------------------------------------------------
  16 -- TestCode
  17 -------------------------------------------------------------------------------
  18
  19 data TestCode
  20     = TestCodeOk
  21     | TestCodeSkip String
  22     | TestCodeKnownFail
  23     | TestCodeUnexpectedOk
  24     | TestCodeFail
  25   deriving (Eq, Show, Read, Typeable)
  26
  27 instance Exception TestCode
  28 #if MIN_VERSION_base(4,8,0)
  29   where
  30     displayException = displayTestCode
  31 #endif
  32
  33 displayTestCode :: TestCode -> String
  34 displayTestCode TestCodeOk           = "OK"
  35 displayTestCode (TestCodeSkip msg)   = "SKIP " ++ msg
  36 displayTestCode TestCodeKnownFail    = "OK (known failure)"
  37 displayTestCode TestCodeUnexpectedOk = "FAIL (unexpected success)"
  38 displayTestCode TestCodeFail         = "FAIL"
  39
  40 isTestCodeSkip :: TestCode -> Bool
  41 isTestCodeSkip (TestCodeSkip _) = True
  42 isTestCodeSkip _                = False