{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ExistentialQuantification #-}
module Test.Hspec.Core.Formatters.V1.Monad (
  Formatter(..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM

, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount

, FailureRecord (..)
, getFailMessages
, usedSeed

, printTimes
, getCPUTime
, getRealTime

, write
, writeLine
, writeTransient

, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor

, useDiff
, extraChunk
, missingChunk

, Environment(..)
, interpretWith
) where

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

import           Control.Monad.IO.Class

import           Test.Hspec.Core.Formatters.V1.Free
import           Test.Hspec.Core.Clock
import           Test.Hspec.Core.Format hiding (FailureReason)

data FailureReason =
    NoReason
  | Reason String
  | ExpectedButGot (Maybe String) String String
  | Error (Maybe String) SomeException
  deriving Int -> FailureReason -> ShowS
[FailureReason] -> ShowS
FailureReason -> String
(Int -> FailureReason -> ShowS)
-> (FailureReason -> String)
-> ([FailureReason] -> ShowS)
-> Show FailureReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FailureReason -> ShowS
showsPrec :: Int -> FailureReason -> ShowS
$cshow :: FailureReason -> String
show :: FailureReason -> String
$cshowList :: [FailureReason] -> ShowS
showList :: [FailureReason] -> ShowS
Show

data Formatter = Formatter {

  Formatter -> FormatM ()
headerFormatter :: FormatM ()

-- | evaluated before each test group
, Formatter -> [String] -> String -> FormatM ()
exampleGroupStarted :: [String] -> String -> FormatM ()

-- | evaluated after each test group
, Formatter -> FormatM ()
exampleGroupDone :: FormatM ()

-- | evaluated before each example
, Formatter -> Path -> FormatM ()
exampleStarted :: Path -> FormatM ()

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

-- | evaluated after each successful example
, Formatter -> Path -> String -> FormatM ()
exampleSucceeded :: Path -> String -> FormatM ()

-- | evaluated after each failed example
, Formatter -> Path -> String -> FailureReason -> FormatM ()
exampleFailed :: Path -> String -> FailureReason -> FormatM ()

-- | evaluated after each pending example
, Formatter -> Path -> String -> Maybe String -> FormatM ()
examplePending :: Path -> String -> Maybe String -> FormatM ()

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

-- | evaluated after `failedFormatter`
, Formatter -> FormatM ()
footerFormatter :: FormatM ()
}

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

data FormatF next =
    GetSuccessCount (Int -> next)
  | GetPendingCount (Int -> next)
  | GetFailMessages ([FailureRecord] -> next)
  | UsedSeed (Integer -> next)
  | PrintTimes (Bool -> next)
  | GetCPUTime (Maybe Seconds -> next)
  | GetRealTime (Seconds -> next)
  | Write String next
  | WriteTransient String next
  | forall a. WithFailColor (FormatM a) (a -> next)
  | forall a. WithSuccessColor (FormatM a) (a -> next)
  | forall a. WithPendingColor (FormatM a) (a -> next)
  | forall a. WithInfoColor (FormatM a) (a -> next)
  | UseDiff (Bool -> next)
  | ExtraChunk String next
  | MissingChunk String next
  | forall a. LiftIO (IO a) (a -> next)

instance Functor FormatF where -- deriving this instance would require GHC >= 7.10.1
  fmap :: forall a b. (a -> b) -> FormatF a -> FormatF b
fmap a -> b
f FormatF a
x = case FormatF a
x of
    GetSuccessCount Int -> a
next -> (Int -> b) -> FormatF b
forall next. (Int -> next) -> FormatF next
GetSuccessCount ((a -> b) -> (Int -> a) -> Int -> b
forall a b. (a -> b) -> (Int -> a) -> Int -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Int -> a
next)
    GetPendingCount Int -> a
next -> (Int -> b) -> FormatF b
forall next. (Int -> next) -> FormatF next
GetPendingCount ((a -> b) -> (Int -> a) -> Int -> b
forall a b. (a -> b) -> (Int -> a) -> Int -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Int -> a
next)
    GetFailMessages [FailureRecord] -> a
next -> ([FailureRecord] -> b) -> FormatF b
forall next. ([FailureRecord] -> next) -> FormatF next
GetFailMessages ((a -> b) -> ([FailureRecord] -> a) -> [FailureRecord] -> b
forall a b.
(a -> b) -> ([FailureRecord] -> a) -> [FailureRecord] -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [FailureRecord] -> a
next)
    UsedSeed Integer -> a
next -> (Integer -> b) -> FormatF b
forall next. (Integer -> next) -> FormatF next
UsedSeed ((a -> b) -> (Integer -> a) -> Integer -> b
forall a b. (a -> b) -> (Integer -> a) -> Integer -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Integer -> a
next)
    PrintTimes Bool -> a
next -> (Bool -> b) -> FormatF b
forall next. (Bool -> next) -> FormatF next
PrintTimes ((a -> b) -> (Bool -> a) -> Bool -> b
forall a b. (a -> b) -> (Bool -> a) -> Bool -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Bool -> a
next)
    GetCPUTime Maybe Seconds -> a
next -> (Maybe Seconds -> b) -> FormatF b
forall next. (Maybe Seconds -> next) -> FormatF next
GetCPUTime ((a -> b) -> (Maybe Seconds -> a) -> Maybe Seconds -> b
forall a b. (a -> b) -> (Maybe Seconds -> a) -> Maybe Seconds -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe Seconds -> a
next)
    GetRealTime Seconds -> a
next -> (Seconds -> b) -> FormatF b
forall next. (Seconds -> next) -> FormatF next
GetRealTime ((a -> b) -> (Seconds -> a) -> Seconds -> b
forall a b. (a -> b) -> (Seconds -> a) -> Seconds -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seconds -> a
next)
    Write String
s a
next -> String -> b -> FormatF b
forall next. String -> next -> FormatF next
Write String
s (a -> b
f a
next)
    WriteTransient String
s a
next -> String -> b -> FormatF b
forall next. String -> next -> FormatF next
WriteTransient String
s (a -> b
f a
next)
    WithFailColor FormatM a
action a -> a
next -> FormatM a -> (a -> b) -> FormatF b
forall next a. FormatM a -> (a -> next) -> FormatF next
WithFailColor FormatM a
action ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)
    WithSuccessColor FormatM a
action a -> a
next -> FormatM a -> (a -> b) -> FormatF b
forall next a. FormatM a -> (a -> next) -> FormatF next
WithSuccessColor FormatM a
action ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)
    WithPendingColor FormatM a
