Verified Commit 10c417b3 authored by Camil Staps's avatar Camil Staps 🚀

Testing.TestEvents: change module_name to more easily extensible TestLocation

parent 60386dc5
Pipeline #27900 failed with stage
in 2 minutes and 15 seconds
...@@ -19,21 +19,29 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode, :: ...@@ -19,21 +19,29 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode, ::
= StartEvent StartEvent //* A test has started = StartEvent StartEvent //* A test has started
| EndEvent EndEvent //* A test has finished | EndEvent EndEvent //* A test has finished
/**
* The location of a test in a source file.
* This is not complete; more fields can be added as necessary.
*/
:: TestLocation =
{ moduleName :: !Maybe String //* The module the test is defined in
}
/** /**
* Event emitted when a test is started. * Event emitted when a test is started.
* Specialised JSONEncode/JSONDecode instances are used for this type, which * Specialised JSONEncode/JSONDecode instances are used for this type, which
* have to be adapted in case the type definition is changed! * have to be adapted in case the type definition is changed!
*/ */
:: StartEvent = { name :: !String //* The test's name :: StartEvent = { name :: !String //* The test's name
, module_name :: !Maybe String //* The module to which the test belongs , location :: !Maybe TestLocation //* The test's location
} }
/** /**
* Event emitted after a test has finished. * Event emitted after a test has finished.
*/ */
:: EndEvent = { name :: !String //* The test's name :: EndEvent = { name :: !String //* The test's name
, module_name :: !Maybe String //* The module to which the test belongs , location :: !Maybe TestLocation //* The test's location
, event :: !EndEventType //* The event's type, indicating success , event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result , message :: !String //* Message providing an explanation for the result
} }
/** /**
......
implementation module Testing.TestEvents implementation module Testing.TestEvents
import Text.GenJSON, Control.Monad, StdFunctions, StdTuple, StdList, Data.Maybe, Control.Applicative, Data.Func import StdEnv
import Text.GenJSON, Control.Monad, Data.Maybe, Control.Applicative, Data.Func
import Data.Functor import Data.Functor
import Data.List import Data.List
...@@ -16,9 +17,11 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of ...@@ -16,9 +17,11 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of
JSONEncode{|StartEvent|} _ startEvent = [ JSONObject JSONEncode{|StartEvent|} _ startEvent = [ JSONObject
[ ("name", JSONString startEvent.StartEvent.name) [ ("name", JSONString startEvent.StartEvent.name)
, ("event", JSONString "start") , ("event", JSONString "start")
: case startEvent.StartEvent.module_name of : case startEvent.StartEvent.location of
Nothing -> [] Nothing -> []
Just m -> [("module",JSONString m)] Just l -> case JSONEncode{|*|} True l of
[json] -> [("location",json)]
_ -> abort "error in JSONEncode_StartEvent\n"
]] ]]
JSONDecode{|StartEvent|} _ [JSONObject objFields : rest] = (mbEvent, rest) JSONDecode{|StartEvent|} _ [JSONObject objFields : rest] = (mbEvent, rest)
...@@ -27,7 +30,7 @@ where ...@@ -27,7 +30,7 @@ where
mbEvent = getField "name" >>= \name -> mbEvent = getField "name" >>= \name ->
getField "event" >>= \event -> getField "event" >>= \event ->
if (event == "start") if (event == "start")
(pure {StartEvent | name = name, module_name = getField "module"}) (pure {StartEvent | name = name, location = getField "location"})
mzero mzero
getField :: String -> Maybe a | JSONDecode{|*|} a getField :: String -> Maybe a | JSONDecode{|*|} a
...@@ -38,9 +41,11 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject ...@@ -38,9 +41,11 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject
[ ("name", JSONString endEvent.EndEvent.name) [ ("name", JSONString endEvent.EndEvent.name)
, ("message", JSONString endEvent.message) , ("message", JSONString endEvent.message)
, ("event", JSONString (typeToString endEvent.event)) , ("event", JSONString (typeToString endEvent.event))
: case endEvent.EndEvent.module_name of : case endEvent.EndEvent.location of
Nothing -> [] Nothing -> []
Just m -> [("module",JSONString m)] Just l -> case JSONEncode{|*|} True l of
[json] -> [("location",json)]
_ -> abort "error in JSONEncode_EndEvent\n"
++ case endEvent.event of ++ case endEvent.event of
Failed (Just r) -> [("failReason", case JSONEncode{|*|} False r of Failed (Just r) -> [("failReason", case JSONEncode{|*|} False r of
[JSONArray r] -> JSONArray r [JSONArray r] -> JSONArray r
...@@ -60,7 +65,7 @@ where ...@@ -60,7 +65,7 @@ where
getField "name" >>= \name -> getField "name" >>= \name ->
getField "event" >>= \event -> getField "event" >>= \event ->
getField "message" >>= \message -> getField "message" >>= \message ->
let e = {name=name, message=message, event=Passed, module_name=getField "module"} in case event of let e = {name=name, message=message, event=Passed, location=getField "location"} in case event of
"passed" -> pure e "passed" -> pure e
"failed" -> pure {e & event = Failed $ getField "failReason"} "failed" -> pure {e & event = Failed $ getField "failReason"}
"skipped" -> pure {e & event=Skipped} "skipped" -> pure {e & event=Skipped}
...@@ -135,5 +140,5 @@ where ...@@ -135,5 +140,5 @@ where
f -> Just (Other f) f -> Just (Other f)
JSONDecode{|Relation|} _ _ = (Nothing, []) JSONDecode{|Relation|} _ _ = (Nothing, [])
derive JSONEncode FailReason, CounterExample derive JSONEncode TestLocation, FailReason, CounterExample
derive JSONDecode FailReason, CounterExample derive JSONDecode TestLocation, FailReason, CounterExample
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