1{-# LANGUAGE CPP #-} 2module Test.Hspec.Core.FailureReport ( 3 FailureReport (..) 4, writeFailureReport 5, readFailureReport 6) where 7 8import Prelude () 9import Test.Hspec.Core.Compat 10 11#ifndef __GHCJS__ 12import System.SetEnv 13import Test.Hspec.Core.Util (safeTry) 14#endif 15import System.IO 16import System.Directory 17import Test.Hspec.Core.Util (Path) 18import Test.Hspec.Core.Config.Options (Config(..)) 19 20data FailureReport = FailureReport { 21 failureReportSeed :: Integer 22, failureReportMaxSuccess :: Int 23, failureReportMaxSize :: Int 24, failureReportMaxDiscardRatio :: Int 25, failureReportPaths :: [Path] 26} deriving (Eq, Show, Read) 27 28writeFailureReport :: Config -> FailureReport -> IO () 29writeFailureReport config report = case configFailureReport config of 30 Just file -> writeFile file (show report) 31 Nothing -> do 32#ifdef __GHCJS__ 33 -- ghcjs currently does not support setting environment variables 34 -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report 35 -- into the environment is a non-essential feature we just disable this to be 36 -- able to run hspec test-suites with ghcjs at all. Should be reverted once 37 -- the issue is fixed. 38 return () 39#else 40 -- on Windows this can throw an exception when the input is too large, hence 41 -- we use `safeTry` here 42 safeTry (setEnv "HSPEC_FAILURES" $ show report) >>= either onError return 43 where 44 onError err = do 45 hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")") 46#endif 47 48readFailureReport :: Config -> IO (Maybe FailureReport) 49readFailureReport config = case configFailureReport config of 50 Just file -> do 51 exists <- doesFileExist file 52 if exists 53 then do 54 r <- readFile file 55 let report = readMaybe r 56 when (report == Nothing) $ do 57 hPutStrLn stderr ("WARNING: Could not read failure report from file " ++ show file ++ "!") 58 return report 59 else return Nothing 60 Nothing -> do 61 mx <- lookupEnv "HSPEC_FAILURES" 62 case mx >>= readMaybe of 63 Nothing -> do 64 hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!" 65 return Nothing 66 report -> return report 67