action a -> a
next -> FormatM a -> (a -> b) -> FormatF b
forall next a. FormatM a -> (a -> next) -> FormatF next
WithPendingColor FormatM a
action ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)
    WithInfoColor FormatM a
action a -> a
next -> FormatM a -> (a -> b) -> FormatF b
forall next a. FormatM a -> (a -> next) -> FormatF next
WithInfoColor FormatM a
action ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)
    UseDiff Bool -> a
next -> (Bool -> b) -> FormatF b
forall next. (Bool -> next) -> FormatF next
UseDiff ((a -> b) -> (Bool -> a) -> Bool -> b
forall a b. (a -> b) -> (Bool -> a) -> Bool -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Bool -> a
next)
    ExtraChunk String
s a
next -> String -> b -> FormatF b
forall next. String -> next -> FormatF next
ExtraChunk String
s (a -> b
f a
next)
    MissingChunk String
s a
next -> String -> b -> FormatF b
forall next. String -> next -> FormatF next
MissingChunk String
s (a -> b
f a
next)
    LiftIO IO a
action a -> a
next -> IO a -> (a -> b) -> FormatF b
forall next a. IO a -> (a -> next) -> FormatF next
LiftIO IO a
action ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)

type FormatM = Free FormatF

instance MonadIO FormatM where
  liftIO :: forall a. IO a -> FormatM a
liftIO IO a
s = FormatF a -> Free FormatF a
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (IO a -> (a -> a) -> FormatF a
forall next a. IO a -> (a -> next) -> FormatF next
LiftIO IO a
s a -> a
forall a. a -> a
id)

