    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ExistentialQuantification #-}
    -- |
    -- Stability: unstable
    --
    -- This is an unstable API.  Use
    -- [Test.Hspec.Api.Format.V2](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html)
    -- instead.
    module Test.Hspec.Core.Format
    -- {-# WARNING "Use [Test.Hspec.Api.Format.V2](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html) instead." #-}
    (
      Format
    , FormatConfig(..)
    , defaultFormatConfig
    , Event(..)
    , Progress
    , Path
    , Location(..)
    , Seconds(..)
    , Item(..)
    , Result(..)
    , FailureReason(..)
    , monadic
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat

    import           Control.Concurrent
    import           Control.Concurrent.Async (Async, async)
    import qualified Control.Concurrent.Async as Async
    import           Control.Monad.IO.Class

    import           Test.Hspec.Core.Example (Progress, Location(..), FailureReason(..))
    import           Test.Hspec.Core.Util (Path, formatExceptionWith)
    import           Test.Hspec.Core.Clock (Seconds(..))

    type Format = Event -> IO ()

    data Item = Item {
      Item -> Maybe Location
    itemLocation :: Maybe Location
    , Item -> Seconds
    itemDuration :: Seconds
    , Item -> String
    itemInfo :: String
    , Item -> Result
    itemResult :: Result
    } deriving Int -> Item -> ShowS
    [Item] -> ShowS
    Item -> String
    (Int -> Item -> ShowS)
    -> (Item -> String) -> ([Item] -> ShowS) -> Show Item
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Item -> ShowS
    showsPrec :: Int -> Item -> ShowS
    $cshow :: Item -> String
    show :: Item -> String
    $cshowList :: [Item] -> ShowS
    showList :: [Item] -> ShowS
    Show

    data Result =
        Success
      | Pending (Maybe Location) (Maybe String)
      | Failure (Maybe Location) FailureReason
      deriving Int -> Result -> ShowS
    [Result] -> ShowS
    Result -> String
    (Int -> Result -> ShowS)
    -> (Result -> String) -> ([Result] -> ShowS) -> Show Result
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Result -> ShowS
    showsPrec :: Int -> Result -> ShowS
    $cshow :: Result -> String
    show :: Result -> String
    $cshowList :: [Result] -> ShowS
    showList :: [Result] -> ShowS
    Show

    data Event =
        Started
      | GroupStarted Path
      | GroupDone Path
      | Progress Path Progress
      | ItemStarted Path
      | ItemDone Path Item
      | Done [(Path, Item)]
      deriving Int -> Event -> ShowS
    [Event] -> ShowS
    Event -> String
    (Int -> Event -> ShowS)
    -> (Event -> String) -> ([Event] -> ShowS) -> Show Event
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Event -> ShowS
    showsPrec :: Int -> Event -> ShowS
    $cshow :: Event -> String
    show :: Event -> String
    $cshowList :: [Event] -> ShowS
    showList :: [Event] -> ShowS
    Show

    data FormatConfig = FormatConfig {
      FormatConfig -> Bool
    formatConfigUseColor :: Bool
    , FormatConfig -> Bool
    formatConfigReportProgress :: Bool
    , FormatConfig -> Bool
    formatConfigOutputUnicode :: Bool
    , FormatConfig -> Bool
    formatConfigUseDiff :: Bool
    , FormatConfig -> Maybe Int
    formatConfigDiffContext :: Maybe Int
    , FormatConfig -> Maybe (String -> String -> IO ())
    formatConfigExternalDiff :: Maybe (String -> String -> IO ())
    , FormatConfig -> Bool
    formatConfigPrettyPrint :: Bool
    , FormatConfig -> Maybe (String -> String -> (String, String))
    formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
    , FormatConfig -> SomeException -> String
    formatConfigFormatException :: SomeException -> String -- ^ @since 2.11.5
    , FormatConfig -> Bool
    formatConfigPrintTimes :: Bool
    , FormatConfig -> Bool
    formatConfigHtmlOutput :: Bool
    , FormatConfig -> Bool
    formatConfigPrintCpuTime :: Bool
    , FormatConfig -> Integer
    formatConfigUsedSeed :: Integer
    , FormatConfig -> Int
    formatConfigExpectedTotalCount :: Int
    , FormatConfig -> Bool
    formatConfigExpertMode :: Bool
    }

    {-# DEPRECATED formatConfigPrettyPrint "Use `formatConfigPrettyPrintFunction` instead" #-}

    -- ^ @since 2.11.5
    defaultFormatConfig :: FormatConfig
    defaultFormatConfig :: FormatConfig
    defaultFormatConfig = FormatConfig {
      formatConfigUseColor :: Bool
    formatConfigUseColor = Bool
    False
    , formatConfigReportProgress :: Bool
    formatConfigReportProgress = Bool
    False
    , formatConfigOutputUnicode :: Bool
    formatConfigOutputUnicode = Bool
    False
    , formatConfigUseDiff :: Bool
    formatConfigUseDiff = Bool
    False
    , formatConfigDiffContext :: Maybe Int
    formatConfigDiffContext = Maybe Int
    forall a. Maybe a
    Nothing
    , formatConfigExternalDiff :: Maybe (String -> String -> IO ())
    formatConfigExternalDiff = Maybe (String -> String -> IO ())
    forall a. Maybe a
    Nothing
    , formatConfigPrettyPrint :: Bool
    formatConfigPrettyPrint = Bool
    False
    , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
    formatConfigPrettyPrintFunction = Maybe (String -> String -> (String, String))
    forall a. Maybe a
    Nothing
    , formatConfigFormatException :: SomeException -> String
    formatConfigFormatException = (SomeException -> String) -> SomeException -> String
    formatExceptionWith SomeException -> String
    forall a. Show a => a -> String
    show
    , formatConfigPrintTimes :: Bool
    formatConfigPrintTimes = Bool
    False
    , formatConfigHtmlOutput :: Bool
    formatConfigHtmlOutput = Bool
    False
    , formatConfigPrintCpuTime :: Bool
    formatConfigPrintCpuTime = Bool
    False
    , formatConfigUsedSeed :: Integer
    formatConfigUsedSeed = Integer
    0
    , formatConfigExpectedTotalCount :: Int
    formatConfigExpectedTotalCount = Int
    0
    , formatConfigExpertMode :: Bool
    formatConfigExpertMode = Bool
    False
    }

    data Signal = Ok | NotOk SomeException

    monadic :: MonadIO m => (m () -> IO ()) -> (Event -> m ()) -> IO Format
    monadic :: forall (m :: * -> *).
    MonadIO m =>
    (m () -> IO ()) -> (Event -> m ()) -> IO Format
    monadic m () -> IO ()
    run Event -> m ()
    format = do
      mvar <- IO (MVar Event)
    forall a. IO (MVar a)
    newEmptyMVar
      done <- newEmptyMVar

      let
        putEvent :: Event -> IO ()
        putEvent = MVar Event -> Format
    forall a. MVar a -> a -> IO ()
    putMVar MVar Event
    mvar

        takeEvent :: MonadIO m => m Event
        takeEvent = IO Event -> m Event
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Event -> m Event) -> IO Event -> m Event
    forall a b. (a -> b) -> a -> b
    $ MVar Event -> IO Event
    forall a. MVar a -> IO a
    takeMVar MVar Event
    mvar

        signal :: MonadIO m => Signal -> m ()
        signal = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Signal -> IO ()) -> Signal -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar Signal -> Signal -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar Signal
    done

        wait :: IO Signal
        wait = MVar Signal -> IO Signal
    forall a. MVar a -> IO a
    takeMVar MVar Signal
    done

        go = do
          event <- m Event
    forall (m :: * -> *). MonadIO m => m Event
    takeEvent
          format event
          case event of
            Done {} -> m ()
    forall (m :: * -> *). Applicative m => m ()
    pass
            Event
    _ -> do
              Signal -> m ()
    forall (m :: * -> *). MonadIO m => Signal -> m ()
    signal Signal
    Ok
              m ()
    go

      worker <- async $ do
        (run go >> signal Ok) `catch` (signal . NotOk)

      return $ \ Event
    event -> do
        running <- Async () -> IO Bool
    asyncRunning Async ()
    worker
        when running $ do
          putEvent event
          r <- wait
          case r of
            Signal
    Ok -> IO ()
    forall (m :: * -> *). Applicative m => m ()
    pass
            NotOk SomeException
    err -> do
              Async () -> IO ()
    forall a. Async a -> IO a
    Async.wait Async ()
    worker
              SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    err

    asyncRunning :: Async () -> IO Bool
    asyncRunning :: Async () -> IO Bool
    asyncRunning Async ()
    worker = Bool
    -> (Either SomeException () -> Bool)
    -> Maybe (Either SomeException ())
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (Bool -> Either SomeException () -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (Maybe (Either SomeException ()) -> Bool)
    -> IO (Maybe (Either SomeException ())) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Async () -> IO (Maybe (Either SomeException ()))
    forall a. Async a -> IO (Maybe (Either SomeException a))
    Async.poll Async ()
    worker