{-# 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
(FailureReport -> FailureReport -> Bool)
-> (FailureReport -> FailureReport -> Bool) -> Eq FailureReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailureReport -> FailureReport -> Bool
== :: FailureReport -> FailureReport -> Bool
$c/= :: FailureReport -> FailureReport -> Bool
/= :: FailureReport -> FailureReport -> Bool
Eq, Int -> FailureReport -> ShowS
[FailureReport] -> ShowS
FailureReport -> FilePath
(Int -> FailureReport -> ShowS)
-> (FailureReport -> FilePath)
-> ([FailureReport] -> ShowS)
-> Show FailureReport
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FailureReport -> ShowS
showsPrec :: Int -> FailureReport -> ShowS
$cshow :: FailureReport -> FilePath
show :: FailureReport -> FilePath
$cshowList :: [FailureReport] -> ShowS
showList :: [FailureReport] -> ShowS
Show, ReadPrec [FailureReport]
ReadPrec FailureReport
Int -> ReadS FailureReport
ReadS [FailureReport]
(Int -> ReadS FailureReport)
-> ReadS [FailureReport]
-> ReadPrec FailureReport
-> ReadPrec [FailureReport]
-> Read FailureReport
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FailureReport
readsPrec :: Int -> ReadS FailureReport
$creadList :: ReadS [FailureReport]
readList :: ReadS [FailureReport]
$creadPrec :: ReadPrec FailureReport
readPrec :: ReadPrec FailureReport
$creadListPrec :: ReadPrec [FailureReport]
readListPrec :: ReadPrec [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 (FailureReport -> FilePath
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
    IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
safeTry (FilePath -> FilePath -> IO ()
setEnv FilePath
"HSPEC_FAILURES" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FailureReport -> FilePath
forall a. Show a => a -> FilePath
show FailureReport
report) IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ()
forall {a}. Show a => a -> IO ()
onError () -> IO ()
forall a. a -> IO a
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 (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
err FilePath -> ShowS
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 = FilePath -> Maybe FailureReport
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
r
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FailureReport
report Maybe FailureReport -> Maybe FailureReport -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FailureReport
forall a. Maybe a
Nothing) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"WARNING: Could not read failure report from file " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
file FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"!")
        Maybe FailureReport -> IO (Maybe FailureReport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
report
      else Maybe FailureReport -> IO (Maybe FailureReport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
forall a. Maybe a
Nothing
  Maybe FilePath
Nothing -> do
    Maybe FilePath
mx <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"HSPEC_FAILURES"
    case Maybe FilePath
mx Maybe FilePath
-> (FilePath -> Maybe FailureReport) -> Maybe FailureReport
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe FailureReport
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!"
        Maybe FailureReport -> IO (Maybe FailureReport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
forall a. Maybe a
Nothing
      Maybe FailureReport
report -> Maybe FailureReport -> IO (Maybe FailureReport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
report