data Environment m = Environment {
  forall (m :: * -> *). Environment m -> m Int
environmentGetSuccessCount :: m Int
, forall (m :: * -> *). Environment m -> m Int
environmentGetPendingCount :: m Int
, forall (m :: * -> *). Environment m -> m [FailureRecord]
environmentGetFailMessages :: m [FailureRecord]
, forall (m :: * -> *). Environment m -> m Integer
environmentUsedSeed :: m Integer
, forall (m :: * -> *). Environment m -> m Bool
environmentPrintTimes :: m Bool
, forall (m :: * -> *). Environment m -> m (Maybe Seconds)
environmentGetCPUTime :: m (Maybe Seconds)
, forall (m :: * -> *). Environment m -> m Seconds
environmentGetRealTime :: m Seconds
, forall (m :: * -> *). Environment m -> String -> m ()
environmentWrite :: String -> m ()
, forall (m :: * -> *). Environment m -> String -> m ()
environmentWriteTransient :: String -> m ()
, forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithFailColor :: forall a. m a -> m a
, forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithSuccessColor :: forall a. m a -> m a
, forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithPendingColor :: forall a. m a -> m a
, forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithInfoColor :: forall a. m a -> m a
, forall (m :: * -> *). Environment m -> m Bool
environmentUseDiff :: m Bool
, forall (m :: * -> *). Environment m -> String -> m ()
environmentExtraChunk :: String -> m ()
, forall (m :: * -> *). Environment m -> String -> m ()
environmentMissingChunk :: String -> m ()
, forall (m :: * -> *). Environment m -> forall a. IO a -> m a
environmentLiftIO :: forall a. IO a -> m a
}

interpretWith :: forall m a. Monad m => Environment m -> FormatM a -> m a
interpretWith :: forall (m :: * -> *) a.
Monad m =>
Environment m -> FormatM a -> m a
interpretWith Environment{m Bool
m Int
m Integer
m [FailureRecord]
m (Maybe Seconds)
m Seconds
String -> m ()
forall a. m a -> m a
forall a. IO a -> m a
environmentGetSuccessCount :: forall (m :: * -> *). Environment m -> m Int
environmentGetPendingCount :: forall (m :: * -> *). Environment m -> m Int
environmentGetFailMessages :: forall (m :: * -> *). Environment m -> m [FailureRecord]
environmentUsedSeed :: forall (m :: * -> *). Environment m -> m Integer
environmentPrintTimes :: forall (m :: * -> *). Environment m -> m Bool
environmentGetCPUTime :: forall (m :: * -> *). Environment m -> m (Maybe Seconds)
environmentGetRealTime :: forall (m :: * -> *). Environment m -> m Seconds
environmentWrite :: forall (m :: * -> *). Environment m -> String -> m ()
environmentWriteTransient :: forall (m :: * -> *). Environment m -> String -> m ()
environmentWithFailColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithSuccessColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithPendingColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithInfoColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentUseDiff :: forall (m :: * -> *). Environment m -> m Bool
environmentExtraChunk :: forall (m :: * -> *). Environment m -> String -> m ()
environmentMissingChunk :: forall (m :: * -> *). Environment m -> String -> m ()
environmentLiftIO :: forall (m :: * -> *). Environment m -> forall a. IO a -> m a
environmentGetSuccessCount :: m Int
environmentGetPendingCount :: m Int
environmentGetFailMessages :: m [FailureRecord]
environmentUsedSeed :: m Integer
environmentPrintTimes :: m Bool
environmentGetCPUTime :: m (Maybe Seconds)
environmentGetRealTime :: m Seconds
environmentWrite :: String -> m ()
environmentWriteTransient :: String -> m ()
environmentWithFailColor :: forall a. m a -> m a
environmentWithSuccessColor :: forall a. m a -> m a
environmentWithPendingColor :: forall a. m a -> m a
environmentWithInfoColor :: forall a. m a -> m a
environmentUseDiff :: m Bool
environmentExtraChunk :: String -> m ()
environmentMissingChunk :: String -> m ()
environmentLiftIO :: forall a. IO a -> m a
..} = FormatM a -> m a
forall b. FormatM b -> m b
go
  where
    go :: forall b. FormatM b -> m b
    go :: forall b. FormatM b -> m b
go FormatM b
m = case FormatM b
m of
      Pure b
value -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
value
      Free FormatF (FormatM b)
action -> case FormatF (FormatM b)
action of
        GetSuccessCount Int -> FormatM b
next -> m Int
environmentGetSuccessCount m Int -> (Int -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Int -> FormatM b) -> Int -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FormatM b
next
        GetPendingCount Int -> FormatM b
next -> m Int
environmentGetPendingCount m Int -> (Int -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Int -> FormatM b) -> Int -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FormatM b
next
        GetFailMessages [FailureRecord] -> FormatM b
next -> m [FailureRecord]
environmentGetFailMessages m [FailureRecord] -> ([FailureRecord] -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b)
-> ([FailureRecord] -> FormatM b) -> [FailureRecord] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FailureRecord] -> FormatM b
next
        UsedSeed Integer -> FormatM b
next -> m Integer
environmentUsedSeed m Integer -> (Integer -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Integer -> FormatM b) -> Integer -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FormatM b
next
        PrintTimes Bool -> FormatM b
