{-# 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(..)
, indentChunks
#endif
) where

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

import           Data.Char
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
    Bool
unicode <- FormatM Bool
outputUnicode
    let fallback :: p -> p -> p
fallback p
a p
b = if Bool
unicode then p
a else p
b
    ((FormatM () -> FormatM ()) -> [Char] -> FormatM ())
-> (FormatM () -> FormatM (), [Char]) -> FormatM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([[Char]]
-> [Char]
-> Seconds
-> [Char]
-> (FormatM () -> FormatM ())
-> [Char]
-> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement (Item -> Seconds
itemDuration Item
item) (Item -> [Char]
itemInfo Item
item)) ((FormatM () -> FormatM (), [Char]) -> FormatM ())
-> (FormatM () -> FormatM (), [Char]) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ case Item -> Result
itemResult Item
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 Item -> Result
itemResult Item
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] -> 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 -> 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
      Bool
shouldPrintTimes <- FormatM Bool
printTimes
      [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 () -> FormatM ()
withColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
symbol
      [Char] -> FormatM ()
writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"]" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [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
      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] -> 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
      Failure {} -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
        Int
n <- FormatM Int
getFailCount
        [[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting ([Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" FAILED [" [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]
"]") Seconds
duration [Char]
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
      Bool
shouldPrintTimes <- FormatM Bool
printTimes
      [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] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [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
      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]
""

  [FailureRecord]
failures <- FormatM [FailureRecord]
getFailMessages

  Bool -> FormatM () -> FormatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FailureRecord] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FailureRecord]
failures) (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> FormatM ()
writeLine [Char]
"Failures:"
    [Char] -> FormatM ()
writeLine [Char]
""

    [(Int, FailureRecord)]
-> ((Int, FailureRecord) -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FailureRecord] -> [(Int, FailureRecord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FailureRecord]
failures) (((Int, FailureRecord) -> FormatM ()) -> FormatM ())
-> ((Int, FailureRecord) -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \(Int, FailureRecord)
x -> do
      (Int, FailureRecord) -> FormatM ()
formatFailure (Int, FailureRecord)
x
      [Char] -> FormatM ()
writeLine [Char]
""

    [Char] -> FormatM ()
write [Char]
"Randomized with seed " FormatM () -> FormatM Integer -> FormatM Integer
forall a b. FormatM a -> FormatM b -> FormatM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM Integer
usedSeed FormatM Integer -> (Integer -> 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
>>= [Char] -> FormatM ()
writeLine ([Char] -> FormatM ())
-> (Integer -> [Char]) -> Integer -> FormatM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show
    [Char] -> FormatM ()
writeLine [Char]
""
  where
    formatFailure :: (Int, FailureRecord) -> FormatM ()
    formatFailure :: (Int, FailureRecord) -> FormatM ()
formatFailure (Int
n, FailureRecord Maybe Location
mLoc Path
path FailureReason
reason) = do
      Bool
unicode <- FormatM Bool
outputUnicode
      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 ([Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Location -> [Char]
formatLocation 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
        ColorizedReason [Char]
err -> [Char] -> FormatM ()
indent [Char]
err
        ExpectedButGot Maybe [Char]
preface [Char]
expected_ [Char]
actual_ -> do
          Maybe ([Char] -> [Char] -> ([Char], [Char]))
pretty <- FormatM (Maybe ([Char] -> [Char] -> ([Char], [Char])))
prettyPrintFunction
          let
            ([Char]
expected, [Char]
actual) = case Maybe ([Char] -> [Char] -> ([Char], [Char]))
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_)

          ([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

          Bool
b <- FormatM Bool
useDiff

          let threshold :: Seconds
threshold = Seconds
2 :: Seconds


          Maybe ([Char] -> [Char] -> IO ())
mExternalDiff <- FormatM (Maybe ([Char] -> [Char] -> IO ()))
externalDiffAction

          case Maybe ([Char] -> [Char] -> IO ())
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
              Maybe Int
context <- FormatM (Maybe Int)
diffContext
              Maybe [Diff]
mchunks <- IO (Maybe [Diff]) -> FormatM (Maybe [Diff])
forall a. IO a -> FormatM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Diff]) -> FormatM (Maybe [Diff]))
-> IO (Maybe [Diff]) -> FormatM (Maybe [Diff])
forall a b. (a -> b) -> a -> b
$ if Bool
b
                then Seconds -> IO [Diff] -> IO (Maybe [Diff])
forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
threshold ([Diff] -> IO [Diff]
forall a. a -> IO a
evaluate ([Diff] -> IO [Diff]) -> [Diff] -> IO [Diff]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> [Char] -> [Char] -> [Diff]
diff Maybe Int
context [Char]
expected [Char]
actual)
                else Maybe [Diff] -> IO (Maybe [Diff])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Diff]
forall a. Maybe a
Nothing

              case Maybe [Diff]
mchunks of
                Just [Diff]
chunks -> do
                  [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 ()
writeDiff [[Char] -> Diff
First [Char]
expected, [Char] -> Diff
Second [Char]
actual] [Char] -> FormatM ()
write [Char] -> FormatM ()
write
          where
            writeDiff :: [Diff]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [Diff]
chunks [Char] -> FormatM ()
extra [Char] -> FormatM ()
missing = do
              [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
writeChunks [Char]
"expected: " ([Diff] -> [Chunk]
expectedChunks [Diff]
chunks) [Char] -> FormatM ()
extra
              [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
writeChunks [Char]
" but got: " ([Diff] -> [Chunk]
actualChunks [Diff]
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)
              [ColorChunk] -> (ColorChunk -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [Chunk] -> [ColorChunk]
indentChunks [Char]
indentation_ [Chunk]
chunks) ((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
                Informational [Char]
a -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withInfoColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
a
              [Char] -> FormatM ()
writeLine [Char]
""
              where
                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
' '

        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
          SomeException -> [Char]
formatException <- (FormatConfig -> SomeException -> [Char])
-> FormatM (SomeException -> [Char])
forall a. (FormatConfig -> a) -> FormatM a
getConfigValue FormatConfig -> SomeException -> [Char]
formatConfigFormatException
          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]
++ SomeException -> [Char]
formatException SomeException
e


      FormatM () -> FormatM ()
unlessExpert (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
        let path_ :: [Char]
path_ = (if Bool
unicode then [Char] -> [Char]
ushow else [Char] -> [Char]
forall a. Show a => a -> [Char]
show) (Path -> [Char]
joinPath Path
path)
        [Char] -> FormatM ()
writeLine [Char]
""
        Integer
seed <- FormatM Integer
usedSeed
        [Char] -> FormatM ()
writeLine ([Char]
"  To rerun use: --match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path_ [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" --seed " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
seed)
      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)

data Chunk = Original String | Modified String | OmittedLines Int
  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 :: [Diff] -> [Chunk]
expectedChunks :: [Diff] -> [Chunk]
expectedChunks = (Diff -> Maybe Chunk) -> [Diff] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Diff -> Maybe Chunk) -> [Diff] -> [Chunk])
-> (Diff -> Maybe Chunk) -> [Diff] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
  Both [Char]
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Chunk
Original [Char]
a
  First [Char]
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Chunk
Modified [Char]
a
  Second [Char]
_ -> Maybe Chunk
forall a. Maybe a
Nothing
  Omitted Int
n -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Int -> Chunk
OmittedLines Int
n

actualChunks :: [Diff] -> [Chunk]
actualChunks :: [Diff] -> [Chunk]
actualChunks = (Diff -> Maybe Chunk) -> [Diff] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Diff -> Maybe Chunk) -> [Diff] -> [Chunk])
-> (Diff -> Maybe Chunk) -> [Diff] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
  Both [Char]
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Chunk
Original [Char]
a
  First [Char]
_ -> Maybe Chunk
forall a. Maybe a
Nothing
  Second [Char]
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ [Char] -> Chunk
Modified [Char]
a
  Omitted Int
n -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Int -> Chunk
OmittedLines Int
n

data ColorChunk = PlainChunk String | ColorChunk String | Informational 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)

data StartsWith = StartsWithNewline | StartsWithNonNewline
  deriving StartsWith -> StartsWith -> Bool
(StartsWith -> StartsWith -> Bool)
-> (StartsWith -> StartsWith -> Bool) -> Eq StartsWith
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartsWith -> StartsWith -> Bool
== :: StartsWith -> StartsWith -> Bool
$c/= :: StartsWith -> StartsWith -> Bool
/= :: StartsWith -> StartsWith -> Bool
Eq

indentChunks :: String -> [Chunk] -> [ColorChunk]
indentChunks :: [Char] -> [Chunk] -> [ColorChunk]
indentChunks [Char]
indentation = [Chunk] -> [ColorChunk]
go
  where
    go :: [Chunk] -> [ColorChunk]
    go :: [Chunk] -> [ColorChunk]
go = \ case
      Original [Char]
x : [Chunk]
xs -> [Char] -> [Char] -> ColorChunk
indentOriginal [Char]
indentation [Char]
x ColorChunk -> [ColorChunk] -> [ColorChunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [ColorChunk]
go [Chunk]
xs
      Modified [Char]
x : [Chunk]
xs -> StartsWith -> [Char] -> [Char] -> [ColorChunk]
indentModified ([Chunk] -> StartsWith
startsWith [Chunk]
xs) [Char]
indentation [Char]
x [ColorChunk] -> [ColorChunk] -> [ColorChunk]
forall a. [a] -> [a] -> [a]
++ [Chunk] -> [ColorChunk]
go [Chunk]
xs
      OmittedLines Int
n : [Chunk]
xs -> [Char] -> ColorChunk
Informational (Int -> [Char]
formatOmittedLines Int
n) ColorChunk -> [ColorChunk] -> [ColorChunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [ColorChunk]
go [Chunk]
xs
      [] -> []

    startsWith :: [Chunk] -> StartsWith
    startsWith :: [Chunk] -> StartsWith
startsWith [Chunk]
xs
      | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Chunk] -> [Char]
unChunks [Chunk]
xs) = StartsWith
StartsWithNewline
      | Bool
otherwise = StartsWith
StartsWithNonNewline

    unChunks :: [Chunk] -> String
    unChunks :: [Chunk] -> [Char]
unChunks = \ case
      Original [Char]
x : [Chunk]
xs -> [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Chunk] -> [Char]
unChunks [Chunk]
xs
      Modified [Char]
x : [Chunk]
xs -> [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Chunk] -> [Char]
unChunks [Chunk]
xs
      OmittedLines {} : [Chunk]
_ -> [Char]
""
      [] -> [Char]
""

    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 @@\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
indentation

indentOriginal :: String -> String -> ColorChunk
indentOriginal :: [Char] -> [Char] -> ColorChunk
indentOriginal [Char]
indentation = [Char] -> ColorChunk
PlainChunk ([Char] -> ColorChunk)
-> ([Char] -> [Char]) -> [Char] -> ColorChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
go
  where
    go :: [Char] -> [Char]
go [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]
ys) -> [Char]
xs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
indentation [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
go [Char]
ys
      ([Char]
xs, [Char]
"") -> [Char]
xs

indentModified :: StartsWith -> String -> String -> [ColorChunk]
indentModified :: StartsWith -> [Char] -> [Char] -> [ColorChunk]
indentModified StartsWith
nextChunk [Char]
indentation = [Char] -> [ColorChunk]
go
  where
    go :: String -> [ColorChunk]
    go :: [Char] -> [ColorChunk]
go = \ case
      [Char]
"" -> []
      [Char]
"\n" -> [[Char] -> ColorChunk
PlainChunk [Char]
"\n", [Char] -> ColorChunk
ColorChunk [Char]
indentation]
      Char
'\n' : ys :: [Char]
ys@(Char
'\n' : [Char]
_) -> [Char] -> ColorChunk
PlainChunk [Char]
"\n" ColorChunk -> [ColorChunk] -> [ColorChunk]
forall a. a -> [a] -> [a]
: [Char] -> ColorChunk
ColorChunk [Char]
indentation ColorChunk -> [ColorChunk] -> [ColorChunk]
forall a. a -> [a] -> [a]
: [Char] -> [ColorChunk]
go [Char]
ys
      Char
'\n' : [Char]
xs -> [Char] -> ColorChunk
PlainChunk (Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
indentation) ColorChunk -> [ColorChunk] -> [ColorChunk]
forall a. a -> [a] -> [a]
: [Char] -> [ColorChunk]
go [Char]
xs
      [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]
"") | StartsWith
nextChunk StartsWith -> StartsWith -> Bool
forall a. Eq a => a -> a -> Bool
== StartsWith
StartsWithNonNewline -> [[Char] -> ColorChunk
ColorChunk [Char]
xs]
        ([Char]
xs, [Char]
ys) -> [Char] -> [ColorChunk]
segment [Char]
xs [ColorChunk] -> [ColorChunk] -> [ColorChunk]
forall a. [a] -> [a] -> [a]
++ [Char] -> [ColorChunk]
go [Char]
ys

    segment :: String -> [ColorChunk]
    segment :: [Char] -> [ColorChunk]
segment [Char]
xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
xs of
      ([Char]
"", [Char]
_) -> [[Char] -> ColorChunk
ColorChunk [Char]
xs]
      ([Char]
_, [Char]
"") -> [[Char] -> ColorChunk
ColorChunk [Char]
xs]
      ([Char]
ys, [Char]
zs) -> [[Char] -> ColorChunk
ColorChunk ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
zs), [Char] -> ColorChunk
ColorChunk ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
ys)]

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)

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

  let
    output :: [Char]
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 :: FormatM a -> FormatM a
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
  FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
color (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine [Char]
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]
": "