    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE LambdaCase #-}
    module Test.Hspec.Core.Formatters.V1.Internal (
    -- * Formatters
      silent
    , checks
    , specdoc
    , progress
    , failed_examples

    -- * Implementing a custom Formatter
    -- |
    -- A formatter is a set of actions.  Each action is evaluated when a certain
    -- situation is encountered during a test run.
    --
    -- Actions live in the `FormatM` monad.  It provides access to the runner state
    -- and primitives for appending to the generated report.
    , Formatter (..)
    , FailureReason (..)
    , FormatM
    , formatterToFormat

    -- ** Accessing the runner state
    , getSuccessCount
    , getPendingCount
    , getFailCount
    , getTotalCount

    , FailureRecord (..)
    , getFailMessages
    , usedSeed

    , Seconds(..)
    , getCPUTime
    , getRealTime

    -- ** Appending to the generated report
    , write
    , writeLine
    , writeTransient

    -- ** Dealing with colors
    , withInfoColor
    , withSuccessColor
    , withPendingColor
    , withFailColor

    , useDiff
    , extraChunk
    , missingChunk

    -- ** Helpers
    , formatException
    ) where

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

    import           Test.Hspec.Core.Util
    import           Test.Hspec.Core.Clock
    import           Test.Hspec.Core.Example (Location(..))
    import           Text.Printf
    import           Control.Monad.IO.Class

    -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make
    -- sure, that we only use the public API to implement formatters.
    --
    -- Everything imported here has to be re-exported, so that users can implement
    -- their own formatters.
    import Test.Hspec.Core.Formatters.V1.Monad (
        Formatter(..)
      , FailureReason(..)
      , FormatM

      , getSuccessCount
      , getPendingCount
      , getFailCount
      , getTotalCount

      , FailureRecord(..)
      , getFailMessages
      , usedSeed

      , getCPUTime
      , getRealTime

      , write
      , writeLine
      , writeTransient

      , withInfoColor
      , withSuccessColor
      , withPendingColor
      , withFailColor

      , useDiff
      , extraChunk
      , missingChunk
      )

    import           Test.Hspec.Core.Format (FormatConfig, Format)

    import           Test.Hspec.Core.Formatters.Diff
    import qualified Test.Hspec.Core.Formatters.V2 as V2
    import           Test.Hspec.Core.Formatters.V1.Monad (Item(..), Result(..), Environment(..), interpretWith)

    formatterToFormat :: Formatter -> FormatConfig -> IO Format
    formatterToFormat :: Formatter -> FormatConfig -> IO Format
    formatterToFormat = Formatter -> FormatConfig -> IO Format
    V2.formatterToFormat (Formatter -> FormatConfig -> IO Format)
    -> (Formatter -> Formatter)
    -> Formatter
    -> FormatConfig
    -> IO Format
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Formatter -> Formatter
    legacyFormatterToFormatter

    legacyFormatterToFormatter :: Formatter -> V2.Formatter
    legacyFormatterToFormatter :: Formatter -> Formatter
    legacyFormatterToFormatter Formatter{FormatM ()
    [[Char]] -> [Char] -> FormatM ()
    Path -> FormatM ()
    Path -> [Char] -> FormatM ()
    Path -> [Char] -> Maybe [Char] -> FormatM ()
    Path -> [Char] -> FailureReason -> FormatM ()
    Path -> Progress -> FormatM ()
    headerFormatter :: FormatM ()
    exampleGroupStarted :: [[Char]] -> [Char] -> FormatM ()
    exampleGroupDone :: FormatM ()
    exampleStarted :: Path -> FormatM ()
    exampleProgress :: Path -> Progress -> FormatM ()
    exampleSucceeded :: Path -> [Char] -> FormatM ()
    exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
    examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
    failedFormatter :: FormatM ()
    footerFormatter :: FormatM ()
    footerFormatter :: Formatter -> FormatM ()
    failedFormatter :: Formatter -> FormatM ()
    examplePending :: Formatter -> Path -> [Char] -> Maybe [Char] -> FormatM ()
    exampleFailed :: Formatter -> Path -> [Char] -> FailureReason -> FormatM ()
    exampleSucceeded :: Formatter -> Path -> [Char] -> FormatM ()
    exampleProgress :: Formatter -> Path -> Progress -> FormatM ()
    exampleStarted :: Formatter -> Path -> FormatM ()
    exampleGroupDone :: Formatter -> FormatM ()
    exampleGroupStarted :: Formatter -> [[Char]] -> [Char] -> FormatM ()
    headerFormatter :: Formatter -> FormatM ()
    ..} = V2.Formatter {
      formatterStarted :: FormatM ()
    V2.formatterStarted = FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret FormatM ()
    headerFormatter
    , formatterGroupStarted :: Path -> FormatM ()
    V2.formatterGroupStarted = FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ())
    -> (Path -> FormatM ()) -> Path -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([[Char]] -> [Char] -> FormatM ()) -> Path -> FormatM ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [[Char]] -> [Char] -> FormatM ()
    exampleGroupStarted
    , formatterGroupDone :: Path -> FormatM ()
    V2.formatterGroupDone = FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ())
    -> (Path -> FormatM ()) -> Path -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FormatM () -> Path -> FormatM ()
    forall a b. a -> b -> a
    const FormatM ()
    exampleGroupDone
    , formatterProgress :: Path -> Progress -> FormatM ()
    V2.formatterProgress = \ Path
    path -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ())
    -> (Progress -> FormatM ()) -> Progress -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> Progress -> FormatM ()
    exampleProgress Path
    path
    , formatterItemStarted :: Path -> FormatM ()
    V2.formatterItemStarted = FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ())
    -> (Path -> FormatM ()) -> Path -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> FormatM ()
    exampleStarted
    , formatterItemDone :: Path -> Item -> FormatM ()
    V2.formatterItemDone = \ Path
    path Item
    item -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
        case Item -> Result
    itemResult Item
    item of
          Result
    Success -> Path -> [Char] -> FormatM ()
    exampleSucceeded Path
    path (Item -> [Char]
    itemInfo Item
    item)
          Pending Maybe Location
    _ Maybe [Char]
    reason -> Path -> [Char] -> Maybe [Char] -> FormatM ()
    examplePending Path
    path (Item -> [Char]
    itemInfo Item
    item) Maybe [Char]
    reason
          Failure Maybe Location
    _ FailureReason
    reason -> Path -> [Char] -> FailureReason -> FormatM ()
    exampleFailed Path
    path (Item -> [Char]
    itemInfo Item
    item) (FailureReason -> FailureReason
    unliftFailureReason FailureReason
    reason)
    , formatterDone :: FormatM ()
    V2.formatterDone = FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    interpret (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ FormatM ()
    failedFormatter FormatM () -> FormatM () -> FormatM ()
    forall a b. Free FormatF a -> Free FormatF b -> Free FormatF b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> FormatM ()
    footerFormatter
    }

    unliftFailureRecord :: V2.FailureRecord -> FailureRecord
    unliftFailureRecord :: FailureRecord -> FailureRecord
    unliftFailureRecord V2.FailureRecord{Maybe Location
    Path
    FailureReason
    failureRecordLocation :: Maybe Location
    failureRecordPath :: Path
    failureRecordMessage :: FailureReason
    failureRecordMessage :: FailureRecord -> FailureReason
    failureRecordPath :: FailureRecord -> Path
    failureRecordLocation :: FailureRecord -> Maybe Location
    ..} = FailureRecord {
      Maybe Location
    failureRecordLocation :: Maybe Location
    failureRecordLocation :: Maybe Location
    failureRecordLocation
    , Path
    failureRecordPath :: Path
    failureRecordPath :: Path
    failureRecordPath
    , failureRecordMessage :: FailureReason
    failureRecordMessage = FailureReason -> FailureReason
    unliftFailureReason FailureReason
    failureRecordMessage
    }

    unliftFailureReason :: V2.FailureReason -> FailureReason
    unliftFailureReason :: FailureReason -> FailureReason
    unliftFailureReason = \ case
      FailureReason
    V2.NoReason -> FailureReason
    NoReason
      V2.Reason [Char]
    reason -> [Char] -> FailureReason
    Reason [Char]
    reason
      V2.ColorizedReason [Char]
    reason -> [Char] -> FailureReason
    Reason ([Char] -> [Char]
    stripAnsi [Char]
    reason)
      V2.ExpectedButGot Maybe [Char]
    preface [Char]
    expected [Char]
    actual -> Maybe [Char] -> [Char] -> [Char] -> FailureReason
    ExpectedButGot Maybe [Char]
    preface [Char]
    expected [Char]
    actual
      V2.Error Maybe [Char]
    info SomeException
    e -> Maybe [Char] -> SomeException -> FailureReason
    Error Maybe [Char]
    info SomeException
    e

    interpret :: FormatM a -> V2.FormatM a
    interpret :: forall a. FormatM a -> FormatM a
    interpret = Environment FormatM -> FormatM a -> FormatM a
    forall (m :: * -> *) a.
    Monad m =>
    Environment m -> FormatM a -> m a
    interpretWith Environment {
      environmentGetSuccessCount :: FormatM Int
    environmentGetSuccessCount = FormatM Int
    V2.getSuccessCount
    , environmentGetPendingCount :: FormatM Int
    environmentGetPendingCount = FormatM Int
    V2.getPendingCount
    , environmentGetFailMessages :: FormatM [FailureRecord]
    environmentGetFailMessages = (FailureRecord -> FailureRecord)
    -> [FailureRecord] -> [FailureRecord]
    forall a b. (a -> b) -> [a] -> [b]
    map FailureRecord -> FailureRecord
    unliftFailureRecord ([FailureRecord] -> [FailureRecord])
    -> FormatM [FailureRecord] -> FormatM [FailureRecord]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FormatM [FailureRecord]
    V2.getFailMessages
    , environmentUsedSeed :: FormatM Integer
    environmentUsedSeed = FormatM Integer
    V2.usedSeed
    , environmentPrintTimes :: FormatM Bool
    environmentPrintTimes = FormatM Bool
    V2.printTimes
    , environmentGetCPUTime :: FormatM (Maybe Seconds)
    environmentGetCPUTime = FormatM (Maybe Seconds)
    V2.getCPUTime
    , environmentGetRealTime :: FormatM Seconds
    environmentGetRealTime = FormatM Seconds
    V2.getRealTime
    , environmentWrite :: [Char] -> FormatM ()
    environmentWrite = [Char] -> FormatM ()
    V2.write
    , environmentWriteTransient :: [Char] -> FormatM ()
    environmentWriteTransient = [Char] -> FormatM ()
    V2.writeTransient
    , environmentWithFailColor :: forall a. FormatM a -> FormatM a
    environmentWithFailColor = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    V2.withFailColor
    , environmentWithSuccessColor :: forall a. FormatM a -> FormatM a
    environmentWithSuccessColor = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    V2.withSuccessColor
    , environmentWithPendingColor :: forall a. FormatM a -> FormatM a
    environmentWithPendingColor = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    V2.withPendingColor
    , environmentWithInfoColor :: forall a. FormatM a -> FormatM a
    environmentWithInfoColor = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    V2.withInfoColor
    , environmentUseDiff :: FormatM Bool
    environmentUseDiff = FormatM Bool
    V2.useDiff
    , environmentExtraChunk :: [Char] -> FormatM ()
    environmentExtraChunk = [Char] -> FormatM ()
    V2.extraChunk
    , environmentMissingChunk :: [Char] -> FormatM ()
    environmentMissingChunk = [Char] -> FormatM ()
    V2.missingChunk
    , environmentLiftIO :: forall a. IO a -> FormatM a
    environmentLiftIO = IO a -> FormatM a
    forall a. IO a -> FormatM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
    }

    silent :: Formatter
    silent :: Formatter
    silent = Formatter {
      headerFormatter :: FormatM ()
    headerFormatter     = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleGroupStarted :: [[Char]] -> [Char] -> FormatM ()
    exampleGroupStarted = \[[Char]]
    _ [Char]
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleGroupDone :: FormatM ()
    exampleGroupDone    = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleStarted :: Path -> FormatM ()
    exampleStarted      = \Path
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleProgress :: Path -> Progress -> FormatM ()
    exampleProgress     = \Path
    _ Progress
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleSucceeded :: Path -> [Char] -> FormatM ()
    exampleSucceeded    = \ Path
    _ [Char]
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
    exampleFailed       = \Path
    _ [Char]
    _ FailureReason
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
    examplePending      = \Path
    _ [Char]
    _ Maybe [Char]
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , failedFormatter :: FormatM ()
    failedFormatter     = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , footerFormatter :: FormatM ()
    footerFormatter     = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    }

    checks :: Formatter
    checks :: Formatter
    checks = Formatter
    specdoc {
      exampleStarted = \([[Char]]
    nesting, [Char]
    requirement) -> do
        [Char] -> FormatM ()
    writeTransient ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    requirement [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " [ ]"

    , exampleProgress = \([[Char]]
    nesting, [Char]
    requirement) Progress
    p -> do
        [Char] -> FormatM ()
    writeTransient ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    requirement [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " [" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Progress -> [Char]
    forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
    formatProgress Progress
    p) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"

    , exampleSucceeded = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info -> do
        [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement [Char]
    info (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "✔"

    , exampleFailed = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info FailureReason
    _ -> do
        [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement [Char]
    info (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "✘"

    , examplePending = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info Maybe [Char]
    reason -> do
        [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement [Char]
    info (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "‐"

        FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
          [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "# PENDING: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe [Char]
    "No reason given" Maybe [Char]
    reason
    } where
        indentationFor :: t a -> [Char]
    indentationFor t a
    nesting = Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    nesting Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2) Char
    ' '

        writeResult :: [String] -> String -> String -> FormatM () -> FormatM ()
        writeResult :: [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement [Char]
    info FormatM ()
    action = do
          [Char] -> FormatM ()
    write ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    requirement [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " ["
          FormatM ()
    action
          [Char] -> FormatM ()
    writeLine [Char]
    "]"
          [[Char]] -> ([Char] -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Char] -> [[Char]]
    lines [Char]
    info) (([Char] -> FormatM ()) -> FormatM ())
    -> ([Char] -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ [Char]
    s ->
            [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s

        formatProgress :: (a, a) -> [Char]
    formatProgress (a
    current, a
    total)
          | a
    total a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    current
          | Bool
    otherwise  = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    current [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    total

    specdoc :: Formatter
    specdoc :: Formatter
    specdoc = Formatter
    silent {

      headerFormatter = do
        writeLine ""

    , exampleGroupStarted = \[[Char]]
    nesting [Char]
    name -> do
        [Char] -> FormatM ()
    writeLine ([[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    name)

    , exampleProgress = \Path
    _ Progress
    p -> do
        [Char] -> FormatM ()
    writeTransient (Progress -> [Char]
    forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
    formatProgress Progress
    p)

    , exampleSucceeded = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
        [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    requirement
        [[Char]] -> ([Char] -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Char] -> [[Char]]
    lines [Char]
    info) (([Char] -> FormatM ()) -> FormatM ())
    -> ([Char] -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ [Char]
    s ->
          [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s

    , exampleFailed = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info FailureReason
    _ -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
        n <- FormatM Int
    getFailCount
        writeLine $ indentationFor nesting ++ requirement ++ " FAILED [" ++ show n ++ "]"
        forM_ (lines info) $ \ [Char]
    s ->
          [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s

    , examplePending = \([[Char]]
    nesting, [Char]
    requirement) [Char]
    info Maybe [Char]
    reason -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
        [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor [[Char]]
    nesting [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    requirement
        [[Char]] -> ([Char] -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Char] -> [[Char]]
    lines [Char]
    info) (([Char] -> FormatM ()) -> FormatM ())
    -> ([Char] -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ [Char]
    s ->
          [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s
        [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "# PENDING: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe [Char]
    "No reason given" Maybe [Char]
    reason

    , failedFormatter = defaultFailedFormatter

    , footerFormatter = defaultFooter
    } where
        indentationFor :: t a -> [Char]
    indentationFor t a
    nesting = Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    nesting Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2) Char
    ' '
        formatProgress :: (a, a) -> [Char]
    formatProgress (a
    current, a
    total)
          | a
    total a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    current
          | Bool
    otherwise  = a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    current [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    total

    progress :: Formatter
    progress :: Formatter
    progress = Formatter
    silent {
      exampleSucceeded = \Path
    _ [Char]
    _ -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "."
    , exampleFailed    = \Path
    _ [Char]
    _ FailureReason
    _ -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor    (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "F"
    , examplePending   = \Path
    _ [Char]
    _ Maybe [Char]
    _ -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "."
    , failedFormatter  = defaultFailedFormatter
    , footerFormatter  = defaultFooter
    }

    failed_examples :: Formatter
    failed_examples :: Formatter
    failed_examples   = Formatter
    silent {
      failedFormatter = defaultFailedFormatter
    , footerFormatter = defaultFooter
    }

    defaultFailedFormatter :: FormatM ()
    defaultFailedFormatter :: FormatM ()
    defaultFailedFormatter = do
      [Char] -> FormatM ()
    writeLine [Char]
    ""

      failures <- FormatM [FailureRecord]
    getFailMessages

      unless (null failures) $ do
        writeLine "Failures:"
        writeLine ""

        forM_ (zip [1..] failures) $ \(Int, FailureRecord)
    x -> do
          (Int, FailureRecord) -> FormatM ()
    formatFailure (Int, FailureRecord)
    x
          [Char] -> FormatM ()
    writeLine [Char]
    ""

        write "Randomized with seed " >> usedSeed >>= writeLine . show
        writeLine ""
      where
        formatFailure :: (Int, FailureRecord) -> FormatM ()
        formatFailure :: (Int, FailureRecord) -> FormatM ()
    formatFailure (Int
    n, FailureRecord Maybe Location
    mLoc Path
    path FailureReason
    reason) = do
          Maybe Location -> (Location -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Maybe Location
    mLoc ((Location -> FormatM ()) -> FormatM ())
    -> (Location -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \Location
    loc -> do
            FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withInfoColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    writeLine (Location -> [Char]
    formatLoc Location
    loc)
          [Char] -> FormatM ()
    write ([Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ") ")
          [Char] -> FormatM ()
    writeLine (Path -> [Char]
    formatRequirement Path
    path)
          case FailureReason
    reason of
            FailureReason
    NoReason -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
            Reason [Char]
    err -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    indent [Char]
    err
            ExpectedButGot Maybe [Char]
    preface [Char]
    expected [Char]
    actual -> do
              ([Char] -> FormatM ()) -> Maybe [Char] -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ [Char] -> FormatM ()
    indent Maybe [Char]
    preface

              b <- FormatM Bool
    useDiff

              let threshold = Seconds
    2 :: Seconds

              mchunks <- liftIO $ if b
                then timeout threshold (evaluate $ diff expected actual)
                else return Nothing

              case mchunks of
                Just [Diff]
    chunks -> do
                  [Diff]
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    forall {t :: * -> *}.
    Foldable t =>
    t Diff
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff [Diff]
    chunks [Char] -> FormatM ()
    extraChunk [Char] -> FormatM ()
    missingChunk
                Maybe [Diff]
    Nothing -> do
                  [Diff]
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    forall {t :: * -> *}.
    Foldable t =>
    t Diff
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff [[Char] -> Diff
    First [Char]
    expected, [Char] -> Diff
    Second [Char]
    actual] [Char] -> FormatM ()
    write [Char] -> FormatM ()
    write
              where
                indented :: ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> Free FormatF a
    output [Char]
    text = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n') [Char]
    text of
                  ([Char]
    xs, [Char]
    "") -> [Char] -> Free FormatF a
    output [Char]
    xs
                  ([Char]
    xs, Char
    _ : [Char]
    ys) -> [Char] -> Free FormatF a
    output ([Char]
    xs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n") Free FormatF a -> FormatM () -> FormatM ()
    forall a b. Free FormatF a -> Free FormatF b -> Free FormatF b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Char] -> FormatM ()
    write ([Char]
    indentation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "          ") FormatM () -> Free FormatF a -> Free FormatF a
    forall a b. Free FormatF a -> Free FormatF b -> Free FormatF b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> Free FormatF a
    output [Char]
    ys

                writeDiff :: t Diff
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff t Diff
    chunks [Char] -> FormatM ()
    extra [Char] -> FormatM ()
    missing = do
                  FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write ([Char]
    indentation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "expected: ")
                  t Diff -> (Diff -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ t Diff
    chunks ((Diff -> FormatM ()) -> FormatM ())
    -> (Diff -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ case
                    Both [Char]
    a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> FormatM ()
    write [Char]
    a
                    First [Char]
    a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> FormatM ()
    extra [Char]
    a
                    Second [Char]
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
                  [Char] -> FormatM ()
    writeLine [Char]
    ""

                  FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write ([Char]
    indentation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " but got: ")
                  t Diff -> (Diff -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ t Diff
    chunks ((Diff -> FormatM ()) -> FormatM ())
    -> (Diff -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ case
                    Both [Char]
    a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> FormatM ()
    write [Char]
    a
                    First [Char]
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
                    Second [Char]
    a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
    indented [Char] -> FormatM ()
    missing [Char]
    a
                  [Char] -> FormatM ()
    writeLine [Char]
    ""

            Error Maybe [Char]
    _ SomeException
    e -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor (FormatM () -> FormatM ())
    -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> FormatM ()
    indent ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ (([Char]
    "uncaught exception: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++) ([Char] -> [Char])
    -> (SomeException -> [Char]) -> SomeException -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> [Char]
    formatException) SomeException
    e

          [Char] -> FormatM ()
    writeLine [Char]
    ""
          [Char] -> FormatM ()
    writeLine ([Char]
    "  To rerun use: --match " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Path -> [Char]
    joinPath Path
    path))
          where
            indentation :: [Char]
    indentation = [Char]
    "       "
            indent :: [Char] -> FormatM ()
    indent [Char]
    message = do
              [[Char]] -> ([Char] -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Char] -> [[Char]]
    lines [Char]
    message) (([Char] -> FormatM ()) -> FormatM ())
    -> ([Char] -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    line -> do
                [Char] -> FormatM ()
    writeLine ([Char]
    indentation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    line)
            formatLoc :: Location -> [Char]
    formatLoc (Location [Char]
    file Int
    line Int
    column) = [Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    file [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    line [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    column [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": "

    defaultFooter :: FormatM ()
    defaultFooter :: FormatM ()
    defaultFooter = do

      [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> Free FormatF [Char] -> FormatM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    (++)
        ([Char] -> [Char] -> [Char])
    -> Free FormatF [Char] -> Free FormatF ([Char] -> [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Char] -> Seconds -> [Char]
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    "Finished in %1.4f seconds" (Seconds -> [Char]) -> Free FormatF Seconds -> Free FormatF [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Free FormatF Seconds
    getRealTime)
        Free FormatF ([Char] -> [Char])
    -> Free FormatF [Char] -> Free FormatF [Char]
    forall a b.
    Free FormatF (a -> b) -> Free FormatF a -> Free FormatF b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ([Char] -> (Seconds -> [Char]) -> Maybe Seconds -> [Char]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [Char]
    "" ([Char] -> Seconds -> [Char]
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    ", used %1.4f seconds of CPU time") (Maybe Seconds -> [Char])
    -> Free FormatF (Maybe Seconds) -> Free FormatF [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Free FormatF (Maybe Seconds)
    getCPUTime)

      fails   <- FormatM Int
    getFailCount
      pending <- getPendingCount
      total   <- getTotalCount

      let
        output =
             Int -> [Char] -> [Char]
    pluralize Int
    total   [Char]
    "example"
          [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char] -> [Char]
    pluralize Int
    fails [Char]
    "failure"
          [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ if Int
    pending Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then [Char]
    "" else [Char]
    ", " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    pending [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " pending"
        c | Int
    fails Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0   = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    withFailColor
          | Int
    pending Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    withPendingColor
          | Bool
    otherwise    = FormatM a -> FormatM a
    forall a. FormatM a -> FormatM a
    withSuccessColor
      c $ writeLine output