next -> m Bool
environmentPrintTimes m Bool -> (Bool -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Bool -> FormatM b) -> Bool -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FormatM b
next
        GetCPUTime Maybe Seconds -> FormatM b
next -> m (Maybe Seconds)
environmentGetCPUTime m (Maybe Seconds) -> (Maybe Seconds -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b)
-> (Maybe Seconds -> FormatM b) -> Maybe Seconds -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Seconds -> FormatM b
next
        GetRealTime Seconds -> FormatM b
next -> m Seconds
environmentGetRealTime m Seconds -> (Seconds -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Seconds -> FormatM b) -> Seconds -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> FormatM b
next
        Write String
s FormatM b
next -> String -> m ()
environmentWrite String
s m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM b -> m b
forall b. FormatM b -> m b
go FormatM b
next
        WriteTransient String
s FormatM b
next -> String -> m ()
environmentWriteTransient String
s m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM b -> m b
forall b. FormatM b -> m b
go FormatM b
next
        WithFailColor FormatM a
inner a -> FormatM b
next -> m a -> m a
forall a. m a -> m a
environmentWithFailColor (FormatM a -> m a
forall b. FormatM b -> m b
go FormatM a
inner) m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (a -> FormatM b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
        WithSuccessColor FormatM a
inner a -> FormatM b
next -> m a -> m a
forall a. m a -> m a
environmentWithSuccessColor (FormatM a -> m a
forall b. FormatM b -> m b
go FormatM a
inner) m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (a -> FormatM b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
        WithPendingColor FormatM a
inner a -> FormatM b
next -> m a -> m a
forall a. m a -> m a
environmentWithPendingColor (FormatM a -> m a
forall b. FormatM b -> m b
go FormatM a
inner) m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (a -> FormatM b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
        WithInfoColor FormatM a
inner a -> FormatM b
next -> m a -> m a
forall a. m a -> m a
environmentWithInfoColor (FormatM a -> m a
forall b. FormatM b -> m b
go FormatM a
inner) m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (a -> FormatM b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
        UseDiff Bool -> FormatM b
next -> m Bool
environmentUseDiff m Bool -> (Bool -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (Bool -> FormatM b) -> Bool -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FormatM b
next
        ExtraChunk String
s FormatM b
next -> String -> m ()
environmentExtraChunk String
s m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM b -> m b
forall b. FormatM b -> m b
go FormatM b
next
        MissingChunk String
s FormatM b
next -> String -> m ()
environmentMissingChunk String
s m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM b -> m b
forall b. FormatM b -> m b
go FormatM b
next
        LiftIO IO a
inner a -> FormatM b
next -> IO a -> m a
forall a. IO a -> m a
environmentLiftIO IO a
inner m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormatM b -> m b
forall b. FormatM b -> m b
go (FormatM b -> m b) -> (a -> FormatM b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next

-- | Get the number of successful examples encountered so far.
getSuccessCount :: FormatM Int
getSuccessCount :: FormatM Int
getSuccessCount = FormatF Int -> FormatM Int
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Int -> Int) -> FormatF Int
forall next. (Int -> next) -> FormatF next
GetSuccessCount Int -> Int
forall a. a -> a
id)

-- | Get the number of pending examples encountered so far.
getPendingCount :: FormatM Int
getPendingCount :: FormatM Int
getPendingCount = FormatF Int -> FormatM Int
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Int -> Int) -> FormatF Int
forall next. (Int -> next) -> FormatF next
GetPendingCount Int -> Int
forall a. a -> a
id)

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

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

-- | Get the list of accumulated failure messages.
getFailMessages :: FormatM [FailureRecord]
getFailMessages :: Free FormatF [FailureRecord]
getFailMessages = FormatF [FailureRecord] -> Free FormatF [FailureRecord]
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (([FailureRecord] -> [FailureRecord]) -> FormatF [FailureRecord]
forall next. ([FailureRecord] -> next) -> FormatF next
GetFailMessages [FailureRecord] -> [FailureRecord]
forall a. a -> a
id)

-- | The random seed that is used for QuickCheck.
usedSeed :: FormatM Integer
usedSeed :: FormatM Integer
usedSeed = FormatF Integer -> FormatM Integer
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Integer -> Integer) -> FormatF Integer
forall next. (Integer -> next) -> FormatF next
UsedSeed Integer -> Integer
forall a. a -> a
id)

