module Test.Hspec.Formatters.Internal (
Formatter (..)
, FormatM
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount
, getFailMessages
, getCPUTime
, getRealTime
, write
, writeLine
, withSuccessColor
, withPendingColor
, withFailColor
, runFormatM
, liftIO
, increaseSuccessCount
, increasePendingCount
, increaseFailCount
, addFailMessage
) where
import qualified System.IO as IO
import System.IO (Handle)
import Control.Monad (when)
import Control.Exception (bracket_)
import System.Console.ANSI
import Control.Monad.Trans.State hiding (gets, modify)
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.IO.Class as IOClass
import qualified System.CPUTime as CPUTime
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
gets :: (FormatterState -> a) -> FormatM a
gets f = FormatM (State.gets f)
modify :: (FormatterState -> FormatterState) -> FormatM ()
modify f = FormatM (State.modify f)
liftIO :: IO a -> FormatM a
liftIO action = FormatM (IOClass.liftIO action)
data FormatterState = FormatterState {
stateHandle :: Handle
, stateUseColor :: Bool
, successCount :: Int
, pendingCount :: Int
, failCount :: Int
, failMessages :: [String]
, cpuStartTime :: Integer
, startTime :: POSIXTime
}
totalCount :: FormatterState -> Int
totalCount s = successCount s + pendingCount s + failCount s
newtype FormatM a = FormatM (StateT FormatterState IO a)
deriving (Functor, Monad)
runFormatM :: Bool -> Handle -> FormatM a -> IO a
runFormatM useColor handle (FormatM action) = do
time <- getPOSIXTime
cpuTime <- CPUTime.getCPUTime
evalStateT action (FormatterState handle useColor 0 0 0 [] cpuTime time)
increaseSuccessCount :: FormatM ()
increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s}
increasePendingCount :: FormatM ()
increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s}
increaseFailCount :: FormatM ()
increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s}
getSuccessCount :: FormatM Int
getSuccessCount = gets successCount
getPendingCount :: FormatM Int
getPendingCount = gets pendingCount
getFailCount :: FormatM Int
getFailCount = gets failCount
getTotalCount :: FormatM Int
getTotalCount = gets totalCount
addFailMessage :: String -> FormatM ()
addFailMessage err = modify $ \s -> s {failMessages = err : failMessages s}
getFailMessages :: FormatM [String]
getFailMessages = reverse `fmap` gets failMessages
data Formatter = Formatter {
formatterName :: String
, exampleGroupStarted :: Int -> String -> FormatM ()
, exampleSucceeded :: Int -> String -> FormatM ()
, exampleFailed :: Int -> String -> String -> FormatM ()
, examplePending :: Int -> String -> String -> FormatM ()
, failedFormatter :: FormatM ()
, footerFormatter :: FormatM ()
}
write :: String -> FormatM ()
write s = do
h <- gets stateHandle
liftIO $ IO.hPutStr h s
writeLine :: String -> FormatM ()
writeLine s = do
h <- gets stateHandle
liftIO $ IO.hPutStrLn h s
withFailColor :: FormatM a -> FormatM a
withFailColor = withColor (SetColor Foreground Dull Red)
withSuccessColor :: FormatM a -> FormatM a
withSuccessColor = withColor (SetColor Foreground Dull Green)
withPendingColor :: FormatM a -> FormatM a
withPendingColor = withColor (SetColor Foreground Dull Yellow)
withColor :: SGR -> FormatM a -> FormatM a
withColor color (FormatM action) = FormatM . StateT $ \st -> do
let useColor = stateUseColor st
h = stateHandle st
bracket_
(when useColor $ hSetSGR h [color])
(when useColor $ hSetSGR h [Reset])
(runStateT action st)
getCPUTime :: FormatM Double
getCPUTime = do
t1 <- liftIO CPUTime.getCPUTime
t0 <- gets cpuStartTime
return ((fromIntegral $ t1 t0) / (10.0^(12::Integer)))
getRealTime :: FormatM Double
getRealTime = do
t1 <- liftIO getPOSIXTime
t0 <- gets startTime
return (realToFrac $ t1 t0)