module Rerun where
import Control.Exception
import Control.Monad (when)
import Prelude
import Safe (lastMay)
import System.Directory (removeFile)
import System.Environment
import System.IO (IOMode (ReadMode), withFile)
import System.IO.Strict
import Test.Hspec.Runner
main clientSpec = do
logPutStrLn <- getPrinter
let
logPrint :: Show a => a -> IO ()
logPrint = logPutStrLn . show
safeReadFile :: FilePath -> IO (Maybe String)
safeReadFile fs = logAndIgnore Nothing $ do
f <- withFile fs ReadMode (\h -> hGetContents h >>= \x -> seq (lastMay x) (return x))
logPrint ("saferead got", f)
return (Just f)
logAndIgnore def f = handle (\(e::IOException) -> logPrint ("saferead failed", e) >> return def) f
stashFile <- lookupEnv "HSPEC_FAILURES_FILE"
alreadySet <- lookupEnv "HSPEC_FAILURES"
logPrint ("startup", stashFile, alreadySet)
case (stashFile,alreadySet) of
(Just stash,Just failures) -> do
logPrint ("writing stash optimistically", failures)
writeFile stash failures
(Just stash,Nothing) -> do
logPrint ("reading", stash)
f <- safeReadFile stash
logPrint ("read", stash)
case f of
Nothing -> logPrint ("couldn't read stash", stash)
Just contents -> do
when (contents /= "") $ do
logPrint ("read stash, setting env", contents)
setEnv "HSPEC_FAILURES" contents
_ -> return ()
clientSpec `finally` do
logPrint "done with tests!"
case stashFile of
Just stash -> logAndIgnore () $ removeFile stash
Nothing -> return ()
newSet <- lookupEnv "HSPEC_FAILURES"
logPrint ("spec failures", newSet,stashFile,alreadySet)
case (stashFile,alreadySet,newSet) of
(Just stash,Nothing,Just newset) ->
writeFile stash newset
_ -> return ()
getPrinter :: IO (String -> IO ())
getPrinter = do
debug <- lookupEnv "HSPEC_STACK_RERUN_DEBUG"
return $ case debug of
Nothing -> (\_ -> return ())
Just _ -> putStrLn