-- | Return `True` if the user requested time reporting for individual spec
-- items, `False` otherwise.
printTimes :: FormatM Bool
printTimes :: FormatM Bool
printTimes = FormatF Bool -> FormatM Bool
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Bool -> Bool) -> FormatF Bool
forall next. (Bool -> next) -> FormatF next
PrintTimes Bool -> Bool
forall a. a -> a
id)

-- | Get the used CPU time since the test run has been started.
getCPUTime :: FormatM (Maybe Seconds)
getCPUTime :: FormatM (Maybe Seconds)
getCPUTime = FormatF (Maybe Seconds) -> FormatM (Maybe Seconds)
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Maybe Seconds -> Maybe Seconds) -> FormatF (Maybe Seconds)
forall next. (Maybe Seconds -> next) -> FormatF next
GetCPUTime Maybe Seconds -> Maybe Seconds
forall a. a -> a
id)

-- | Get the passed real time since the test run has been started.
getRealTime :: FormatM Seconds
getRealTime :: FormatM Seconds
getRealTime = FormatF Seconds -> FormatM Seconds
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Seconds -> Seconds) -> FormatF Seconds
forall next. (Seconds -> next) -> FormatF next
GetRealTime Seconds -> Seconds
forall a. a -> a
id)

-- | Append some output to the report.
write :: String -> FormatM ()
write :: String -> FormatM ()
write String
s = FormatF () -> FormatM ()
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (String -> () -> FormatF ()
forall next. String -> next -> FormatF next
Write String
s ())

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

writeTransient :: String -> FormatM ()
writeTransient :: String -> FormatM ()
writeTransient String
s = FormatF () -> FormatM ()
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (String -> () -> FormatF ()
forall next. String -> next -> FormatF next
WriteTransient String
s ())

-- | Set output color to red, run given action, and finally restore the default
-- color.
withFailColor :: FormatM a -> FormatM a
withFailColor :: forall a. FormatM a -> FormatM a
withFailColor FormatM a
s = FormatF a -> FormatM a
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (FormatM a -> (a -> a) -> FormatF a
forall next a. FormatM a -> (a -> next) -> FormatF next
WithFailColor FormatM a
s a -> a
forall a. a -> a
id)

-- | Set output color to green, run given action, and finally restore the
-- default color.
withSuccessColor :: FormatM a -> FormatM a
withSuccessColor :: forall a. FormatM a -> FormatM a
withSuccessColor FormatM a
s = FormatF a -> FormatM a
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (FormatM a -> (a -> a) -> FormatF a
forall next a. FormatM a -> (a -> next) -> FormatF next
WithSuccessColor FormatM a
s a -> a
forall a. a -> a
id)

-- | Set output color to yellow, run given action, and finally restore the
-- default color.
withPendingColor :: FormatM a -> FormatM a
withPendingColor :: forall a. FormatM a -> FormatM a
withPendingColor FormatM a
s = FormatF a -> FormatM a
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (FormatM a -> (a -> a) -> FormatF a
forall next a. FormatM a -> (a -> next) -> FormatF next
WithPendingColor FormatM a
s a -> a
forall a. a -> a
id)

-- | Set output color to cyan, run given action, and finally restore the
-- default color.
withInfoColor :: FormatM a -> FormatM a
withInfoColor :: forall a. FormatM a -> FormatM a
withInfoColor FormatM a
s = FormatF a -> FormatM a
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (FormatM a -> (a -> a) -> FormatF a
forall next a. FormatM a -> (a -> next) -> FormatF next
WithInfoColor FormatM a
s a -> a
forall a. a -> a
id)

-- | Return `True` if the user requested colorized diffs, `False` otherwise.
useDiff :: FormatM Bool
useDiff :: FormatM Bool
useDiff = FormatF Bool -> FormatM Bool
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF ((Bool -> Bool) -> FormatF Bool
forall next. (Bool -> next) -> FormatF next
UseDiff Bool -> Bool
forall a. a -> a
id)

-- | Output given chunk in red.
extraChunk :: String -> FormatM ()
extraChunk :: String -> FormatM ()
extraChunk String
s = FormatF () -> FormatM ()
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (String -> () -> FormatF ()
forall next. String -> next -> FormatF next
ExtraChunk String
s ())

-- | Output given chunk in green.
missingChunk :: String -> FormatM ()
missingChunk :: String -> FormatM ()
missingChunk String
s = FormatF () -> FormatM ()
forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (String -> () -> FormatF ()
forall next. String -> next -> FormatF next
MissingChunk String
s ())