{-# 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      = forall (m :: * -> *). Applicative m => m ()
pass
, formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted = \ Path
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, formatterGroupDone :: Path -> FormatM ()
formatterGroupDone    = \ Path
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress     = \ Path
_ Progress
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, formatterItemStarted :: Path -> FormatM ()
formatterItemStarted  = \ Path
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone     = \ Path
_ Item
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, formatterDone :: FormatM ()
formatterDone         = forall (m :: * -> *). Applicative m => m ()
pass
}

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

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

, formatterItemDone :: Path -> Item -> FormatM ()
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
    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)) forall a b. (a -> b) -> a -> b
$ case Item -> Result
itemResult Item
item of
      Success {} -> (forall a. FormatM a -> FormatM a
withSuccessColor, forall {p}. p -> p -> p
fallback [Char]
"✔" [Char]
"v")
      Pending {} -> (forall a. FormatM a -> FormatM a
withPendingColor, forall {p}. p -> p -> p
fallback [Char]
"‐" [Char]
"-")
      Failure {} -> (forall a. FormatM a -> FormatM a
withFailColor,    forall {p}. p -> p -> p
fallback [Char]
"✘" [Char]
"x")
    case Item -> Result
itemResult Item
item of
      Success {} -> forall (m :: * -> *). Applicative m => m ()
pass
      Failure {} -> forall (m :: * -> *). Applicative m => m ()
pass
      Pending Maybe Location
_ Maybe [Char]
reason -> forall a. FormatM a -> FormatM a
withPendingColor forall a b. (a -> b) -> a -> b
$ do
        [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
"# PENDING: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason
} where
    indentationFor :: t a -> [Char]
indentationFor t a
nesting = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting 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 forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" ["
      FormatM () -> FormatM ()
withColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
symbol
      [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ [Char]
"]" forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [Char]
""
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
        [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s
      where
        dt :: Int
        dt :: Int
dt = Seconds -> Int
toMilliseconds Seconds
duration

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

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

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

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

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

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

, formatterItemDone :: Path -> Item -> FormatM ()
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 -> forall a. FormatM a -> FormatM a
withSuccessColor 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 -> forall a. FormatM a -> FormatM a
withPendingColor 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 forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
"# PENDING: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason
      Failure {} -> forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ do
        Int
n <- FormatM Int
getFailCount
        [[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting ([Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" FAILED [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"]") Seconds
duration [Char]
info

, formatterDone :: FormatM ()
formatterDone = FormatM ()
defaultFailedFormatter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM ()
defaultFooter
} where
    indentationFor :: t a -> [Char]
indentationFor t a
nesting = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting 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 forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [Char]
""
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
        [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s
      where
        dt :: Int
        dt :: Int
dt = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
duration forall a. Num a => a -> a -> a
* Double
1000)

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

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

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

failed_examples :: Formatter
failed_examples :: Formatter
failed_examples   = Formatter
silent {
  formatterDone :: FormatM ()
formatterDone = FormatM ()
defaultFailedFormatter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM ()
defaultFooter
}

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

  [FailureRecord]
failures <- FormatM [FailureRecord]
getFailMessages

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

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FailureRecord]
failures) 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 " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM Integer
usedSeed forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> FormatM ()
writeLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Location
mLoc forall a b. (a -> b) -> a -> b
$ \Location
loc -> do
        forall a. FormatM a -> FormatM a
withInfoColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine ([Char]
"  " forall a. [a] -> [a] -> [a]
++ Location -> [Char]
formatLocation Location
loc)
      [Char] -> FormatM ()
write ([Char]
"  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
") ")
      [Char] -> FormatM ()
writeLine (Path -> [Char]
formatRequirement Path
path)
      case FailureReason
reason of
        FailureReason
NoReason -> forall (m :: * -> *). Applicative m => m ()
pass
        Reason [Char]
err -> forall a. FormatM a -> FormatM a
withFailColor 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_)

          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
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
b
                then forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
threshold (forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ Maybe Int -> [Char] -> [Char] -> [Diff]
diff Maybe Int
context [Char]
expected [Char]
actual)
                else forall (m :: * -> *) a. Monad m => a -> m a
return 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
              forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
pre)
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [Chunk] -> [ColorChunk]
indentChunks [Char]
indentation_ [Chunk]
chunks) 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 -> forall a. FormatM a -> FormatM a
withInfoColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
a
              [Char] -> FormatM ()
