Start with #1: different output options

Tools/CleanTest.icl

@@ -22,12 +22,14 @@ import Text.JSON
 import Text.Language
 
 :: Options =
-	{ runs :: ![Run]
-	, help :: !Bool
-	, hide :: ![MessageType]
+	{ runs   :: ![Run]
+	, help   :: !Bool
+	, output :: !OutputFormat
+	, hide   :: ![MessageType]
 	}
 
 :: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost
+:: OutputFormat = OF_JSON | OF_HumanReadable
 
 messageType :: TestEvent -> MessageType
 messageType (StartEvent _) = MT_Started
@@ -45,7 +47,7 @@ derive gEq MessageType; instance == MessageType where == a b = a === b
 	}
 
 gDefault{|Bool|} = False
-derive gDefault MessageType, Options, Run
+derive gDefault MessageType, Options, OutputFormat, Run
 
 :: ProcessOutput =
 	{ lines :: ![String]
@@ -68,7 +70,7 @@ Start w
 | isError opts = exit True (Just $ fromError opts) prog w
 # opts = fromOk opts
 | opts.help = exit True Nothing prog w
-# w = seqSt (run opts.hide) opts.runs w
+# w = seqSt (run opts) opts.runs w
 = w
 where
 	parseOpts :: Options [String] -> MaybeErrorString Options
@@ -77,7 +79,8 @@ where
 		= parseOpts opts [fromJust ('M'.get arg long_options):args]
 	where
 		long_options = 'M'.fromList
-			[ ("-h", "--help")
+			[ ("-f", "--output-format")
+			, ("-h", "--help")
 			, ("-H", "--hide")
 			, ("-n", "--name")
 			, ("-O", "--option")
@@ -103,6 +106,11 @@ where
 			[]     -> Error "--option used before --run"
 			[r:rs] -> parseOpts {opts & runs=[{r & options=r.options ++ [opt]}:rs]} args
 		[]         -> Error "--option requires a parameter"
+	parseOpts opts ["--output-format":args] = case args of
+		["json":args]  -> parseOpts {opts & output=OF_JSON} args
+		["human":args] -> parseOpts {opts & output=OF_HumanReadable} args
+		[fmt:args]     -> Error $ "Unknown output format '" +++ fmt +++ "'"
+		[]             -> Error "--output-format requires a parameter"
 	parseOpts opts ["--name":args] = case args of
 		[name:args] -> case opts.runs of
 			[]      -> Error "-n used before -r"
@@ -123,20 +131,21 @@ where
 	where
 		help :: String
 		help = prog +++ ": run Clean tests\nOptions:\n" +++
-			"  --help/-h        Show this help\n" +++
-			"  --hide/-H TYPE   Comma-separated list of types of messages to hide (start,pass,fail,skip,lost)\n" +++
-			"  --run/-r EXE     Execute tests from executable EXE\n" +++
-			"  --option/-O OPT  Add OPT to the command line of the previously added run\n" +++
-			"  --name/-n NAME   Give the previously added run the name NAME\n"
+			"  --help/-h               Show this help\n" +++
+			"  --hide/-H TYPE          Comma-separated list of types of messages to hide (start,pass,fail,skip,lost)\n" +++
+			"  --output-format/-f FMT  The output format (json,human)\n" +++
+			"  --run/-r EXE            Execute tests from executable EXE\n" +++
+			"  --option/-O OPT         Add OPT to the command line of the previously added run\n" +++
+			"  --name/-n NAME          Give the previously added run the name NAME\n"
 
-run :: ![MessageType] !Run !*World -> *World
-run hide r w
+run :: !Options !Run !*World -> *World
+run opts r w
 # (io,w) = stdio w
-# io = emit hide (StartEvent {StartEvent | name=r.Run.name}) io
+# io = emit (StartEvent {StartEvent | name=r.Run.name}) io
 # (h,w) = runProcessIO r.executable r.options Nothing w
 | isError h
 	# (err,msg) = fromError h
-	# io = emit hide (EndEvent
+	# io = emit (EndEvent
 		{ name    = r.Run.name
 		, event   = Failed
 		, message = "Failed to execute " <+ r.executable <+ " (" <+ err <+ "; " <+ msg <+ ")"
@@ -154,7 +163,7 @@ where
 	# (ss,w) = readPipeBlockingMulti [pio.stdOut, pio.stdErr] w
 	| isError ss
 		# (err,msg) = fromError ss
-		# io = emit hide (EndEvent
+		# io = emit (EndEvent
 			{ name    = r.Run.name
 			, event   = Failed
 			, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
@@ -163,13 +172,13 @@ where
 	# [out,err:_] = fromOk ss
 	# (output,io) = append out (\s io -> case fromJSON $ fromString s of
 		Nothing -> io
-		Just ev -> emit hide ev io) output io
+		Just ev -> emit ev io) output io
 	# w = snd $ fclose (stderr <<< err) w
 	// Check if child has terminated
 	# (t,w) = checkProcess h w
 	| isError t
 		# (err,msg) = fromError t
-		# io = emit hide (EndEvent
+		# io = emit (EndEvent
 			{ name    = r.Run.name
 			, event   = Failed
 			, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
@@ -186,10 +195,10 @@ where
 				, message = "Failed to read child messages"
 				} <<< "\n"
 			= snd $ fclose io w
-		# io = emit hide (EndEvent $ mergeResults $ map fromJust results) io
+		# io = emit (EndEvent $ mergeResults $ map fromJust results) io
 		= snd $ fclose io w
 	| isJust rcode
-		# io = emit hide (EndEvent
+		# io = emit (EndEvent
 			{ name    = r.Run.name
 			, event   = Failed
 			, message = "Child process exited with " <+ fromJust rcode
@@ -215,7 +224,20 @@ where
 			lost = length (filter (\te -> te=:(StartEvent _)) tes) -
 				length (filter (\te -> te=:(EndEvent _)) tes)
 
-	emit :: [MessageType] TestEvent *File -> *File
-	emit hide ev io
-	| isMember (messageType ev) hide = io
-	| otherwise = io <<< toJSON ev <<< "\n"
+	emit :: TestEvent *File -> *File
+	emit ev io
+	| isMember (messageType ev) opts.hide = io
+	| otherwise = case opts.output of
+		OF_JSON          -> io <<< toJSON ev <<< "\n"
+		OF_HumanReadable -> io <<< humanReadable ev <<< "\n"
+	where
+		humanReadable :: TestEvent -> String
+		humanReadable (StartEvent se) = "Started:  " +++ se.StartEvent.name
+		humanReadable (EndEvent ee) = event +++ ee.EndEvent.name
+		where
+			event = case ee.event of
+				Passed   -> "Passed:   "
+				Failed   -> "Failed:   "
+				//Failed _ -> "failed" // TODO reason
+				Skipped  -> "Got lost: "
+				//Lost     -> "got lost"