content: {-# LANGUAGE OverloadedStrings #-}
  
  module Interop.Client (runInteropClient) where
  
  import Control.Exception
  import Control.Monad
  import Data.IORef
  import System.Exit
  import System.Timeout
  
  import Interop.Cmdline
  import Interop.Util.ANSI
  import Interop.Util.Exceptions
  
  import Interop.Client.TestCase.EmptyUnary                qualified as EmptyUnary
  import Interop.Client.TestCase.LargeUnary                qualified as LargeUnary
  import Interop.Client.TestCase.ClientCompressedUnary     qualified as ClientCompressedUnary
  import Interop.Client.TestCase.ServerCompressedUnary     qualified as ServerCompressedUnary
  import Interop.Client.TestCase.ClientStreaming           qualified as ClientStreaming
  import Interop.Client.TestCase.ClientCompressedStreaming qualified as ClientCompressedStreaming
  import Interop.Client.TestCase.ServerStreaming           qualified as ServerStreaming
  import Interop.Client.TestCase.ServerCompressedStreaming qualified as ServerCompressedStreaming
  import Interop.Client.TestCase.PingPong                  qualified as PingPong
  import Interop.Client.TestCase.EmptyStream               qualified as EmptyStream
  import Interop.Client.TestCase.CustomMetadata            qualified as CustomMetadata
  import Interop.Client.TestCase.StatusCodeAndMessage      qualified as StatusCodeAndMessage
  import Interop.Client.TestCase.SpecialStatusMessage      qualified as SpecialStatusMessage
  import Interop.Client.TestCase.UnimplementedMethod       qualified as UnimplementedMethod
  import Interop.Client.TestCase.UnimplementedService      qualified as UnimplementedService
  import Interop.Client.TestCase.CancelAfterBegin          qualified as CancelAfterBegin
  import Interop.Client.TestCase.CancelAfterFirstResponse  qualified as CancelAfterFirstResponse
  import Interop.Client.TestCase.TimeoutOnSleepingServer   qualified as TimeoutOnSleepingServer
  
  {-------------------------------------------------------------------------------
    Top-level
  -------------------------------------------------------------------------------}
  
  runInteropClient :: Cmdline -> IO ()
  runInteropClient cmdline = do
      stats <- newIORef initTestStats
  
      case cmdTestCase cmdline of
        Nothing ->
          forM_ [minBound .. maxBound] $ testCase cmdline stats
        Just test ->
          testCase cmdline stats test
  
      ranAllTests stats
  
  {-------------------------------------------------------------------------------
    Running individual tests
  -------------------------------------------------------------------------------}
  
  runTest :: TestCase -> Cmdline -> IO ()
  runTest TestEmptyUnary                = EmptyUnary.runTest
  runTest TestLargeUnary                = LargeUnary.runTest
  runTest TestClientCompressedUnary     = ClientCompressedUnary.runTest
  runTest TestServerCompressedUnary     = ServerCompressedUnary.runTest
  runTest TestClientStreaming           = ClientStreaming.runTest
  runTest TestClientCompressedStreaming = ClientCompressedStreaming.runTest
  runTest TestServerStreaming           = ServerStreaming.runTest
  runTest TestServerCompressedStreaming = ServerCompressedStreaming.runTest
  runTest TestPingPong                  = PingPong.runTest
  runTest TestEmptyStream               = EmptyStream.runTest
  runTest TestCustomMetadata            = CustomMetadata.runTest
  runTest TestStatusCodeAndMessage      = StatusCodeAndMessage.runTest
  runTest TestSpecialStatusMessage      = SpecialStatusMessage.runTest
  runTest TestUnimplementedMethod       = UnimplementedMethod.runTest
  runTest TestUnimplementedService      = UnimplementedService.runTest
  runTest TestCancelAfterBegin          = CancelAfterBegin.runTest
  runTest TestCancelAfterFirstResponse  = CancelAfterFirstResponse.runTest
  runTest TestTimeoutOnSleepingServer   = TimeoutOnSleepingServer.runTest
  
  skips :: Cmdline -> TestCase -> Bool
  skips cmdline test = or [
        elem test (cmdSkipTest cmdline)
      , cmdSkipCompression cmdline && elem test [
            TestClientCompressedUnary
          , TestServerCompressedUnary
          , TestClientCompressedStreaming
          , TestServerCompressedStreaming
          ]
      , cmdSkipClientCompression cmdline && elem test [
            TestClientCompressedUnary
          , TestClientCompressedStreaming
          ]
      ]
  
  testCase :: Cmdline -> IORef TestStats -> TestCase -> IO ()
  testCase cmdline stats test = unless (skips cmdline test) $ do
      result <- try $ timeout (cmdTimeoutTest cmdline * 1_000_000) $
                  runTest test cmdline
      case result of
        Right (Just ()) ->
          testOK stats test
        Right Nothing ->
          testFailed stats test "timeout"
        Left err | Just (TestSkipped reason) <- fromException err ->
          testSkipped stats test reason
        Left err ->
          testFailed stats test (displayException err)
  
  {-------------------------------------------------------------------------------
    Test stats
  -------------------------------------------------------------------------------}
  
  data TestStats = TestStats {
        numSucceeded :: Int
      , numFailed    :: Int
      , numSkipped   :: Int
      }
  
  initTestStats :: TestStats
  initTestStats = TestStats {
        numSucceeded = 0
      , numFailed    = 0
      , numSkipped   = 0
      }
  
  testOK :: IORef TestStats -> TestCase -> IO ()
  testOK statsRef test = do
      putDocLn $ mconcat [
          Show test
        , ": "
        , Color Green "OK"
        ]
      modifyIORef statsRef $ \stats ->
        stats { numSucceeded = numSucceeded stats + 1 }
  
  testFailed :: IORef TestStats -> TestCase -> String -> IO ()
  testFailed statsRef test err = do
      putDocLn $ mconcat [
          Show test
        , ": "
        , Color Red "Failed: "
        , fromString err
        ]
      modifyIORef statsRef $ \stats ->
        stats { numFailed = numFailed stats + 1 }
  
  testSkipped :: IORef TestStats -> TestCase -> String -> IO ()
  testSkipped statsRef test reason = do
      putDocLn $ mconcat [
          Show test
        , ": "
        , Color Yellow "Skipped: "
        , fromString reason
        ]
      modifyIORef statsRef $ \stats ->
        stats { numSkipped = numSkipped stats + 1 }
  
  ranAllTests :: IORef TestStats -> IO ()
  ranAllTests statsRef = do
      stats <- readIORef statsRef
  
      when (numSucceeded stats + numFailed stats > 1 || numSkipped stats > 0) $
        putStrLn $ concat [
            show $ numSucceeded stats
          , " succeeded, "
          , show $ numFailed stats
          , " failed, "
          , show $ numSkipped stats
          , " skipped."
          ]
  
      when (numFailed stats > 0) $
        exitFailure
  