writeLine [Char]
""
              where
                indentation_ :: [Char]
indentation_ = [Char]
indentation forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
pre) Char
' '

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


      FormatM () -> FormatM ()
unlessExpert forall a b. (a -> b) -> a -> b
$ do
        let path_ :: [Char]
path_ = (if Bool
unicode then [Char] -> [Char]
ushow else forall a. Show a => a -> [Char]
show) (Path -> [Char]
joinPath Path
path)
        [Char] -> FormatM ()
writeLine [Char]
""
        [Char] -> FormatM ()
writeLine ([Char]
"  To rerun use: --match " forall a. [a] -> [a] -> [a]
++ [Char]
path_)
      where
        indentation :: [Char]
indentation = [Char]
"       "
        indent :: [Char] -> FormatM ()
indent [Char]
message = do
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
message) forall a b. (a -> b) -> a -> b
$ \[Char]
line -> do
            [Char] -> FormatM ()
writeLine ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
line)

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

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

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

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

data StartsWith = StartsWithNewline | StartsWithNonNewline
  deriving StartsWith -> StartsWith -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartsWith -> StartsWith -> Bool
$c/= :: StartsWith -> StartsWith -> Bool
== :: StartsWith -> StartsWith -> Bool
$c== :: 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 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 forall a. [a] -> [a] -> [a]
++ [Chunk] -> [ColorChunk]
go [Chunk]
xs
      OmittedLines Int
n : [Chunk]
xs -> [Char] -> ColorChunk
Informational (Int -> [Char]
formatOmittedLines Int
n) forall a. a -> [a] -> [a]
: [Chunk] -> [ColorChunk]
go [Chunk]
xs
      [] -> []

    startsWith :: [Chunk] -> StartsWith
    startsWith :: [Chunk] -> StartsWith
startsWith [Chunk]
xs
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') 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 forall a. [a] -> [a] -> [a]
++ [Chunk] -> [Char]
unChunks [Chunk]
xs
      Modified [Char]
x : [Chunk]
xs -> [Char]
x forall a. [a] -> [a] -> [a]
++ [Chunk] -> [Char]
unChunks [Chunk]
xs
      OmittedLines {} : [Chunk]
_ -> [Char]
""
      [] -> [Char]
""

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

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

    segment :: String -> [ColorChunk]
    segment :: [Char] -> [ColorChunk]
segment [Char]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ 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 (forall a. [a] -> [a]
reverse [Char]
zs), [Char] -> ColorChunk
ColorChunk (forall a. [a] -> [a]
reverse [Char]
ys)]

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

  [Char] -> FormatM ()
writeLine forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> [a] -> [a]
(++)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. PrintfType r => [Char] -> r
printf [Char]
"Finished in %1.4f seconds" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM Seconds
getRealTime)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (forall r. PrintfType r => [Char] -> r
printf [Char]
", used %1.4f seconds of CPU time") 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"
      forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
pluralize Int
fails [Char]
"failure"
      forall a. [a] -> [a] -> [a]
++ if Int
pending forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
"" else [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
pending forall a. [a] -> [a] -> [a]
++ [Char]
" pending"

    color :: FormatM a -> FormatM a
color
      | Int
fails forall a. Eq a => a -> a -> Bool
/= Int
0   = forall a. FormatM a -> FormatM a
withFailColor
      | Int
pending forall a. Eq a => a -> a -> Bool
/= Int
0 = forall a. FormatM a -> FormatM a
withPendingColor
      | Bool
otherwise    = forall a. FormatM a -> FormatM a
withSuccessColor
  forall a. FormatM a -> FormatM a
color 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 forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
column forall a. [a] -> [a] -> [a]
++ [Char]
": "