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