module Test.Chell.Main
( defaultMain
) where
import Control.Applicative
import Control.Monad (forM, forM_, when)
import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.Trans.Writer as Writer
import Data.Char (ord)
import Data.List (isPrefixOf)
import System.Exit (exitSuccess, exitFailure)
import System.IO (hPutStr, hPutStrLn, hIsTerminalDevice, stderr, stdout, withBinaryFile, IOMode(..))
import System.Random (randomIO)
import Text.Printf (printf)
import Options
import Test.Chell.Output
import Test.Chell.Types
data MainOptions =
MainOptions
{ MainOptions -> Bool
optVerbose :: Bool
, MainOptions -> String
optXmlReport :: String
, MainOptions -> String
optJsonReport :: String
, MainOptions -> String
optTextReport :: String
, MainOptions -> Maybe Int
optSeed :: Maybe Int
, MainOptions -> Maybe Int
optTimeout :: Maybe Int
, MainOptions -> ColorMode
optColor :: ColorMode
}
optionType_ColorMode :: OptionType ColorMode
optionType_ColorMode :: OptionType ColorMode
optionType_ColorMode = String
-> ColorMode
-> (String -> Either String ColorMode)
-> (ColorMode -> String)
-> OptionType ColorMode
forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType "ColorMode" ColorMode
ColorModeAuto String -> Either String ColorMode
parseMode ColorMode -> String
showMode
where
parseMode :: String -> Either String ColorMode
parseMode s :: String
s =
case String
s of
"always" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAlways
"never" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeNever
"auto" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAuto
_ -> String -> Either String ColorMode
forall a b. a -> Either a b
Left (String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not in {\"always\", \"never\", \"auto\"}.")
showMode :: ColorMode -> String
showMode mode :: ColorMode
mode =
case ColorMode
mode of
ColorModeAlways -> "always"
ColorModeNever -> "never"
ColorModeAuto -> "auto"
instance Options MainOptions
where
defineOptions :: DefineOptions MainOptions
defineOptions = (Bool
-> String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions)
-> DefineOptions
(Bool
-> String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
-> String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions
MainOptions
DefineOptions
(Bool
-> String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions)
-> DefineOptions Bool
-> DefineOptions
(String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OptionType Bool
-> (Option Bool -> Option Bool) -> DefineOptions Bool
forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption OptionType Bool
optionType_bool
(\o :: Option Bool
o -> Option Bool
o
{ optionShortFlags :: String
optionShortFlags = ['v']
, optionLongFlags :: [String]
optionLongFlags = ["verbose"]
, optionDefault :: Bool
optionDefault = Bool
False
, optionDescription :: String
optionDescription = "Print more output."
}
)
DefineOptions
(String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions)
-> DefineOptions String
-> DefineOptions
(String
-> String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption "xml-report" ""
"Write a parsable report to a given path, in XML."
DefineOptions
(String
-> String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions String
-> DefineOptions
(String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption "json-report" ""
"Write a parsable report to a given path, in JSON."
DefineOptions
(String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions String
-> DefineOptions
(Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption "text-report" ""
"Write a human-readable report to a given path."
DefineOptions (Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions (Maybe Int)
-> DefineOptions (Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int -> String -> DefineOptions (Maybe Int)
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption "seed" Maybe Int
forall a. Maybe a
Nothing
"The seed used for random numbers in (for example) quickcheck."
DefineOptions (Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions (Maybe Int)
-> DefineOptions (ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int -> String -> DefineOptions (Maybe Int)
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption "timeout" Maybe Int
forall a. Maybe a
Nothing
"The maximum duration of a test, in milliseconds."
DefineOptions (ColorMode -> MainOptions)
-> DefineOptions ColorMode -> DefineOptions MainOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OptionType ColorMode
-> (Option ColorMode -> Option ColorMode)
-> DefineOptions ColorMode
forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption OptionType ColorMode
optionType_ColorMode
(\o :: Option ColorMode
o -> Option ColorMode
o
{ optionLongFlags :: [String]
optionLongFlags = ["color"]
, optionDefault :: ColorMode
optionDefault = ColorMode
ColorModeAuto
, optionDescription :: String
optionDescription = "Whether to enable color ('always', 'auto', or 'never')."
}
)
defaultMain :: [Suite] -> IO ()
defaultMain :: [Suite] -> IO ()
defaultMain suites :: [Suite]
suites = (MainOptions -> [String] -> IO ()) -> IO ()
forall (m :: * -> *) opts a.
(MonadIO m, Options opts) =>
(opts -> [String] -> m a) -> m a
runCommand ((MainOptions -> [String] -> IO ()) -> IO ())
-> (MainOptions -> [String] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \opts :: MainOptions
opts args :: [String]
args ->
do
Int
seed <-
case MainOptions -> Maybe Int
optSeed MainOptions
opts of
Just s :: Int
s -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
Nothing -> IO Int
forall a. Random a => IO a
randomIO
Maybe Int
timeout <-
case MainOptions -> Maybe Int
optTimeout MainOptions
opts of
Nothing -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
Just t :: Int
t -> if Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 1000 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
then
do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "Test.Chell.defaultMain: Ignoring --timeout because it is too large."
Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
else
Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
t)
let
testOptions :: TestOptions
testOptions = TestOptions
defaultTestOptions
{ testOptionSeed :: Int
testOptionSeed = Int
seed
, testOptionTimeout :: Maybe Int
testOptionTimeout = Maybe Int
timeout
}
let
allTests :: [Test]
allTests = (Suite -> [Test]) -> [Suite] -> [Test]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Suite -> [Test]
suiteTests [Suite]
suites
tests :: [Test]
tests =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args
then [Test]
allTests
else (Test -> Bool) -> [Test] -> [Test]
forall a. (a -> Bool) -> [a] -> [a]
filter ([String] -> Test -> Bool
matchesFilter [String]
args) [Test]
allTests
Output
output <-
case MainOptions -> ColorMode
optColor MainOptions
opts of
ColorModeNever -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
plainOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
ColorModeAlways -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
colorOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
ColorModeAuto ->
do
Bool
isTerm <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> IO Output) -> Output -> IO Output
forall a b. (a -> b) -> a -> b
$
if Bool
isTerm
then Bool -> Output
colorOutput (MainOptions -> Bool
optVerbose MainOptions
opts)
else Bool -> Output
plainOutput (MainOptions -> Bool
optVerbose MainOptions
opts)
[(Test, TestResult)]
results <- [Test]
-> (Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Test]
tests ((Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)])
-> (Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)]
forall a b. (a -> b) -> a -> b
$ \t :: Test
t ->
do
Output -> Test -> IO ()
outputStart Output
output Test
t
TestResult
result <- Test -> TestOptions -> IO TestResult
runTest Test
t TestOptions
testOptions
Output -> Test -> TestResult -> IO ()
outputResult Output
output Test
t TestResult
result
(Test, TestResult) -> IO (Test, TestResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Test
t, TestResult
result)
let
reports :: [(String, String, Report)]
reports = MainOptions -> [(String, String, Report)]
getReports MainOptions
opts
[(String, String, Report)]
-> ((String, String, Report) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String, Report)]
reports (((String, String, Report) -> IO ()) -> IO ())
-> ((String, String, Report) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(path :: String
path, fmt :: String
fmt, toText :: Report
toText) ->
String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h ->
do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainOptions -> Bool
optVerbose MainOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn ("Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fmt String -> String -> String
forall a. [a] -> [a] -> [a]
++ " report to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
path)
Handle -> String -> IO ()
hPutStr Handle
h (Report
toText [(Test, TestResult)]
results)
let
stats :: (Integer, Integer, Integer, Integer)
stats = [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics [(Test, TestResult)]
results
(_, _, failed :: Integer
failed, aborted :: Integer
aborted) = (Integer, Integer, Integer, Integer)
stats
String -> IO ()
putStrLn ((Integer, Integer, Integer, Integer) -> String
formatResultStatistics (Integer, Integer, Integer, Integer)
stats)
if Integer
failed Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Integer
aborted Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then IO ()
forall a. IO a
exitSuccess
else IO ()
forall a. IO a
exitFailure
matchesFilter :: [String] -> Test -> Bool
matchesFilter :: [String] -> Test -> Bool
matchesFilter filters :: [String]
filters = Test -> Bool
check
where
check :: Test -> Bool
check t :: Test
t = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
matchName (Test -> String
testName Test
t)) [String]
filters
matchName :: String -> String -> Bool
matchName name :: String
name f :: String
f = String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".") String
name
type Report = [(Test, TestResult)] -> String
getReports :: MainOptions -> [(String, String, Report)]
getReports :: MainOptions -> [(String, String, Report)]
getReports opts :: MainOptions
opts = [[(String, String, Report)]] -> [(String, String, Report)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String, Report)]
xml, [(String, String, Report)]
json, [(String, String, Report)]
text]
where
xml :: [(String, String, Report)]
xml = case MainOptions -> String
optXmlReport MainOptions
opts of
"" -> []
path :: String
path -> [(String
path, "XML", Report
xmlReport)]
json :: [(String, String, Report)]
json = case MainOptions -> String
optJsonReport MainOptions
opts of
"" -> []
path :: String
path -> [(String
path, "JSON", Report
jsonReport)]
text :: [(String, String, Report)]
text = case MainOptions -> String
optTextReport MainOptions
opts of
"" -> []
path :: String
path -> [(String
path, "text", Report
textReport)]
jsonReport :: [(Test, TestResult)] -> String
jsonReport :: Report
jsonReport results :: [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
where
tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
writer :: Writer String ()
writer =
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"test-runs\": ["
[(Test, TestResult)]
-> ((Test, TestResult) -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas [(Test, TestResult)]
results (Test, TestResult) -> Writer String ()
tellResult
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "]}"
tellResult :: (Test, TestResult) -> Writer String ()
tellResult (t :: Test
t, result :: TestResult
result) =
case TestResult
result of
TestPassed notes :: [(String, String)]
notes ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"test\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"result\": \"passed\""
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
TestSkipped ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"test\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"result\": \"skipped\"}"
TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"test\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"result\": \"failed\", \"failures\": ["
[Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \f :: Failure
f ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"message\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Failure -> String
failureMessage Failure
f))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\""
case Failure -> Maybe Location
failureLocation Failure
f of
Just loc :: Location
loc ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ", \"location\": {\"module\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Location -> String
locationModule Location
loc))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"file\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Location -> String
locationFile Location
loc))
case Location -> Maybe Integer
locationLine Location
loc of
Just line :: Integer
line ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"line\": "
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "]"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"test\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"result\": \"aborted\", \"abortion\": {\"message\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
msg)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\"}"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
escapeJSON :: String -> String
escapeJSON =
(Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\c :: Char
c ->
case Char
c of
'"' -> "\\\""
'\\' -> "\\\\"
_ | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x1F -> String -> Int -> String
forall r. PrintfType r => String -> r
printf "\\u%04X" (Char -> Int
ord Char
c)
_ -> [Char
c]
)
tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: t (String, String)
notes =
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ", \"notes\": ["
t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(key :: String
key, value :: String
value) ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"key\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
key)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"value\": \""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
value)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\"}"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "]"
commas :: t t -> (t -> WriterT String m b) -> WriterT String m ()
commas xs :: t t
xs block :: t -> WriterT String m b
block = StateT Bool (WriterT String m) () -> Bool -> WriterT String m ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
forall (t :: * -> *) (m :: * -> *) t b.
(Foldable t, Monad m) =>
t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
commaState t t
xs t -> WriterT String m b
block) Bool
False
commaState :: t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
commaState xs :: t t
xs block :: t -> WriterT String m b
block = t t
-> (t -> StateT Bool (WriterT String m) b)
-> StateT Bool (WriterT String m) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t t
xs ((t -> StateT Bool (WriterT String m) b)
-> StateT Bool (WriterT String m) ())
-> (t -> StateT Bool (WriterT String m) b)
-> StateT Bool (WriterT String m) ()
forall a b. (a -> b) -> a -> b
$ \x :: t
x ->
do
let
tell' :: String -> StateT Bool (WriterT String m) ()
tell' = WriterT String m () -> StateT Bool (WriterT String m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT String m () -> StateT Bool (WriterT String m) ())
-> (String -> WriterT String m ())
-> String
-> StateT Bool (WriterT String m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WriterT String m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
Bool
needComma <- StateT Bool (WriterT String m) Bool
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
if Bool
needComma
then String -> StateT Bool (WriterT String m) ()
tell' "\n, "
else String -> StateT Bool (WriterT String m) ()
tell' "\n "
Bool -> StateT Bool (WriterT String m) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put Bool
True
WriterT String m b -> StateT Bool (WriterT String m) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t -> WriterT String m b
block t
x)
xmlReport :: [(Test, TestResult)] -> String
xmlReport :: Report
xmlReport results :: [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
where
tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
writer :: Writer String ()
writer =
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "<?xml version=\"1.0\" encoding=\"utf8\"?>\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "<report xmlns='urn:john-millikin:chell:report:1'>\n"
((Test, TestResult) -> Writer String ())
-> [(Test, TestResult)] -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Test, TestResult) -> Writer String ()
tellResult [(Test, TestResult)]
results
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "</report>"
tellResult :: (Test, TestResult) -> Writer String ()
tellResult (t :: Test
t, result :: TestResult
result) =
case TestResult
result of
TestPassed notes :: [(String, String)]
notes ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t<test-run test='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' result='passed'>\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t</test-run>\n"
TestSkipped ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t<test-run test='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' result='skipped'/>\n"
TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t<test-run test='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' result='failed'>\n"
[Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \f :: Failure
f ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t<failure message='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Failure -> String
failureMessage Failure
f))
case Failure -> Maybe Location
failureLocation Failure
f of
Just loc :: Location
loc ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'>\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t\t<location module='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Location -> String
locationModule Location
loc))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' file='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Location -> String
locationFile Location
loc))
case Location -> Maybe Integer
locationLine Location
loc of
Just line :: Integer
line ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' line='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'/>\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t</failure>\n"
Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'/>\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t</test-run>\n"
TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t<test-run test='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' result='aborted'>\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t<abortion message='"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
msg)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'/>\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t</test-run>\n"
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
escapeXML :: String -> String
escapeXML =
(Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\c :: Char
c ->
case Char
c of
'&' -> "&"
'<' -> "<"
'>' -> ">"
'"' -> """
'\'' -> "'"
_ -> [Char
c]
)
tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: t (String, String)
notes = t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(key :: String
key, value :: String
value) ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t<note key=\""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
key)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\" value=\""
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
value)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\"/>\n"
textReport :: [(Test, TestResult)] -> String
textReport :: Report
textReport results :: [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
where
tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
writer :: Writer String ()
writer =
do
[(Test, TestResult)]
-> ((Test, TestResult) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Test, TestResult)]
results (Test, TestResult) -> Writer String ()
tellResult
let stats :: (Integer, Integer, Integer, Integer)
stats = [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics [(Test, TestResult)]
results
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ((Integer, Integer, Integer, Integer) -> String
formatResultStatistics (Integer, Integer, Integer, Integer)
stats)
tellResult :: (Test, TestResult) -> Writer String ()
tellResult (t :: Test
t, result :: TestResult
result) =
case TestResult
result of
TestPassed notes :: [(String, String)]
notes ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "PASSED: "
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n\n"
TestSkipped ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "SKIPPED: "
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n\n"
TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "FAILED: "
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '-')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
[Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \f :: Failure
f ->
do
case Failure -> Maybe Location
failureLocation Failure
f of
Just loc :: Location
loc ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Location -> String
locationFile Location
loc)
case Location -> Maybe Integer
locationLine Location
loc of
Just line :: Integer
line ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ":"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Failure -> String
failureMessage Failure
f)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n\n"
TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "ABORTED: "
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
[(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '-')
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
msg
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n\n"
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: t (String, String)
notes = t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(key :: String
key, value :: String
value) ->
do
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
key
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "="
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
value
String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics stats :: (Integer, Integer, Integer, Integer)
stats = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer where
writer :: Writer String ()
writer =
do
let
(passed :: Integer
passed, skipped :: Integer
skipped, failed :: Integer
failed, aborted :: Integer
aborted) = (Integer, Integer, Integer, Integer)
stats
if Integer
failed Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Integer
aborted Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then String -> Writer String ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell "PASS: "
else String -> Writer String ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell "FAIL: "
let
putNum :: String -> a -> String -> WriterT String m ()
putNum comma :: String
comma n :: a
n what :: String
what = String -> WriterT String m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell (String -> WriterT String m ()) -> String -> WriterT String m ()
forall a b. (a -> b) -> a -> b
$
if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then String
comma String -> String -> String
forall a. [a] -> [a] -> [a]
++ "1 test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what
else String
comma String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " tests " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what
let
total :: Integer
total = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer
passed, Integer
skipped, Integer
failed, Integer
aborted]
String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum "" Integer
total "run"
(String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
passed "passed")
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
skipped Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
skipped "skipped")
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
failed Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
failed "failed")
Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
aborted Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
aborted "aborted")
resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics results :: [(Test, TestResult)]
results = State (Integer, Integer, Integer, Integer) ()
-> (Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer)
forall s a. State s a -> s -> s
State.execState State (Integer, Integer, Integer, Integer) ()
state (0, 0, 0, 0)
where
state :: State (Integer, Integer, Integer, Integer) ()
state = [(Test, TestResult)]
-> ((Test, TestResult)
-> State (Integer, Integer, Integer, Integer) ())
-> State (Integer, Integer, Integer, Integer) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Test, TestResult)]
results (((Test, TestResult)
-> State (Integer, Integer, Integer, Integer) ())
-> State (Integer, Integer, Integer, Integer) ())
-> ((Test, TestResult)
-> State (Integer, Integer, Integer, Integer) ())
-> State (Integer, Integer, Integer, Integer) ()
forall a b. (a -> b) -> a -> b
$ \(_, result :: TestResult
result) -> case TestResult
result of
TestPassed{} -> ((Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1, Integer
s, Integer
f, Integer
a))
TestSkipped{} -> ((Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
sInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1, Integer
f, Integer
a))
TestFailed{} -> ((Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
s, Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1, Integer
a))
TestAborted{} -> ((Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
s, Integer
f, Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1))
_ -> () -> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()