    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    -- |
    -- Stability: unstable
    --
    -- This is an unstable API.  Use
    -- [Test.Hspec.Api.Formatters.V3](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V3.html)
    -- instead.
    module Test.Hspec.Core.Formatters.V2
    -- {-# WARNING "Use [Test.Hspec.Api.Formatters.V3](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V3.html) instead." #-}
    (
    -- * 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 (..)
    , Path
    , Progress
    , Location(..)
    , Item(..)
    , Result(..)
    , FailureReason (..)
    , FormatM
    , formatterToFormat

    -- ** Accessing config values
    , getConfig
    , getConfigValue
    , FormatConfig(..)

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

    , FailureRecord (..)
    , getFailMessages
    , usedSeed

    , printTimes

    , Seconds(..)
    , getCPUTime
    , getRealTime

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

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

    , outputUnicode

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

    -- ** expert mode
    , unlessExpert

    -- ** Helpers
    , formatLocation
    , Util.formatException

    #ifdef TEST
    , Chunk(..)
    , ColorChunk(..)
    #endif
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat
    import           System.IO (hFlush, stdout)

    import           Test.Hspec.Core.Util hiding (formatException)
    import qualified Test.Hspec.Core.Util as Util
    import           Test.Hspec.Core.Clock
    import           Test.Hspec.Core.Example (Location(..), Progress)
    import           Text.Printf
    import           Test.Hspec.Core.Formatters.Pretty.Unicode (ushow)
    import           Control.Monad.IO.Class

    -- We use an explicit import list for "Test.Hspec.Formatters.Monad", 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.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
      )

    import           Test.Hspec.Core.Formatters.Diff

    silent :: Formatter
    silent :: Formatter
    silent = Formatter {
      formatterStarted :: FormatM ()
    formatterStarted      = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterGroupStarted :: Path -> FormatM ()
    formatterGroupStarted = \ Path
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterGroupDone :: Path -> FormatM ()
    formatterGroupDone    = \ Path
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterProgress :: Path -> Progress -> FormatM ()
    formatterProgress     = \ Path
    _ Progress
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterItemStarted :: Path -> FormatM ()
    formatterItemStarted  = \ Path
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterItemDone :: Path -> Item -> FormatM ()
    formatterItemDone     = \ Path
    _ Item
    _ -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    , formatterDone :: FormatM ()
    formatterDone         = FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
    }

    checks :: Formatter
    checks :: Formatter
    checks = Formatter
    specdoc {
      formatterProgress = \([[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]
    "]"

    , formatterItemStarted = \([[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]
    " [ ]"

    , formatterItemDone = \ ([[Char]]
    nesting, [Char]
    requirement) Item
    item -> do
        unicode <- FormatM Bool
    outputUnicode
        let fallback p
    a p
    b = if Bool
    unicode then p
    a else p
    b
        uncurry (writeResult nesting requirement (itemDuration item) (itemInfo item)) $ case itemResult item of
          Success {} -> (FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor, [Char] -> [Char] -> [Char]
    forall {p}. p -> p -> p
    fallback [Char]
    "✔" [Char]
    "v")
          Pending {} -> (FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor, [Char] -> [Char] -> [Char]
    forall {p}. p -> p -> p
    fallback [Char]
    "‐" [Char]
    "-")
          Failure {} -> (FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withFailColor,    [Char] -> [Char] -> [Char]
    forall {p}. p -> p -> p
    fallback [Char]
    "✘" [Char]
    "x")
        case itemResult item of
          Success {} -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
          Failure {} -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
          Pending Maybe Location
    _ 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] -> [Char] -> FormatM ()
    indentBy ([[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting)) ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [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 -> Seconds -> String -> (FormatM () -> FormatM ()) -> String -> FormatM ()
        writeResult :: [[Char]]
    -> [Char]
    -> Seconds
    -> [Char]
    -> (FormatM () -> FormatM ())
    -> [Char]
    -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement Seconds
    duration [Char]
    info FormatM () -> FormatM ()
    withColor [Char]
    symbol = do
          shouldPrintTimes <- FormatM Bool
    printTimes
          write $ indentationFor nesting ++ requirement ++ " ["
          withColor $ write symbol
          writeLine $ "]" ++ if shouldPrintTimes then times else ""
          indentBy (indentationFor ("" : nesting)) info
          where
            dt :: Int
            dt :: Int
    dt = Seconds -> Int
    toMilliseconds Seconds
    duration

            times :: [Char]
    times
              | Int
    dt Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = [Char]
    ""
              | Bool
    otherwise = [Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "ms)"

        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 {

      formatterStarted = do
        writeLine ""

    , formatterGroupStarted = \ ([[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)

    , formatterProgress = \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)

    , formatterItemDone = \([[Char]]
    nesting, [Char]
    requirement) Item
    item -> do
        let duration :: Seconds
    duration = Item -> Seconds
    itemDuration Item
    item
            info :: [Char]
    info = Item -> [Char]
    itemInfo Item
    item

        case Item -> Result
    itemResult Item
    item of
          Result
    Success -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ do
            [[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement Seconds
    duration [Char]
    info
          Pending Maybe Location
    _ 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]] -> [Char] -> Seconds -> [Char] -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement Seconds
    duration [Char]
    info
            [Char] -> [Char] -> FormatM ()
    indentBy ([[Char]] -> [Char]
    forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
    indentationFor ([Char]
    "" [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    nesting)) ([Char] -> FormatM ()) -> [Char] -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [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
          Failure {} -> 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
            writeResult nesting (requirement ++ " FAILED [" ++ show n ++ "]") duration info

    , formatterDone = defaultFailedFormatter >> 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
    ' '

        writeResult :: [[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
    writeResult [[Char]]
    nesting [Char]
    requirement (Seconds Double
    duration) [Char]
    info = do
          shouldPrintTimes <- FormatM Bool
    printTimes
          writeLine $ indentationFor nesting ++ requirement ++ if shouldPrintTimes then times else ""
          indentBy (indentationFor ("" : nesting)) info
          where
            dt :: Int
            dt :: Int
    dt = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double
    duration Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    1000)

            times :: [Char]
    times
              | Int
    dt Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = [Char]
    ""
              | Bool
    otherwise = [Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "ms)"

        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
    failed_examples {
      formatterItemDone = \ Path
    _ Item
    item -> do
        case Item -> Result
    itemResult Item
    item of
          Success{} -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "."
          Pending{} -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    "."
          Failure{} -> 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"
        IO () -> FormatM ()
    forall a. IO a -> FormatM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FormatM ()) -> IO () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> IO ()
    hFlush Handle
    stdout
    }

    failed_examples :: Formatter
    failed_examples :: Formatter
    failed_examples   = Formatter
    silent {
      formatterDone = defaultFailedFormatter >> 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
          unicode <- FormatM Bool
    outputUnicode
          forM_ mLoc $ \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 ([Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Location -> [Char]
    formatLocation Location
    loc)
          write ("  " ++ show n ++ ") ")
          writeLine (formatRequirement path)
          case 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
            ColorizedReason [Char]
    err -> [Char] -> FormatM ()
    indent [Char]
    err
            ExpectedButGot Maybe [Char]
    preface [Char]
    expected_ [Char]
    actual_ -> do
              pretty <- FormatM (Maybe ([Char] -> [Char] -> ([Char], [Char])))
    prettyPrintFunction
              let
                (expected, actual) = case pretty of
                  Just [Char] -> [Char] -> ([Char], [Char])
    f -> [Char] -> [Char] -> ([Char], [Char])
    f [Char]
    expected_ [Char]
    actual_
                  Maybe ([Char] -> [Char] -> ([Char], [Char]))
    Nothing -> ([Char]
    expected_, [Char]
    actual_)

              mapM_ indent preface

              b <- useDiff

              let threshold = Seconds
    2 :: Seconds

              mExternalDiff <- externalDiffAction

              case mExternalDiff of
                Just [Char] -> [Char] -> IO ()
    externalDiff -> do
                  IO () -> FormatM ()
    forall a. IO a -> FormatM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> FormatM ()) -> IO () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> IO ()
    externalDiff [Char]
    expected [Char]
    actual

                Maybe ([Char] -> [Char] -> IO ())
    Nothing -> do
                  context <- FormatM (Maybe Int)
    diffContext
                  mchunks <- liftIO $ if b
                    then timeout threshold (evaluate $ lineDiff context expected actual)
                    else return Nothing

                  case mchunks of
                    Just [LineDiff]
    chunks -> do
                      [LineDiff]
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff [LineDiff]
    chunks [Char] -> FormatM ()
    extraChunk [Char] -> FormatM ()
    missingChunk
                    Maybe [LineDiff]
    Nothing -> do
                      [LineDiff]
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff [[[Char]] -> LineDiff
    LinesFirst ([Char] -> [[Char]]
    splitLines [Char]
    expected), [[Char]] -> LineDiff
    LinesSecond ([Char] -> [[Char]]
    splitLines [Char]
    actual)] [Char] -> FormatM ()
    write [Char] -> FormatM ()
    write
              where
                writeDiff :: [LineDiff] -> (String -> FormatM ()) -> (String -> FormatM ()) -> FormatM ()
                writeDiff :: [LineDiff]
    -> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
    writeDiff [LineDiff]
    chunks [Char] -> FormatM ()
    extra [Char] -> FormatM ()
    missing = do
                  [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
    writeChunks [Char]
    "expected: " ([LineDiff] -> [Chunk]
    expectedChunks [LineDiff]
    chunks) [Char] -> FormatM ()
    extra
                  [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
    writeChunks [Char]
    " but got: " ([LineDiff] -> [Chunk]
    actualChunks [LineDiff]
    chunks) [Char] -> FormatM ()
    missing

                writeChunks :: String -> [Chunk] -> (String -> FormatM ()) -> FormatM ()
                writeChunks :: [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
    writeChunks [Char]
    pre [Chunk]
    chunks [Char] -> FormatM ()
    colorize = 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]
    pre)
                  FormatM () -> [Chunk] -> FormatM ()
    go FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass [Chunk]
    chunks
                  where
                    indentation_ :: [Char]
                    indentation_ :: [Char]
    indentation_ = [Char]
    indentation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    pre) Char
    ' '

                    go :: FormatM () -> [Chunk] -> FormatM ()
                    go :: FormatM () -> [Chunk] -> FormatM ()
    go FormatM ()
    indent_ = \ case
                      [] -> FormatM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
                      Chunk
    c : [Chunk]
    cs -> do
                        FormatM ()
    indent_
                        case Chunk
    c of
                          Original [Char]
    a -> [Char] -> FormatM ()
    write [Char]
    a
                          Modified [Char]
    a -> [Char] -> FormatM ()
    colorize [Char]
    a
                          Info [Char]
    text -> FormatM () -> FormatM ()
    forall a. FormatM a -> FormatM a
    withInfoColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> FormatM ()
    write [Char]
    text
                          ModifiedChunks [ColorChunk]
    xs -> [ColorChunk] -> (ColorChunk -> FormatM ()) -> FormatM ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [ColorChunk]
    xs ((ColorChunk -> FormatM ()) -> FormatM ())
    -> (ColorChunk -> FormatM ()) -> FormatM ()
    forall a b. (a -> b) -> a -> b
    $ \ case
                            PlainChunk [Char]
    a -> [Char] -> FormatM ()
    write [Char]
    a
                            ColorChunk [Char]
    a -> [Char] -> FormatM ()
    colorize [Char]
    a
                        [Char] -> FormatM ()
    write [Char]
    "\n"
                        FormatM () -> [Chunk] -> FormatM ()
    go ([Char] -> FormatM ()
    write [Char]
    indentation_) [Chunk]
    cs

            Error Maybe [Char]
    info SomeException
    e -> 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]
    info
              formatException <- (FormatConfig -> SomeException -> [Char])
    -> FormatM (SomeException -> [Char])
    forall a. (FormatConfig -> a) -> FormatM a
    getConfigValue FormatConfig -> SomeException -> [Char]
    formatConfigFormatException
              withFailColor . indent $ "uncaught exception: " ++ formatException e

          unlessExpert $ do
            let path_ = (if Bool
    unicode then [Char] -> [Char]
    ushow else [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show) (Path -> [Char]
    joinPath Path
    path)
            writeLine ""
            seed <- usedSeed
            writeLine ("  To rerun use: --match " ++ path_ <> " --seed " <> show seed)
          where
            indentation :: [Char]
    indentation = [Char]
    "       "
            indent :: [Char] -> FormatM ()
    indent = [Char] -> [Char] -> FormatM ()
    indentBy [Char]
    indentation

    indentBy :: String -> String -> FormatM ()
    indentBy :: [Char] -> [Char] -> FormatM ()
    indentBy [Char]
    indentation [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)

    data Chunk = Original String | Modified String | Info String | ModifiedChunks [ColorChunk]
      deriving (Chunk -> Chunk -> Bool
    (Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Chunk -> Chunk -> Bool
    == :: Chunk -> Chunk -> Bool
    $c/= :: Chunk -> Chunk -> Bool
    /= :: Chunk -> Chunk -> Bool
    Eq, Int -> Chunk -> [Char] -> [Char]
    [Chunk] -> [Char] -> [Char]
    Chunk -> [Char]
    (Int -> Chunk -> [Char] -> [Char])
    -> (Chunk -> [Char]) -> ([Chunk] -> [Char] -> [Char]) -> Show Chunk
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Chunk -> [Char] -> [Char]
    showsPrec :: Int -> Chunk -> [Char] -> [Char]
    $cshow :: Chunk -> [Char]
    show :: Chunk -> [Char]
    $cshowList :: [Chunk] -> [Char] -> [Char]
    showList :: [Chunk] -> [Char] -> [Char]
    Show)

    expectedChunks :: [LineDiff] -> [Chunk]
    expectedChunks :: [LineDiff] -> [Chunk]
    expectedChunks = (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk])
    -> (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
    forall a b. (a -> b) -> a -> b
    $ \ case
      LinesBoth [[Char]]
    a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Chunk
    Original [[Char]]
    a
      LinesFirst [[Char]]
    a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Chunk
    Modified [[Char]]
    a
      LinesSecond [[Char]]
    _ -> []
      LinesOmitted Int
    n -> [[Char] -> Chunk
    Info ([Char] -> Chunk) -> [Char] -> Chunk
    forall a b. (a -> b) -> a -> b
    $ Int -> [Char]
    formatOmittedLines Int
    n]
      SingleLineDiff [Diff]
    diffs -> Chunk -> [Chunk]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Chunk -> [Chunk])
    -> ((Diff -> Maybe ColorChunk) -> Chunk)
    -> (Diff -> Maybe ColorChunk)
    -> [Chunk]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ColorChunk] -> Chunk
    ModifiedChunks ([ColorChunk] -> Chunk)
    -> ((Diff -> Maybe ColorChunk) -> [ColorChunk])
    -> (Diff -> Maybe ColorChunk)
    -> Chunk
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk])
    -> [Diff] -> (Diff -> Maybe ColorChunk) -> [ColorChunk]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [Diff]
    diffs ((Diff -> Maybe ColorChunk) -> [Chunk])
    -> (Diff -> Maybe ColorChunk) -> [Chunk]
    forall a b. (a -> b) -> a -> b
    $ \ case
        First [Char]
    a -> ColorChunk -> Maybe ColorChunk
    forall a. a -> Maybe a
    Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ColorChunk
    ColorChunk [Char]
    a
        Second [Char]
    _ -> Maybe ColorChunk
    forall a. Maybe a
    Nothing
        Both [Char]
    a -> ColorChunk -> Maybe ColorChunk
    forall a. a -> Maybe a
    Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ColorChunk
    PlainChunk [Char]
    a

    actualChunks :: [LineDiff] -> [Chunk]
    actualChunks :: [LineDiff] -> [Chunk]
    actualChunks = (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk])
    -> (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
    forall a b. (a -> b) -> a -> b
    $ \ case
      LinesBoth [[Char]]
    a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Chunk
    Original [[Char]]
    a
      LinesFirst [[Char]]
    _ -> []
      LinesSecond [[Char]]
    a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Chunk
    Modified [[Char]]
    a
      LinesOmitted Int
    n -> [[Char] -> Chunk
    Info ([Char] -> Chunk) -> [Char] -> Chunk
    forall a b. (a -> b) -> a -> b
    $ Int -> [Char]
    formatOmittedLines Int
    n]
      SingleLineDiff [Diff]
    diffs -> Chunk -> [Chunk]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Chunk -> [Chunk])
    -> ((Diff -> Maybe ColorChunk) -> Chunk)
    -> (Diff -> Maybe ColorChunk)
    -> [Chunk]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ColorChunk] -> Chunk
    ModifiedChunks ([ColorChunk] -> Chunk)
    -> ((Diff -> Maybe ColorChunk) -> [ColorChunk])
    -> (Diff -> Maybe ColorChunk)
    -> Chunk
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk])
    -> [Diff] -> (Diff -> Maybe ColorChunk) -> [ColorChunk]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [Diff]
    diffs ((Diff -> Maybe ColorChunk) -> [Chunk])
    -> (Diff -> Maybe ColorChunk) -> [Chunk]
    forall a b. (a -> b) -> a -> b
    $ \ case
        First [Char]
    _ -> Maybe ColorChunk
    forall a. Maybe a
    Nothing
        Second [Char]
    a -> ColorChunk -> Maybe ColorChunk
    forall a. a -> Maybe a
    Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ColorChunk
    ColorChunk [Char]
    a
        Both [Char]
    a -> ColorChunk -> Maybe ColorChunk
    forall a. a -> Maybe a
    Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ColorChunk
    PlainChunk [Char]
    a

    data ColorChunk = PlainChunk String | ColorChunk String
      deriving (ColorChunk -> ColorChunk -> Bool
    (ColorChunk -> ColorChunk -> Bool)
    -> (ColorChunk -> ColorChunk -> Bool) -> Eq ColorChunk
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ColorChunk -> ColorChunk -> Bool
    == :: ColorChunk -> ColorChunk -> Bool
    $c/= :: ColorChunk -> ColorChunk -> Bool
    /= :: ColorChunk -> ColorChunk -> Bool
    Eq, Int -> ColorChunk -> [Char] -> [Char]
    [ColorChunk] -> [Char] -> [Char]
    ColorChunk -> [Char]
    (Int -> ColorChunk -> [Char] -> [Char])
    -> (ColorChunk -> [Char])
    -> ([ColorChunk] -> [Char] -> [Char])
    -> Show ColorChunk
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> ColorChunk -> [Char] -> [Char]
    showsPrec :: Int -> ColorChunk -> [Char] -> [Char]
    $cshow :: ColorChunk -> [Char]
    show :: ColorChunk -> [Char]
    $cshowList :: [ColorChunk] -> [Char] -> [Char]
    showList :: [ColorChunk] -> [Char] -> [Char]
    Show)

    formatOmittedLines :: Int -> String
    formatOmittedLines :: Int -> [Char]
    formatOmittedLines Int
    n = [Char]
    "@@ " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " lines omitted @@"

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

      [Char] -> FormatM ()
    writeLine ([Char] -> FormatM ()) -> FormatM [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])
    -> FormatM [Char] -> FormatM ([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]) -> FormatM Seconds -> FormatM [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FormatM Seconds
    getRealTime)
        FormatM ([Char] -> [Char]) -> FormatM [Char] -> FormatM [Char]
    forall a b. FormatM (a -> b) -> FormatM a -> FormatM 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])
    -> FormatM (Maybe Seconds) -> FormatM [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FormatM (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"

        color
          | 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
      color $ writeLine output

    formatLocation :: Location -> String
    formatLocation :: Location -> [Char]
    formatLocation (Location [Char]
    file Int
    line Int
    column) = [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]
    ": "