    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE LambdaCase #-}
    module Test.Hspec.Core.Formatters.Internal (
      Formatter(..)
    , Item(..)
    , Result(..)
    , FailureReason(..)
    , FormatM
    , formatterToFormat

    , getConfig
    , getConfigValue
    , FormatConfig(..)

    , getSuccessCount
    , getPendingCount
    , getFailCount
    , getTotalCount
    , getExpectedTotalCount

    , FailureRecord(..)
    , getFailMessages
    , usedSeed

    , printTimes
    , getCPUTime
    , getRealTime

    , write
    , writeLine
    , writeTransient

    , withInfoColor
    , withSuccessColor
    , withPendingColor
    , withFailColor

    , outputUnicode

    , useDiff
    , diffContext
    , externalDiffAction
    , prettyPrint
    , prettyPrintFunction
    , extraChunk
    , missingChunk

    , unlessExpert

    #ifdef TEST
    , runFormatM
    , splitLines
    #endif
    ) where

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

    import qualified System.IO as IO
    import           System.IO (stdout)
    import           System.Console.ANSI hiding (clearLine)
    import           Control.Monad.Trans.Reader (ReaderT(..), ask)
    import           Control.Monad.IO.Class
    import           Data.Char (isSpace)
    import           Data.List (groupBy)
    import qualified System.CPUTime as CPUTime

    import           Test.Hspec.Core.Format
    import           Test.Hspec.Core.Clock

    data Formatter = Formatter {
    -- | evaluated before a test run
      Formatter -> FormatM ()
    formatterStarted :: FormatM ()

    -- | evaluated before each spec group
    , Formatter -> Path -> FormatM ()
    formatterGroupStarted :: Path -> FormatM ()

    -- | evaluated after each spec group
    , Formatter -> Path -> FormatM ()
    formatterGroupDone :: Path -> FormatM ()

    -- | used to notify the progress of the currently evaluated example
    , Formatter -> Path -> Progress -> FormatM ()
    formatterProgress :: Path -> Progress -> FormatM ()

    -- | evaluated before each spec item
    , Formatter -> Path -> FormatM ()
    formatterItemStarted :: Path -> FormatM ()

    -- | evaluated after each spec item
    , Formatter -> Path -> Item -> FormatM ()
    formatterItemDone :: Path -> Item -> FormatM ()

    -- | evaluated after a test run
    , Formatter -> FormatM ()
    formatterDone :: FormatM ()
    }

    data FailureRecord = FailureRecord {
      FailureRecord -> Maybe Location
    failureRecordLocation :: Maybe Location
    , FailureRecord -> Path
    failureRecordPath     :: Path
    , FailureRecord -> FailureReason
    failureRecordMessage  :: FailureReason
    }

    formatterToFormat :: Formatter -> FormatConfig -> IO Format
    formatterToFormat :: Formatter -> FormatConfig -> IO Format
    formatterToFormat Formatter{FormatM ()
    Path -> FormatM ()
    Path -> Progress -> FormatM ()
    Path -> Item -> FormatM ()
    formatterStarted :: Formatter -> FormatM ()
    formatterGroupStarted :: Formatter -> Path -> FormatM ()
    formatterGroupDone :: Formatter -> Path -> FormatM ()
    formatterProgress :: Formatter -> Path -> Progress -> FormatM ()
    formatterItemStarted :: Formatter -> Path -> FormatM ()
    formatterItemDone :: Formatter -> Path -> Item -> FormatM ()
    formatterDone :: Formatter -> FormatM ()
    formatterStarted :: FormatM ()
    formatterGroupStarted :: Path -> FormatM ()
    formatterGroupDone :: Path -> FormatM ()
    formatterProgress :: Path -> Progress -> FormatM ()
    formatterItemStarted :: Path -> FormatM ()
    formatterItemDone :: Path -> Item -> FormatM ()
    formatterDone :: FormatM ()
    ..} FormatConfig
    config = (FormatM () -> IO ()) -> (Event -> FormatM ()) -> IO Format
    forall (m :: * -> *).
    MonadIO m =>
    (m () -> IO ()) -> (Event -> m ()) -> IO Format
    monadic (FormatConfig -> FormatM () -> IO ()
    forall a. FormatConfig -> FormatM a -> IO a
    runFormatM FormatConfig
    config) ((Event -> FormatM ()) -> IO Format)
    -> (Event -> FormatM ()) -> IO Format
    forall a b. (a -> b) -> a -> b
    $ \ case
      Event
    Started -> FormatM ()
    formatterStarted
      GroupStarted Path
    path -> Path -> FormatM ()
    formatterGroupStarted Path
    path
      GroupDone Path
    path -> Path -> FormatM ()
    formatterGroupDone Path
    path
      Progress Path
    path Progress
    progress -> Path -> Progress -> FormatM ()
    formatterProgress Path
    path Progress
    progress
      ItemStarted Path
    path -> Path -> FormatM ()
    formatterItemStarted Path
    path
      ItemDone Path
    path Item
    item -> do
        case Item -> Result
    itemResult Item
    item of
          Success {} -> FormatM ()
    increaseSuccessCount
          Pending {} -> FormatM ()
    increasePendingCount
          Failure Maybe Location
    loc FailureReason
    err -> FailureRecord -> FormatM ()
    addFailure (FailureRecord -> FormatM ()) -> FailureRecord -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ Maybe Location -> Path -> FailureReason -> FailureRecord
    FailureRecord (Maybe Location
    loc Maybe Location -> Maybe Location -> Maybe Location
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Item -> Maybe Location
    itemLocation Item
    item) Path
    path FailureReason
    err
        Path -> Item -> FormatM ()
    formatterItemDone Path
    path Item
    item
      Done [(Path, Item)]
    _ -> FormatM ()
    formatterDone
      where
        addFailure :: FailureRecord -> FormatM ()
    addFailure FailureRecord
    r = (FormatterState -> FormatterState) -> FormatM ()
    modify ((FormatterState -> FormatterState) -> FormatM ())
    -> (FormatterState -> FormatterState) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ FormatterState
    s -> FormatterState
    s { stateFailMessages = r : stateFailMessages s }

    -- | Get the number of failed examples encountered so far.
    getFailCount :: FormatM Int
    getFailCount :: FormatM Int
    getFailCount = [FailureRecord] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([FailureRecord] -> Int) -> FormatM [FailureRecord] -> FormatM Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FormatM [FailureRecord]
    getFailMessages

    -- | Return `True` if the user requested colorized diffs, `False` otherwise.
    useDiff :: FormatM Bool
    useDiff :: FormatM Bool
    useDiff = (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigUseDiff

    -- | Do nothing on `--expert`, otherwise run the given action.
    --
    -- @since 2.11.2
    unlessExpert :: FormatM () -> FormatM ()
    unlessExpert :: FormatM () -> FormatM ()
    unlessExpert FormatM ()
    action = (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigExpertMode FormatM Bool -> (Bool -> FormatM ()) -> FormatM ()
    forall a b. FormatM a -> (a -> FormatM b) -> FormatM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
      Bool
    False -> FormatM ()
    action
      Bool
    True -> () -> FormatM ()
    forall a. a -> FormatM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- |
    -- Return the value of `Test.Hspec.Core.Runner.configDiffContext`.
    --
    -- @since 2.10.6
    diffContext :: FormatM (Maybe Int)
    diffContext :: FormatM (Maybe Int)
    diffContext = (FormatConfig -> Maybe Int) -> FormatM (Maybe Int)
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Maybe Int
    formatConfigDiffContext

    -- | An action for printing diffs.
    --
    -- The action takes @expected@ and @actual@ as arguments.
    --
    -- When this is a `Just`-value then it should be used instead of any built-in
    -- diff implementation.  A `Just`-value also implies that `useDiff` returns
    -- `True`.
    --
    -- @since 2.10.6
    externalDiffAction :: FormatM (Maybe (String -> String -> IO ()))
    externalDiffAction :: FormatM (Maybe (String -> String -> IO ()))
    externalDiffAction = (FormatConfig -> Maybe (String -> String -> IO ()))
    -> FormatM (Maybe (String -> String -> IO ()))
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Maybe (String -> String -> IO ())
    formatConfigExternalDiff

    -- | Return `True` if the user requested pretty diffs, `False` otherwise.
    prettyPrint :: FormatM Bool
    prettyPrint :: FormatM Bool
    prettyPrint = Bool
    -> ((String -> String -> (String, String)) -> Bool)
    -> Maybe (String -> String -> (String, String))
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> (String -> String -> (String, String)) -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (Maybe (String -> String -> (String, String)) -> Bool)
    -> FormatM (Maybe (String -> String -> (String, String)))
    -> FormatM Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FormatConfig -> Maybe (String -> String -> (String, String)))
    -> FormatM (Maybe (String -> String -> (String, String)))
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Maybe (String -> String -> (String, String))
    formatConfigPrettyPrintFunction
    {-# DEPRECATED prettyPrint "use `prettyPrintFunction` instead" #-}

    -- | Return a function for pretty-printing if the user requested pretty diffs,
    -- `Nothing` otherwise.
    --
    -- @since 2.10.0
    prettyPrintFunction :: FormatM (Maybe (String -> String -> (String, String)))
    prettyPrintFunction :: FormatM (Maybe (String -> String -> (String, String)))
    prettyPrintFunction = (FormatConfig -> Maybe (String -> String -> (String, String)))
    -> FormatM (Maybe (String -> String -> (String, String)))
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Maybe (String -> String -> (String, String))
    formatConfigPrettyPrintFunction

    -- | Return `True` if the user requested unicode output, `False` otherwise.
    --
    -- @since 2.9.0
    outputUnicode :: FormatM Bool
    outputUnicode :: FormatM Bool
    outputUnicode = (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigOutputUnicode

    -- | The same as `write`, but adds a newline character.
    writeLine :: String -> FormatM ()
    writeLine :: String -> FormatM ()
    writeLine String
    s = String -> FormatM ()
    write String
    s FormatM () -> FormatM () -> FormatM ()
    forall a b. FormatM a -> FormatM b -> FormatM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> FormatM ()
    write String
    "\n"

    -- | Return `True` if the user requested time reporting for individual spec
    -- items, `False` otherwise.
    printTimes :: FormatM Bool
    printTimes :: FormatM Bool
    printTimes = (FormatterState -> Bool) -> FormatM Bool
    forall a. (FormatterState -> a) -> FormatM a
    gets (FormatConfig -> Bool
    formatConfigPrintTimes (FormatConfig -> Bool)
    -> (FormatterState -> FormatConfig) -> FormatterState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FormatterState -> FormatConfig
    stateConfig)

    -- | Get the total number of examples encountered so far.
    getTotalCount :: FormatM Int
    getTotalCount :: FormatM Int
    getTotalCount = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> FormatM [Int] -> FormatM Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [FormatM Int] -> FormatM [Int]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [FormatM Int
    getSuccessCount, FormatM Int
    getFailCount, FormatM Int
    getPendingCount]

    -- | A lifted version of `Control.Monad.Trans.State.gets`
    gets :: (FormatterState -> a) -> FormatM a
    gets :: forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> a
    f = ReaderT (IORef FormatterState) IO a -> FormatM a
    forall a. ReaderT (IORef FormatterState) IO a -> FormatM a
    FormatM (ReaderT (IORef FormatterState) IO a -> FormatM a)
    -> ReaderT (IORef FormatterState) IO a -> FormatM a
    forall a b. (a -> b) -> a -> b
    $ do
      FormatterState -> a
    f (FormatterState -> a)
    -> ReaderT (IORef FormatterState) IO FormatterState
    -> ReaderT (IORef FormatterState) IO a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ReaderT (IORef FormatterState) IO (IORef FormatterState)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask ReaderT (IORef FormatterState) IO (IORef FormatterState)
    -> (IORef FormatterState
        -> ReaderT (IORef FormatterState) IO FormatterState)
    -> ReaderT (IORef FormatterState) IO FormatterState
    forall a b.
    ReaderT (IORef FormatterState) IO a
    -> (a -> ReaderT (IORef FormatterState) IO b)
    -> ReaderT (IORef FormatterState) IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO FormatterState
    -> ReaderT (IORef FormatterState) IO FormatterState
    forall a. IO a -> ReaderT (IORef FormatterState) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FormatterState
     -> ReaderT (IORef FormatterState) IO FormatterState)
    -> (IORef FormatterState -> IO FormatterState)
    -> IORef FormatterState
    -> ReaderT (IORef FormatterState) IO FormatterState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef FormatterState -> IO FormatterState
    forall a. IORef a -> IO a
    readIORef)

    -- | A lifted version of `Control.Monad.Trans.State.modify`
    modify :: (FormatterState -> FormatterState) -> FormatM ()
    modify :: (FormatterState -> FormatterState) -> FormatM ()
    modify FormatterState -> FormatterState
    f = ReaderT (IORef FormatterState) IO () -> FormatM ()
    forall a. ReaderT (IORef FormatterState) IO a -> FormatM a
    FormatM (ReaderT (IORef FormatterState) IO () -> FormatM ())
    -> ReaderT (IORef FormatterState) IO () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
      ReaderT (IORef FormatterState) IO (IORef FormatterState)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask ReaderT (IORef FormatterState) IO (IORef FormatterState)
    -> (IORef FormatterState -> ReaderT (IORef FormatterState) IO ())
    -> ReaderT (IORef FormatterState) IO ()
    forall a b.
    ReaderT (IORef FormatterState) IO a
    -> (a -> ReaderT (IORef FormatterState) IO b)
    -> ReaderT (IORef FormatterState) IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> ReaderT (IORef FormatterState) IO ()
    forall a. IO a -> ReaderT (IORef FormatterState) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT (IORef FormatterState) IO ())
    -> (IORef FormatterState -> IO ())
    -> IORef FormatterState
    -> ReaderT (IORef FormatterState) IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IORef FormatterState -> (FormatterState -> FormatterState) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    `modifyIORef'` FormatterState -> FormatterState
    f)

    data FormatterState = FormatterState {
      FormatterState -> Int
    stateSuccessCount    :: !Int
    , FormatterState -> Int
    statePendingCount    :: !Int
    , FormatterState -> [FailureRecord]
    stateFailMessages    :: [FailureRecord]
    , FormatterState -> Maybe Integer
    stateCpuStartTime    :: Maybe Integer
    , FormatterState -> Seconds
    stateStartTime       :: Seconds
    , FormatterState -> FormatConfig
    stateConfig          :: FormatConfig
    , FormatterState -> Maybe SGR
    stateColor           :: Maybe SGR
    }

    -- | @since 2.11.5
    getConfig :: FormatM FormatConfig
    getConfig :: FormatM FormatConfig
    getConfig = (FormatterState -> FormatConfig) -> FormatM FormatConfig
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> FormatConfig
    stateConfig

    -- | @since 2.11.5
    getConfigValue :: (FormatConfig -> a) -> FormatM a
    getConfigValue :: forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> a
    f = (FormatterState -> a) -> FormatM a
    forall a. (FormatterState -> a) -> FormatM a
    gets (FormatConfig -> a
    f (FormatConfig -> a)
    -> (FormatterState -> FormatConfig) -> FormatterState -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FormatterState -> FormatConfig
    stateConfig)

    -- | The random seed that is used for QuickCheck.
    usedSeed :: FormatM Integer
    usedSeed :: FormatM Integer
    usedSeed = (FormatConfig -> Integer) -> FormatM Integer
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Integer
    formatConfigUsedSeed

    -- NOTE: We use an IORef here, so that the state persists when UserInterrupt is
    -- thrown.
    newtype FormatM a = FormatM (ReaderT (IORef FormatterState) IO a)
      deriving ((forall a b. (a -> b) -> FormatM a -> FormatM b)
    -> (forall a b. a -> FormatM b -> FormatM a) -> Functor FormatM
    forall a b. a -> FormatM b -> FormatM a
    forall a b. (a -> b) -> FormatM a -> FormatM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> FormatM a -> FormatM b
    fmap :: forall a b. (a -> b) -> FormatM a -> FormatM b
    $c<$ :: forall a b. a -> FormatM b -> FormatM a
    <$ :: forall a b. a -> FormatM b -> FormatM a
    Functor, Functor FormatM
    Functor FormatM =>
    (forall a. a -> FormatM a)
    -> (forall a b. FormatM (a -> b) -> FormatM a -> FormatM b)
    -> (forall a b c.
        (a -> b -> c) -> FormatM a -> FormatM b -> FormatM c)
    -> (forall a b. FormatM a -> FormatM b -> FormatM b)
    -> (forall a b. FormatM a -> FormatM b -> FormatM a)
    -> Applicative FormatM
    forall a. a -> FormatM a
    forall a b. FormatM a -> FormatM b -> FormatM a
    forall a b. FormatM a -> FormatM b -> FormatM b
    forall a b. FormatM (a -> b) -> FormatM a -> FormatM b
    forall a b c. (a -> b -> c) -> FormatM a -> FormatM b -> FormatM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> FormatM a
    pure :: forall a. a -> FormatM a
    $c<*> :: forall a b. FormatM (a -> b) -> FormatM a -> FormatM b
    <*> :: forall a b. FormatM (a -> b) -> FormatM a -> FormatM b
    $cliftA2 :: forall a b c. (a -> b -> c) -> FormatM a -> FormatM b -> FormatM c
    liftA2 :: forall a b c. (a -> b -> c) -> FormatM a -> FormatM b -> FormatM c
    $c*> :: forall a b. FormatM a -> FormatM b -> FormatM b
    *> :: forall a b. FormatM a -> FormatM b -> FormatM b
    $c<* :: forall a b. FormatM a -> FormatM b -> FormatM a
    <* :: forall a b. FormatM a -> FormatM b -> FormatM a
    Applicative, Applicative FormatM
    Applicative FormatM =>
    (forall a b. FormatM a -> (a -> FormatM b) -> FormatM b)
    -> (forall a b. FormatM a -> FormatM b -> FormatM b)
    -> (forall a. a -> FormatM a)
    -> Monad FormatM
    forall a. a -> FormatM a
    forall a b. FormatM a -> FormatM b -> FormatM b
    forall a b. FormatM a -> (a -> FormatM b) -> FormatM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. FormatM a -> (a -> FormatM b) -> FormatM b
    >>= :: forall a b. FormatM a -> (a -> FormatM b) -> FormatM b
    $c>> :: forall a b. FormatM a -> FormatM b -> FormatM b
    >> :: forall a b. FormatM a -> FormatM b -> FormatM b
    $creturn :: forall a. a -> FormatM a
    return :: forall a. a -> FormatM a
    Monad, Monad FormatM
    Monad FormatM => (forall a. IO a -> FormatM a) -> MonadIO FormatM
    forall a. IO a -> FormatM a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> FormatM a
    liftIO :: forall a. IO a -> FormatM a
    MonadIO)

    runFormatM :: FormatConfig -> FormatM a -> IO a
    runFormatM :: forall a. FormatConfig -> FormatM a -> IO a
    runFormatM FormatConfig
    config (FormatM ReaderT (IORef FormatterState) IO a
    action) = IO a -> IO a
    forall a. IO a -> IO a
    withLineBuffering (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
      time <- IO Seconds
    getMonotonicTime
      cpuTime <- if formatConfigPrintCpuTime config then Just <$> CPUTime.getCPUTime else pure Nothing

      let
        progress = FormatConfig -> Bool
    formatConfigReportProgress FormatConfig
    config Bool -> Bool -> Bool
    && Bool -> Bool
    not (FormatConfig -> Bool
    formatConfigHtmlOutput FormatConfig
    config)
        state = FormatterState {
          stateSuccessCount :: Int
    stateSuccessCount = Int
    0
        , statePendingCount :: Int
    statePendingCount = Int
    0
        , stateFailMessages :: [FailureRecord]
    stateFailMessages = []
        , stateCpuStartTime :: Maybe Integer
    stateCpuStartTime = Maybe Integer
    cpuTime
        , stateStartTime :: Seconds
    stateStartTime = Seconds
    time
        , stateConfig :: FormatConfig
    stateConfig = FormatConfig
    config { formatConfigReportProgress = progress }
        , stateColor :: Maybe SGR
    stateColor = Maybe SGR
    forall a. Maybe a
    Nothing
        }
      newIORef state >>= runReaderT action

    withLineBuffering :: IO a -> IO a
    withLineBuffering :: forall a. IO a -> IO a
    withLineBuffering IO a
    action = IO BufferMode
    -> (BufferMode -> IO ()) -> (BufferMode -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Handle -> IO BufferMode
    IO.hGetBuffering Handle
    stdout) (Handle -> BufferMode -> IO ()
    IO.hSetBuffering Handle
    stdout) ((BufferMode -> IO a) -> IO a) -> (BufferMode -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \ BufferMode
    _ -> do
      Handle -> BufferMode -> IO ()
    IO.hSetBuffering Handle
    stdout BufferMode
    IO.LineBuffering IO () -> IO a -> IO a
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO a
    action

    -- | Increase the counter for successful examples
    increaseSuccessCount :: FormatM ()
    increaseSuccessCount :: FormatM ()
    increaseSuccessCount = (FormatterState -> FormatterState) -> FormatM ()
    modify ((FormatterState -> FormatterState) -> FormatM ())
    -> (FormatterState -> FormatterState) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \FormatterState
    s -> FormatterState
    s {stateSuccessCount = succ $ stateSuccessCount s}

    -- | Increase the counter for pending examples
    increasePendingCount :: FormatM ()
    increasePendingCount :: FormatM ()
    increasePendingCount = (FormatterState -> FormatterState) -> FormatM ()
    modify ((FormatterState -> FormatterState) -> FormatM ())
    -> (FormatterState -> FormatterState) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \FormatterState
    s -> FormatterState
    s {statePendingCount = succ $ statePendingCount s}

    -- | Get the number of successful examples encountered so far.
    getSuccessCount :: FormatM Int
    getSuccessCount :: FormatM Int
    getSuccessCount = (FormatterState -> Int) -> FormatM Int
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> Int
    stateSuccessCount

    -- | Get the number of pending examples encountered so far.
    getPendingCount :: FormatM Int
    getPendingCount :: FormatM Int
    getPendingCount = (FormatterState -> Int) -> FormatM Int
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> Int
    statePendingCount

    -- | Get the list of accumulated failure messages.
    getFailMessages :: FormatM [FailureRecord]
    getFailMessages :: FormatM [FailureRecord]
    getFailMessages = [FailureRecord] -> [FailureRecord]
    forall a. [a] -> [a]
    reverse ([FailureRecord] -> [FailureRecord])
    -> FormatM [FailureRecord] -> FormatM [FailureRecord]
    forall a b. (a -> b) -> FormatM a -> FormatM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (FormatterState -> [FailureRecord]) -> FormatM [FailureRecord]
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> [FailureRecord]
    stateFailMessages

    -- | Get the number of spec items that will have been encountered when this run
    -- completes (if it is not terminated early).
    --
    -- @since 2.9.0
    getExpectedTotalCount :: FormatM Int
    getExpectedTotalCount :: FormatM Int
    getExpectedTotalCount = (FormatConfig -> Int) -> FormatM Int
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Int
    formatConfigExpectedTotalCount

    writeTransient :: String -> FormatM ()
    writeTransient :: String -> FormatM ()
    writeTransient String
    new = do
      reportProgress <- (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigReportProgress
      when reportProgress . liftIO $ do
        bracket_ disableLineWrapping enableLineWrapping $ writePlain new
        IO.hFlush stdout
        clearLine
      where
        disableLineWrapping :: IO ()
        disableLineWrapping :: IO ()
    disableLineWrapping = String -> IO ()
    writePlain String
    "\ESC[?7l"

        enableLineWrapping :: IO ()
        enableLineWrapping :: IO ()
    enableLineWrapping = String -> IO ()
    writePlain String
    "\ESC[?7h"

        clearLine :: IO ()
        clearLine :: IO ()
    clearLine = String -> IO ()
    writePlain String
    "\r\ESC[K"

    -- | Append some output to the report.
    write :: String -> FormatM ()
    write :: String -> FormatM ()
    write = (String -> FormatM ()) -> [String] -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> FormatM ()
    writeChunk ([String] -> FormatM ())
    -> (String -> [String]) -> String -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    splitLines

    splitLines :: String -> [String]
    splitLines :: String -> [String]
    splitLines = (Char -> Char -> Bool) -> String -> [String]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (\ Char
    a Char
    b -> Char -> Bool
    isNewline Char
    a Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Bool
    isNewline Char
    b)
      where
        isNewline :: Char -> Bool
    isNewline = (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n')

    writeChunk :: String -> FormatM ()
    writeChunk :: String -> FormatM ()
    writeChunk String
    str = do
      let
        plainOutput :: IO ()
    plainOutput = String -> IO ()
    writePlain String
    str
        colorOutput :: SGR -> IO ()
    colorOutput SGR
    color = IO () -> IO () -> IO () -> IO ()
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (Handle -> [SGR] -> IO ()
    hSetSGR Handle
    stdout [SGR
    color]) (Handle -> [SGR] -> IO ()
    hSetSGR Handle
    stdout [SGR
    Reset]) IO ()
    plainOutput
      mColor <- (FormatterState -> Maybe SGR) -> FormatM (Maybe SGR)
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> Maybe SGR
    stateColor
      liftIO $ case mColor of
        Just (SetColor ConsoleLayer
    Foreground ColorIntensity
    _ Color
    _) | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    str -> IO ()
    plainOutput
        Just SGR
    color -> SGR -> IO ()
    colorOutput SGR
    color
        Maybe SGR
    Nothing -> IO ()
    plainOutput

    writePlain :: String -> IO ()
    writePlain :: String -> IO ()
    writePlain = Handle -> String -> IO ()
    IO.hPutStr Handle
    stdout

    -- | Set output color to red, run given action, and finally restore the default
    -- color.
    withFailColor :: FormatM a -> FormatM a
    withFailColor :: forall a. FormatM a -> FormatM a
    withFailColor = SGR -> String -> FormatM a -> FormatM a
    forall a. SGR -> String -> FormatM a -> FormatM a
    withColor (ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Red) String
    "hspec-failure"

    -- | Set output color to green, run given action, and finally restore the
    -- default color.
    withSuccessColor :: FormatM a -> FormatM a
    withSuccessColor :: forall a. FormatM a -> FormatM a
    withSuccessColor = SGR -> String -> FormatM a -> FormatM a
    forall a. SGR -> String -> FormatM a -> FormatM a
    withColor (ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Green) String
    "hspec-success"

    -- | Set output color to yellow, run given action, and finally restore the
    -- default color.
    withPendingColor :: FormatM a -> FormatM a
    withPendingColor :: forall a. FormatM a -> FormatM a
    withPendingColor = SGR -> String -> FormatM a -> FormatM a
    forall a. SGR -> String -> FormatM a -> FormatM a
    withColor (ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Yellow) String
    "hspec-pending"

    -- | Set output color to cyan, run given action, and finally restore the
    -- default color.
    withInfoColor :: FormatM a -> FormatM a
    withInfoColor :: forall a. FormatM a -> FormatM a
    withInfoColor = SGR -> String -> FormatM a -> FormatM a
    forall a. SGR -> String -> FormatM a -> FormatM a
    withColor (ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    Cyan) String
    "hspec-info"

    -- | Set a color, run an action, and finally reset colors.
    withColor :: SGR -> String -> FormatM a -> FormatM a
    withColor :: forall a. SGR -> String -> FormatM a -> FormatM a
    withColor SGR
    color String
    cls FormatM a
    action = do
      produceHTML <- (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigHtmlOutput
      (if produceHTML then htmlSpan cls else withColor_ color) action

    htmlSpan :: String -> FormatM a -> FormatM a
    htmlSpan :: forall a. String -> FormatM a -> FormatM a
    htmlSpan String
    cls FormatM a
    action = String -> FormatM ()
    write (String
    "<span class=\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cls String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\">") FormatM () -> FormatM a -> FormatM a
    forall a b. FormatM a -> FormatM b -> FormatM b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> FormatM a
    action FormatM a -> FormatM () -> FormatM a
    forall a b. FormatM a -> FormatM b -> FormatM a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* String -> FormatM ()
    write String
    "</span>"

    withColor_ :: SGR -> FormatM a -> FormatM a
    withColor_ :: forall a. SGR -> FormatM a -> FormatM a
    withColor_ SGR
    color FormatM a
    action = do
      oldColor <- (FormatterState -> Maybe SGR) -> FormatM (Maybe SGR)
    forall a. (FormatterState -> a) -> FormatM a
    gets FormatterState -> Maybe SGR
    stateColor
      setColor (Just color) *> action <* setColor oldColor

    setColor :: Maybe SGR -> FormatM ()
    setColor :: Maybe SGR -> FormatM ()
    setColor Maybe SGR
    color = do
      useColor <- (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigUseColor
      when useColor $ do
        modify (\ FormatterState
    state -> FormatterState
    state { stateColor = color })

    -- | Output given chunk in red.
    extraChunk :: String -> FormatM ()
    extraChunk :: String -> FormatM ()
    extraChunk String
    s = do
      diff <- (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigUseDiff
      case diff of
        Bool
    True -> String -> FormatM ()
    extra String
    s
        Bool
    False -> String -> FormatM ()
    write String
    s
      where
        extra :: String -> FormatM ()
        extra :: String -> FormatM ()
    extra = Color -> String -> String -> FormatM ()
    diffColorize Color
    Red String
    "hspec-failure"

    -- | Output given chunk in green.
    missingChunk :: String -> FormatM ()
    missingChunk :: String -> FormatM ()
    missingChunk String
    s = do
      diff <- (FormatConfig -> Bool) -> FormatM Bool
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> Bool
    formatConfigUseDiff
      case diff of
        Bool
    True -> String -> FormatM ()
    missing String
    s
        Bool
    False -> String -> FormatM ()
    write String
    s
      where
        missing :: String-> FormatM ()
        missing :: String -> FormatM ()
    missing = Color -> String -> String -> FormatM ()
    diffColorize Color
    Green String
    "hspec-success"

    diffColorize :: Color -> String -> String-> FormatM ()
    diffColorize :: Color -> String -> String -> FormatM ()
    diffColorize Color
    color String
    cls String
    s = SGR -> String -> FormatM () -> FormatM ()
    forall a. SGR -> String -> FormatM a -> FormatM a
    withColor (ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    layer ColorIntensity
    Dull Color
    color) String
    cls (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ case String
    s of
      String
    "" -> String -> FormatM ()
    write String
    eraseInLine
      String
    _ -> String -> FormatM ()
    write String
    s
      where
        eraseInLine :: String
        eraseInLine :: String
    eraseInLine = String
    "\ESC[K"

        layer :: ConsoleLayer
        layer :: ConsoleLayer
    layer
          | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    s = ConsoleLayer
    Background
          | Bool
    otherwise = ConsoleLayer
    Foreground

    -- | Get the used CPU time since the test run has been started.
    getCPUTime :: FormatM (Maybe Seconds)
    getCPUTime :: FormatM (Maybe Seconds)
    getCPUTime = do
      t1  <- IO Integer -> FormatM Integer
    forall a. IO a -> FormatM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Integer
    CPUTime.getCPUTime
      mt0 <- gets stateCpuStartTime
      return $ toSeconds <$> ((t1 -) <$> mt0)
      where
        toSeconds :: a -> Seconds
    toSeconds a
    x = Double -> Seconds
    Seconds (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / (Double
    10.0 Double -> Integer -> Double
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Integer
    12 :: Integer)))

    -- | Get the passed real time since the test run has been started.
    getRealTime :: FormatM Seconds
    getRealTime :: FormatM Seconds
    getRealTime = do
      t1 <- IO Seconds -> FormatM Seconds
    forall a. IO a -> FormatM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Seconds
    getMonotonicTime
      t0 <- gets stateStartTime
      return (t1 - t0)