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

    #if !defined(__GHCJS__) && !defined(__MHS__)
    -- 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.
    #define HAS_SET_ENV
    #endif

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

    #ifdef HAS_SET_ENV
    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 HAS_SET_ENV
        -- 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
    ")")
    #else
        pass
    #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
        exists <- FilePath -> IO Bool
    doesFileExist FilePath
    file
        if exists
          then do
            r <- readFile file
            let report = FilePath -> Maybe FailureReport
    forall a. Read a => FilePath -> Maybe a
    readMaybe FilePath
    r
            when (report == Nothing) $ do
              hPutStrLn stderr ("WARNING: Could not read failure report from file " ++ show file ++ "!")
            return report
          else return Nothing
      Maybe FilePath
    Nothing -> do
        mx <- FilePath -> IO (Maybe FilePath)
    lookupEnv FilePath
    "HSPEC_FAILURES"
        case mx >>= 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