{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureReason] -> ShowS
$cshowList :: [FailureReason] -> ShowS
show :: FailureReason -> String
$cshow :: FailureReason -> String
showsPrec :: Int -> FailureReason -> ShowS
$cshowsPrec :: Int -> FailureReason -> ShowS
Show
data Formatter = Formatter {
:: FormatM ()
, Formatter -> [String] -> String -> FormatM ()
exampleGroupStarted :: [String] -> String -> FormatM ()
, Formatter -> FormatM ()
exampleGroupDone :: FormatM ()
, Formatter -> Path -> FormatM ()
exampleStarted :: Path -> FormatM ()
, Formatter -> Path -> Progress -> FormatM ()
exampleProgress :: Path -> Progress -> FormatM ()
, Formatter -> Path -> String -> FormatM ()
exampleSucceeded :: Path -> String -> FormatM ()
, Formatter -> Path -> String -> FailureReason -> FormatM ()
exampleFailed :: Path -> String -> FailureReason -> FormatM ()
, Formatter -> Path -> String -> Maybe String -> FormatM ()
examplePending :: Path -> String -> Maybe String -> FormatM ()
, Formatter -> FormatM ()
failedFormatter :: FormatM ()
, :: 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)
| String next
| MissingChunk String next
| forall a. LiftIO (IO a) (a -> next)
instance Functor FormatF where
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 -> forall next. (Int -> next) -> FormatF next
GetSuccessCount (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Int -> a
next)
GetPendingCount Int -> a
next -> forall next. (Int -> next) -> FormatF next
GetPendingCount (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Int -> a
next)
GetFailMessages [FailureRecord] -> a
next -> forall next. ([FailureRecord] -> next) -> FormatF next
GetFailMessages (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [FailureRecord] -> a
next)
UsedSeed Integer -> a
next -> forall next. (Integer -> next) -> FormatF next
UsedSeed (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Integer -> a
next)
PrintTimes Bool -> a
next -> forall next. (Bool -> next) -> FormatF next
PrintTimes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Bool -> a
next)
GetCPUTime Maybe Seconds -> a
next -> forall next. (Maybe Seconds -> next) -> FormatF next
GetCPUTime (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe Seconds -> a
next)
GetRealTime Seconds -> a
next -> forall next. (Seconds -> next) -> FormatF next
GetRealTime (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seconds -> a
next)
Write String
s a
next -> forall next. String -> next -> FormatF next
Write String
s (a -> b
f a
next)
WriteTransient String
s a
next -> forall next. String -> next -> FormatF next
WriteTransient String
s (a -> b
f a
next)
WithFailColor FormatM a
action a -> a
next -> forall next a. FormatM a -> (a -> next) -> FormatF next
WithFailColor FormatM a
action (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 -> forall next a. FormatM a -> (a -> next) -> FormatF next
WithSuccessColor FormatM a
action (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 -> forall next a. FormatM a -> (a -> next) -> FormatF next
WithPendingColor FormatM a
action (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 -> forall next a. FormatM a -> (a -> next) -> FormatF next
WithInfoColor FormatM a
action (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
next)
UseDiff Bool -> a
next -> forall next. (Bool -> next) -> FormatF next
UseDiff (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Bool -> a
next)
ExtraChunk String
s a
next -> forall next. String -> next -> FormatF next
ExtraChunk String
s (a -> b
f a
next)
MissingChunk String
s a
next -> forall next. String -> next -> FormatF next
MissingChunk String
s (a -> b
f a
next)
LiftIO IO a
action a -> a
next -> forall next a. IO a -> (a -> next) -> FormatF next
LiftIO IO a
action (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 = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next a. IO a -> (a -> next) -> FormatF next
LiftIO IO a
s 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
, :: 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
environmentLiftIO :: forall a. IO a -> m a
environmentMissingChunk :: String -> m ()
environmentExtraChunk :: String -> m ()
environmentUseDiff :: m Bool
environmentWithInfoColor :: forall a. m a -> m a
environmentWithPendingColor :: forall a. m a -> m a
environmentWithSuccessColor :: forall a. m a -> m a
environmentWithFailColor :: forall a. m a -> m a
environmentWriteTransient :: String -> m ()
environmentWrite :: String -> m ()
environmentGetRealTime :: m Seconds
environmentGetCPUTime :: m (Maybe Seconds)
environmentPrintTimes :: m Bool
environmentUsedSeed :: m Integer
environmentGetFailMessages :: m [FailureRecord]
environmentGetPendingCount :: m Int
environmentGetSuccessCount :: m Int
environmentLiftIO :: forall (m :: * -> *). Environment m -> forall a. IO a -> m a
environmentMissingChunk :: forall (m :: * -> *). Environment m -> String -> m ()
environmentExtraChunk :: forall (m :: * -> *). Environment m -> String -> m ()
environmentUseDiff :: forall (m :: * -> *). Environment m -> m Bool
environmentWithInfoColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithPendingColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithSuccessColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWithFailColor :: forall (m :: * -> *). Environment m -> forall a. m a -> m a
environmentWriteTransient :: forall (m :: * -> *). Environment m -> String -> m ()
environmentWrite :: forall (m :: * -> *). Environment m -> String -> m ()
environmentGetRealTime :: forall (m :: * -> *). Environment m -> m Seconds
environmentGetCPUTime :: forall (m :: * -> *). Environment m -> m (Maybe Seconds)
environmentPrintTimes :: forall (m :: * -> *). Environment m -> m Bool
environmentUsedSeed :: forall (m :: * -> *). Environment m -> m Integer
environmentGetFailMessages :: forall (m :: * -> *). Environment m -> m [FailureRecord]
environmentGetPendingCount :: forall (m :: * -> *). Environment m -> m Int
environmentGetSuccessCount :: forall (m :: * -> *). Environment m -> m Int
..} = 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 -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FormatM b
next
GetPendingCount Int -> FormatM b
next -> m Int
environmentGetPendingCount forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FormatM b
next
GetFailMessages [FailureRecord] -> FormatM b
next -> m [FailureRecord]
environmentGetFailMessages forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FailureRecord] -> FormatM b
next
UsedSeed Integer -> FormatM b
next -> m Integer
environmentUsedSeed forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FormatM b
next
PrintTimes Bool -> FormatM b
next -> m Bool
environmentPrintTimes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FormatM b
next
GetCPUTime Maybe Seconds -> FormatM b
next -> m (Maybe Seconds)
environmentGetCPUTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Seconds -> FormatM b
next
GetRealTime Seconds -> FormatM b
next -> m Seconds
environmentGetRealTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. FormatM b -> m b
go FormatM b
next
WriteTransient String
s FormatM b
next -> String -> m ()
environmentWriteTransient String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. FormatM b -> m b
go FormatM b
next
WithFailColor FormatM a
inner a -> FormatM b
next -> forall a. m a -> m a
environmentWithFailColor (forall b. FormatM b -> m b
go FormatM a
inner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
WithSuccessColor FormatM a
inner a -> FormatM b
next -> forall a. m a -> m a
environmentWithSuccessColor (forall b. FormatM b -> m b
go FormatM a
inner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
WithPendingColor FormatM a
inner a -> FormatM b
next -> forall a. m a -> m a
environmentWithPendingColor (forall b. FormatM b -> m b
go FormatM a
inner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
WithInfoColor FormatM a
inner a -> FormatM b
next -> forall a. m a -> m a
environmentWithInfoColor (forall b. FormatM b -> m b
go FormatM a
inner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
UseDiff Bool -> FormatM b
next -> m Bool
environmentUseDiff forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. FormatM b -> m b
go FormatM b
next
MissingChunk String
s FormatM b
next -> String -> m ()
environmentMissingChunk String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. FormatM b -> m b
go FormatM b
next
LiftIO IO a
inner a -> FormatM b
next -> forall a. IO a -> m a
environmentLiftIO IO a
inner forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. FormatM b -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FormatM b
next
getSuccessCount :: FormatM Int
getSuccessCount :: FormatM Int
getSuccessCount = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Int -> next) -> FormatF next
GetSuccessCount forall a. a -> a
id)
getPendingCount :: FormatM Int
getPendingCount :: FormatM Int
getPendingCount = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Int -> next) -> FormatF next
GetPendingCount forall a. a -> a
id)
getFailCount :: FormatM Int
getFailCount :: FormatM Int
getFailCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM [FailureRecord]
getFailMessages
getTotalCount :: FormatM Int
getTotalCount :: FormatM Int
getTotalCount = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [FormatM Int
getSuccessCount, FormatM Int
getFailCount, FormatM Int
getPendingCount]
getFailMessages :: FormatM [FailureRecord]
getFailMessages :: FormatM [FailureRecord]
getFailMessages = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. ([FailureRecord] -> next) -> FormatF next
GetFailMessages forall a. a -> a
id)
usedSeed :: FormatM Integer
usedSeed :: FormatM Integer
usedSeed = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Integer -> next) -> FormatF next
UsedSeed forall a. a -> a
id)
printTimes :: FormatM Bool
printTimes :: FormatM Bool
printTimes = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Bool -> next) -> FormatF next
PrintTimes forall a. a -> a
id)
getCPUTime :: FormatM (Maybe Seconds)
getCPUTime :: FormatM (Maybe Seconds)
getCPUTime = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Maybe Seconds -> next) -> FormatF next
GetCPUTime forall a. a -> a
id)
getRealTime :: FormatM Seconds
getRealTime :: FormatM Seconds
getRealTime = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Seconds -> next) -> FormatF next
GetRealTime forall a. a -> a
id)
write :: String -> FormatM ()
write :: String -> FormatM ()
write String
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. String -> next -> FormatF next
Write String
s ())
writeLine :: String -> FormatM ()
writeLine :: String -> FormatM ()
writeLine String
s = String -> FormatM ()
write String
s 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 = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. String -> next -> FormatF next
WriteTransient String
s ())
withFailColor :: FormatM a -> FormatM a
withFailColor :: forall a. FormatM a -> FormatM a
withFailColor FormatM a
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next a. FormatM a -> (a -> next) -> FormatF next
WithFailColor FormatM a
s forall a. a -> a
id)
withSuccessColor :: FormatM a -> FormatM a
withSuccessColor :: forall a. FormatM a -> FormatM a
withSuccessColor FormatM a
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next a. FormatM a -> (a -> next) -> FormatF next
WithSuccessColor FormatM a
s forall a. a -> a
id)
withPendingColor :: FormatM a -> FormatM a
withPendingColor :: forall a. FormatM a -> FormatM a
withPendingColor FormatM a
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next a. FormatM a -> (a -> next) -> FormatF next
WithPendingColor FormatM a
s forall a. a -> a
id)
withInfoColor :: FormatM a -> FormatM a
withInfoColor :: forall a. FormatM a -> FormatM a
withInfoColor FormatM a
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next a. FormatM a -> (a -> next) -> FormatF next
WithInfoColor FormatM a
s forall a. a -> a
id)
useDiff :: FormatM Bool
useDiff :: FormatM Bool
useDiff = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. (Bool -> next) -> FormatF next
UseDiff forall a. a -> a
id)
extraChunk :: String -> FormatM ()
String
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. String -> next -> FormatF next
ExtraChunk String
s ())
missingChunk :: String -> FormatM ()
missingChunk :: String -> FormatM ()
missingChunk String
s = forall (f :: * -> *) a. Functor f => f a -> Free f a
liftF (forall next. String -> next -> FormatF next
MissingChunk String
s ())