{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.Runner.Single (runSingleTestWithFlakinessMode) where

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import System.Timeout (timeout)
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef

-- | Run a single test.
--
-- Run the test up to 'maxRetries' times.
-- Finish as soon as the test passes once, or when we run out of retries.
runSingleTestWithFlakinessMode ::
  forall externalResources t.
  -- | How to report test progress
  ProgressReporter ->
  -- | External resources
  HList externalResources ->
  -- | Test definition
  TDef
    ( ProgressReporter ->
      ((HList externalResources -> () -> t) -> t) ->
      IO TestRunResult
    ) ->
  -- | Timeout
  Timeout ->
  -- | Max retries
  Word ->
  -- | Flakiness mode
  FlakinessMode ->
  -- | Expectation mode
  ExpectationMode ->
  -- | Test result
  IO TestRunReport
runSingleTestWithFlakinessMode :: forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Timeout
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
runSingleTestWithFlakinessMode ProgressReporter
progressReporter HList externalResources
l TDef
  (ProgressReporter
   -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
td Timeout
mTimeout Word
maxRetries FlakinessMode
fm ExpectationMode
em = do
  NonEmpty TestRunResult
results <- ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Timeout
-> Word
-> ExpectationMode
-> IO (NonEmpty TestRunResult)
forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Timeout
-> Word
-> ExpectationMode
-> IO (NonEmpty TestRunResult)
runSingleTestWithRetries ProgressReporter
progressReporter HList externalResources
l TDef
  (ProgressReporter
   -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
td Timeout
mTimeout Word
maxRetries ExpectationMode
em
  TestRunReport -> IO TestRunReport
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TestRunReport
      { testRunReportExpectationMode :: ExpectationMode
testRunReportExpectationMode = ExpectationMode
em,
        testRunReportRawResults :: NonEmpty TestRunResult
testRunReportRawResults = NonEmpty TestRunResult
results,
        testRunReportFlakinessMode :: FlakinessMode
testRunReportFlakinessMode = FlakinessMode
fm
      }

runSingleTestWithRetries ::
  forall externalResources t.
  -- | How to report test progress
  ProgressReporter ->
  -- | External resources
  HList externalResources ->
  -- | Test definition
  TDef
    ( ProgressReporter ->
      ((HList externalResources -> () -> t) -> t) ->
      IO TestRunResult
    ) ->
  -- | Timeout
  Timeout ->
  -- | Max retries
  Word ->
  -- | Expectation mode
  ExpectationMode ->
  -- If the test ever passed, and the last test result
  IO (NonEmpty TestRunResult)
runSingleTestWithRetries :: forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Timeout
-> Word
-> ExpectationMode
-> IO (NonEmpty TestRunResult)
runSingleTestWithRetries ProgressReporter
progressReporter HList externalResources
l TDef
  (ProgressReporter
   -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
td Timeout
mTimeout Word
maxRetries ExpectationMode
em = Word -> IO (NonEmpty TestRunResult)
go Word
maxRetries
  where
    go :: Word -> IO (NonEmpty TestRunResult)
    go :: Word -> IO (NonEmpty TestRunResult)
go Word
w
      | Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
1 = (TestRunResult -> [TestRunResult] -> NonEmpty TestRunResult
forall a. a -> [a] -> NonEmpty a
:| []) (TestRunResult -> NonEmpty TestRunResult)
-> (Either TestRunResult TestRunResult -> TestRunResult)
-> Either TestRunResult TestRunResult
-> NonEmpty TestRunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestRunResult -> TestRunResult)
-> (TestRunResult -> TestRunResult)
-> Either TestRunResult TestRunResult
-> TestRunResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TestRunResult -> TestRunResult
forall a. a -> a
id TestRunResult -> TestRunResult
forall a. a -> a
id (Either TestRunResult TestRunResult -> NonEmpty TestRunResult)
-> IO (Either TestRunResult TestRunResult)
-> IO (NonEmpty TestRunResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either TestRunResult TestRunResult)
runWithTimeout
      | Bool
otherwise = do
          Either TestRunResult TestRunResult
mResult <- IO (Either TestRunResult TestRunResult)
runWithTimeout
          case Either TestRunResult TestRunResult
mResult of
            -- Don't retry on timeout
            Left TestRunResult
result -> NonEmpty TestRunResult -> IO (NonEmpty TestRunResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestRunResult
result TestRunResult -> [TestRunResult] -> NonEmpty TestRunResult
forall a. a -> [a] -> NonEmpty a
:| [])
            Right TestRunResult
result ->
              if TestStatus -> ExpectationMode -> Bool
testStatusMatchesExpectationMode (TestRunResult -> TestStatus
testRunResultStatus TestRunResult
result) ExpectationMode
em
                then NonEmpty TestRunResult -> IO (NonEmpty TestRunResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestRunResult
result TestRunResult -> [TestRunResult] -> NonEmpty TestRunResult
forall a. a -> [a] -> NonEmpty a
:| [])
                else do
                  NonEmpty TestRunResult
rest <- Word -> IO (NonEmpty TestRunResult)
go (Word -> Word
forall a. Enum a => a -> a
pred Word
w)
                  NonEmpty TestRunResult -> IO (NonEmpty TestRunResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestRunResult
result TestRunResult -> NonEmpty TestRunResult -> NonEmpty TestRunResult
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty TestRunResult
rest)
      where
        runWithTimeout :: IO (Either TestRunResult TestRunResult)
        runWithTimeout :: IO (Either TestRunResult TestRunResult)
runWithTimeout = case Timeout
mTimeout of
          Timeout
DoNotTimeout -> TestRunResult -> Either TestRunResult TestRunResult
forall a b. b -> Either a b
Right (TestRunResult -> Either TestRunResult TestRunResult)
-> IO TestRunResult -> IO (Either TestRunResult TestRunResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TestRunResult
runFunc
          TimeoutAfterMicros Int
micros -> do
            Maybe TestRunResult
mResult <- Int -> IO TestRunResult -> IO (Maybe TestRunResult)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
micros IO TestRunResult
runFunc
            Either TestRunResult TestRunResult
-> IO (Either TestRunResult TestRunResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TestRunResult TestRunResult
 -> IO (Either TestRunResult TestRunResult))
-> Either TestRunResult TestRunResult
-> IO (Either TestRunResult TestRunResult)
forall a b. (a -> b) -> a -> b
$ case Maybe TestRunResult
mResult of
              Maybe TestRunResult
Nothing -> TestRunResult -> Either TestRunResult TestRunResult
forall a b. a -> Either a b
Left TestRunResult
timeoutResult
              Just TestRunResult
result -> TestRunResult -> Either TestRunResult TestRunResult
forall a b. b -> Either a b
Right TestRunResult
result

        runFunc :: IO TestRunResult
        runFunc :: IO TestRunResult
runFunc = TDef
  (ProgressReporter
   -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> ProgressReporter
-> ((HList externalResources -> () -> t) -> t)
-> IO TestRunResult
forall value. TDef value -> value
testDefVal TDef
  (ProgressReporter
   -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
td ProgressReporter
progressReporter (\HList externalResources -> () -> t
f -> HList externalResources -> () -> t
f HList externalResources
l ())

        timeoutResult :: TestRunResult
        timeoutResult :: TestRunResult
timeoutResult =
          TestRunResult
            { testRunResultStatus :: TestStatus
testRunResultStatus = TestStatus
TestFailed,
              testRunResultException :: Maybe SomeException
testRunResultException = Maybe SomeException
forall a. Maybe a
Nothing,
              testRunResultNumTests :: Maybe Word
testRunResultNumTests = Maybe Word
forall a. Maybe a
Nothing,
              testRunResultNumShrinks :: Maybe Word
testRunResultNumShrinks = Maybe Word
forall a. Maybe a
Nothing,
              testRunResultFailingInputs :: [String]
testRunResultFailingInputs = [],
              testRunResultLabels :: Maybe (Map [String] Int)
testRunResultLabels = Maybe (Map [String] Int)
forall a. Maybe a
Nothing,
              testRunResultClasses :: Maybe (Map String Int)
testRunResultClasses = Maybe (Map String Int)
forall a. Maybe a
Nothing,
              testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultTables = Maybe (Map String (Map String Int))
forall a. Maybe a
Nothing,
              testRunResultGoldenCase :: Maybe GoldenCase
testRunResultGoldenCase = Maybe GoldenCase
forall a. Maybe a
Nothing,
              testRunResultExtraInfo :: Maybe String
testRunResultExtraInfo = String -> Maybe String
forall a. a -> Maybe a
Just String
"Timeout!"
            }