{-# LANGUAGE ScopedTypeVariables #-}
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



-- | We wrap this so that we can stash HSPEC_FAILURES in a file (which
--   comes from HSPEC_FAILURES_FILE).

main clientSpec = do

  logPrint <- do
    debug <- lookupEnv "HSPEC_STACK_RERUN_DEBUG"
    return $ case debug of
      Nothing -> const $ return ()
      Just _  -> print
  let
    -- 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))
      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
      -- 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
      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)
        -- this should read all of contents, thereby closing the
        -- filehandle. Lazy IO is the devil.
        Just contents ->  do
          when (contents /= "") $ do
            logPrint ("read stash, setting env", contents)
            setEnv "HSPEC_FAILURES" contents
    _ -> return ()
  clientSpec `finally` do
    logPrint "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"
    logPrint ("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 ()