Commit f4fed6f0 authored by Camil Staps's avatar Camil Staps 🐧

Move FailReason to EndEventType

parent 46907182
Pipeline #9531 passed with stage
in 1 minute and 58 seconds
......@@ -28,10 +28,9 @@ from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode, :: Ma
/**
* Event emitted after a test has finished.
*/
:: EndEvent = { name :: !String //* The test's name
, event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result
, failReason :: !Maybe FailReason //* The reason for failure, when `event` is `Failed`
:: EndEvent = { name :: !String //* The test's name
, event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result
}
/**
......@@ -40,10 +39,10 @@ from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode, :: Ma
* Specialised JSONEncode/JSONDecode instances are used for this type, which
* have to be adapted in case the type definition is changed!
*/
:: EndEventType = Passed //* The test passed
| Failed //* The test failed
| Skipped //* The test was not executed, but should be executed and pass for future versions
| Lost //* The test crashed
:: EndEventType = Passed //* The test passed
| Failed FailReason //* The test failed
| Skipped //* The test was not executed, but should be executed and pass for future versions
| Lost //* The test crashed
/**
* Reasons for failing a test.
......
implementation module Testing.TestEvents
import Text.JSON, Control.Monad, StdFunc, StdTuple, StdList, Data.Maybe, Control.Applicative
import Data.Functor
import Data.List
JSONEncode{|TestEvent|} c (StartEvent se) = JSONEncode{|*|} c se
JSONEncode{|TestEvent|} c (EndEvent ee) = JSONEncode{|*|} c ee
......@@ -25,29 +27,55 @@ where
(pure {StartEvent | name = name})
mzero
getField :: String -> Maybe a | JSONDecode{|*|} a
getField fieldName = case filter ((==) fieldName o fst) objFields of
[(_, jsonNode)] -> fromJSON jsonNode
_ -> mzero
getField :: String -> Maybe a | JSONDecode{|*|} a
getField field = lookup field objFields >>= fromJSON
JSONDecode{|StartEvent|} _ _ = (Nothing, [])
JSONEncode{|EndEventType|} _ eType = [JSONString eTypeStr]
JSONEncode{|EndEvent|} _ endEvent = [JSONObject
[ ("name", JSONString endEvent.EndEvent.name)
, ("message", JSONString endEvent.message)
, ("event", JSONString (typeToString endEvent.event))
: case endEvent.event of
Failed r -> [("failReason", case JSONEncode{|*|} False r of
[JSONArray r] -> JSONArray r
r -> JSONArray r)]
_ -> []
]]
where
eTypeStr = case eType of
Passed -> "passed"
Failed -> "failed"
Skipped -> "skipped"
Lost -> "lost"
typeToString :: EndEventType -> String
typeToString Passed = "passed"
typeToString (Failed r) = "failed"
typeToString Skipped = "skipped"
typeToString Lost = "lost"
JSONDecode{|EndEvent|} _ [JSONObject fields:rest] = (mbEvent, rest)
where
mbEvent :: Maybe EndEvent
mbEvent =
getField "name" >>= \name ->
getField "event" >>= \event ->
getField "message" >>= \message ->
let e = {name=name, message=message, event=Passed} in case event of
"passed" -> pure e
"failed" -> (\r -> {e & event=Failed r}) <$> getField "failReason"
"skipped" -> pure {e & event=Skipped}
"lost" -> pure {e & event=Lost}
getField :: String -> Maybe a | JSONDecode{|*|} a
getField field = lookup field fields >>= fromJSON
JSONDecode{|EndEvent|} _ _ = (Nothing, [])
JSONDecode{|EndEventType|} b [JSONString "failed" : rest] = case JSONDecode{|*|} b rest of
(Just r,rest) -> (Just (Failed r), rest)
_ -> (Nothing, rest)
JSONDecode{|EndEventType|} _ [JSONString eTypeStr : rest] = (mbEType, rest)
where
mbEType = case eTypeStr of
"passed" -> Just Passed
"failed" -> Just Failed
"skipped" -> Just Skipped
"lost" -> Just Lost
_ -> Nothing
JSONDecode{|EndEventType|} _ nodes = (Nothing, nodes)
derive JSONEncode EndEvent, FailReason
derive JSONDecode EndEvent, FailReason
derive JSONEncode FailReason
derive JSONDecode FailReason
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment