{-# LANGUAGE CPP #-}
module Test.Hspec.Core.FailureReport (
  FailureReport (..)
, writeFailureReport
, readFailureReport
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

#ifndef __GHCJS__
import           System.SetEnv (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__
    -- ghcjs currently does not support setting environment variables
    -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report
    -- into the environment is a non-essential feature we just disable this to be
    -- able to run hspec test-suites with ghcjs at all. Should be reverted once
    -- the issue is fixed.
    pass
#else
    -- on Windows this can throw an exception when the input is too large, hence
    -- we use `safeTry` here
    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