{-# LANGUAGE CPP #-}
module Test.Hspec.Core.FailureReport (
FailureReport (..)
, writeFailureReport
, readFailureReport
) where
import Prelude ()
import Test.Hspec.Core.Compat
#ifndef __GHCJS__
import System.Environment (setEnv)
import Test.Hspec.Core.Util (safeTry)
#endif
import System.IO
import System.Directory
import Test.Hspec.Core.Util (Path)
import Test.Hspec.Core.Config.Definition (Config(..))
data FailureReport = FailureReport {
FailureReport -> Integer
failureReportSeed :: Integer
, FailureReport -> Int
failureReportMaxSuccess :: Int
, FailureReport -> Int
failureReportMaxSize :: Int
, FailureReport -> Int
failureReportMaxDiscardRatio :: Int
, FailureReport -> [Path]
failureReportPaths :: [Path]
} deriving (FailureReport -> FailureReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureReport -> FailureReport -> Bool
$c/= :: FailureReport -> FailureReport -> Bool
== :: FailureReport -> FailureReport -> Bool
$c== :: FailureReport -> FailureReport -> Bool
Eq, Int -> FailureReport -> ShowS
[FailureReport] -> ShowS
FailureReport -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FailureReport] -> ShowS
$cshowList :: [FailureReport] -> ShowS
show :: FailureReport -> FilePath
$cshow :: FailureReport -> FilePath
showsPrec :: Int -> FailureReport -> ShowS
$cshowsPrec :: Int -> FailureReport -> ShowS
Show, ReadPrec [FailureReport]
ReadPrec FailureReport
Int -> ReadS FailureReport
ReadS [FailureReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailureReport]
$creadListPrec :: ReadPrec [FailureReport]
readPrec :: ReadPrec FailureReport
$creadPrec :: ReadPrec FailureReport
readList :: ReadS [FailureReport]
$creadList :: ReadS [FailureReport]
readsPrec :: Int -> ReadS FailureReport
$creadsPrec :: Int -> ReadS FailureReport
Read)
writeFailureReport :: Config -> FailureReport -> IO ()
writeFailureReport :: Config -> FailureReport -> IO ()
writeFailureReport Config
config FailureReport
report = case Config -> Maybe FilePath
configFailureReport Config
config of
Just FilePath
file -> FilePath -> FilePath -> IO ()
writeFile FilePath
file (forall a. Show a => a -> FilePath
show FailureReport
report)
Maybe FilePath
Nothing -> do
#ifdef __GHCJS__
pass
#else
forall a. IO a -> IO (Either SomeException a)
safeTry (FilePath -> FilePath -> IO ()
setEnv FilePath
"HSPEC_FAILURES" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FailureReport
report) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. Show a => a -> IO ()
onError forall (m :: * -> *) a. Monad m => a -> m a
return
where
onError :: a -> IO ()
onError a
err = do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"WARNING: Could not write environment variable HSPEC_FAILURES (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
err forall a. [a] -> [a] -> [a]
++ FilePath
")")
#endif
readFailureReport :: Config -> IO (Maybe FailureReport)
readFailureReport :: Config -> IO (Maybe FailureReport)
readFailureReport Config
config = case Config -> Maybe FilePath
configFailureReport Config
config of
Just FilePath
file -> do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
file
if Bool
exists
then do
FilePath
r <- FilePath -> IO FilePath
readFile FilePath
file
let report :: Maybe FailureReport
report = forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FailureReport
report forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"WARNING: Could not read failure report from file " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
"!")
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
report
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe FilePath
Nothing -> do
Maybe FilePath
mx <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"HSPEC_FAILURES"
case Maybe FilePath
mx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => FilePath -> Maybe a
readMaybe of
Maybe FailureReport
Nothing -> do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe FailureReport
report -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
report