{-# LANGUAGE ScopedTypeVariables #-}
module Rerun where
import Test.Hspec.Runner
import Control.Exception
import Prelude
import System.Environment
import System.IO.Strict
import System.IO(withFile,IOMode(ReadMode))
import System.Directory(removeFile)
import Safe (lastMay)
import Control.Monad(when)
-- | We wrap this so that we can stash HSPEC_FAILURES in a file (which
-- comes from HSPEC_FAILURES_FILE).
main clientSpec = do
stashFile <- lookupEnv "HSPEC_FAILURES_FILE"
alreadySet <- lookupEnv "HSPEC_FAILURES"
print ("startup", stashFile, alreadySet)
case (stashFile,alreadySet) of
(Just stash,Just failures) -> do
-- if there's no stash set, we might as well write it so
-- we have a starting point. it might get overwritten later,
-- that's fine
print ("writing stash optimistically", failures)
writeFile stash failures
(Just stash,Nothing) -> do
print ("reading", stash)
f <- safeReadFile stash
print ("read", stash)
case f of
Nothing -> print ("couldn't read stash", stash)
-- this should read all of contents, thereby closing the
-- filehandle. Lazy IO is the devil.
Just contents -> do
when (contents /= "") $ do
print ("read stash, setting env", contents)
setEnv "HSPEC_FAILURES" contents
_ -> return ()
clientSpec `finally` do
print "done with tests!"
-- we don't remove the file until now, so that if ghcid gets
-- interrupted, we still have the failures to run first.
-- small race condition, obviously, but the worst case is that
-- we run more tests than we should.
case stashFile of
Just stash -> logAndIgnore () $ removeFile stash
Nothing -> return ()
newSet <- lookupEnv "HSPEC_FAILURES"
print ("spec failures", newSet,stashFile,alreadySet)
case (stashFile,alreadySet,newSet) of
-- only care if there is a stash file, the var wasn't set before,
-- and there is a new value: here, we write the file
(Just stash,Nothing,Just newset) ->
writeFile stash newset
_ -> return ()
-- LAZY IO IS THE DEVIL
safeReadFile :: FilePath -> IO (Maybe String)
safeReadFile fs = logAndIgnore Nothing $ do
f <- withFile fs ReadMode (\h -> hGetContents h >>= \x -> seq (lastMay x) (return x))
print ("saferead got", f)
return (Just f)
logAndIgnore def f = handle (\(e::IOException) -> print ("saferead failed", e) >> return def) f