Adapt to clean-platform!112 (moved the CLI options to Platform)

Tools/CleanTest.icl

 module CleanTest
 
+import StdArray
 import StdFile
 from StdFunc import o
 import StdList
 import StdString
 import StdTuple
 
-import Control.Monad
+import Control.Monad => qualified join
 import Data.Error
 from Data.Func import $, seqSt
+import Data.List
 import Data.Maybe
 import System.CommandLine
 import System.FilePath
 import System.Process
+import Testing.Options
 import Testing.TestEvents
-from Text import <+, class Text(split), instance Text String
+from Text import <+, class Text(join,split), instance Text String
 import Text.JSON
 import Text.Language
 
-import CleanTest.Options
-
 :: ProcessOutput =
 	{ lines :: ![String]
 	, rest  :: !String
@@ -57,17 +58,8 @@ where
 	where
 		help :: String
 		help = prog +++ ": run Clean tests\n" +++
-			"\nGeneral options:\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" +++
-			"  --strategy/-S STRATEGY  The test order strategy, where STRATEGY is one of\n" +++
-			"      default               Order of the --run parameters\n" +++
-			"      failed-first          First run the tests that failed last time; if they past continue with the rest\n" +++
-			"\nTest options:\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"
+			join "\n" [if (d.[0] <> ' ') "\n" "" +++ d \\ d <- optionDoc] +++
+			"\n"
 
 run :: !Options !Run !*World -> *World
 run opts r w

Tools/CleanTest/Options.dcl

-definition module CleanTest.Options
-
-from StdOverloaded import class ==
-
-from Data.Error import :: MaybeError, :: MaybeErrorString
-from Data.Generics.GenDefault import generic gDefault
-from System.FilePath import :: FilePath
-from Testing.TestEvents import :: TestEvent
-
-:: Options =
-	{ runs     :: ![Run]
-	, help     :: !Bool
-	, output   :: !OutputFormat
-	, hide     :: ![MessageType]
-	, strategy :: !Strategy
-	}
-
-:: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost
-:: OutputFormat = OF_JSON | OF_HumanReadable
-:: Strategy = S_FailedFirst | S_Default
-
-:: Run =
-	{ name       :: !String
-	, executable :: !FilePath
-	, options    :: ![String]
-	}
-
-instance == MessageType
-
-derive gDefault MessageType, Options, OutputFormat, Run, Strategy
-
-messageType :: TestEvent -> MessageType
-
-parseTestOpts :: Options [String] -> MaybeErrorString Options

Tools/CleanTest/Options.icl

-implementation module CleanTest.Options
-
-import StdList
-import StdOverloaded
-import StdString
-
-import Control.Monad
-import Data.Error
-from Data.Func import $
-import Data.Generics.GenDefault
-import Data.Generics.GenEq
-import Data.List
-import Data.Maybe
-import System.FilePath
-import Testing.TestEvents
-from Text import class Text(split), instance Text String
-
-derive gEq MessageType; instance == MessageType where == a b = a === b
-
-gDefault{|Bool|} = False
-derive gDefault MessageType, Options, OutputFormat, Run, Strategy
-
-messageType :: TestEvent -> MessageType
-messageType (StartEvent _) = MT_Started
-messageType (EndEvent ee) = case ee.event of
-	Passed  -> MT_Passed
-	Failed  -> MT_Failed
-	Skipped -> MT_Skipped
-
-LONG_OPTIONS =:
-	[ ("-f", "--output-format")
-	, ("-h", "--help")
-	, ("-H", "--hide")
-	, ("-n", "--name")
-	, ("-O", "--option")
-	, ("-r", "--run")
-	, ("-S", "--strategy")
-	]
-
-parseTestOpts :: Options [String] -> MaybeErrorString Options
-parseTestOpts opts [] = Ok {opts & runs=reverse opts.runs}
-parseTestOpts opts [arg:args] | isJust opt = parseTestOpts opts [fromJust opt:args]
-where opt = lookup arg LONG_OPTIONS
-parseTestOpts opts ["--help":args] = parseTestOpts {opts & help=True} args
-parseTestOpts opts ["--hide":args] = case args of
-	[arg:args] -> mapM parseMT (split "," arg) >>= \h -> parseTestOpts {opts & hide=h} args
-	[]         -> Error "--hide requires a parameter"
-where
-	parseMT :: String -> MaybeErrorString MessageType
-	parseMT "start" = Ok MT_Started
-	parseMT "pass"  = Ok MT_Passed
-	parseMT "fail"  = Ok MT_Failed
-	parseMT "skip"  = Ok MT_Skipped
-	parseMT "lost"  = Ok MT_Lost
-	parseMT s       = Error $ "Unknown message type '" +++ s +++ "'"
-parseTestOpts opts ["--name":args] = case args of
-	[name:args] -> case opts.runs of
-		[]      -> Error "-n used before -r"
-		[r:rs]  -> parseTestOpts {opts & runs=[{Run | r & name=name}:rs]} args
-	[]          -> Error "-n requires a parameter"
-parseTestOpts opts ["--option":args] = case args of
-	[opt:args] -> case opts.runs of
-		[]     -> Error "--option used before --run"
-		[r:rs] -> parseTestOpts {opts & runs=[{r & options=r.options ++ [opt]}:rs]} args
-	[]         -> Error "--option requires a parameter"
-parseTestOpts opts ["--output-format":args] = case args of
-	["json":args]  -> parseTestOpts {opts & output=OF_JSON} args
-	["human":args] -> parseTestOpts {opts & output=OF_HumanReadable} args
-	[fmt:args]     -> Error $ "Unknown output format '" +++ fmt +++ "'"
-	[]             -> Error "--output-format requires a parameter"
-parseTestOpts opts ["--run":args] = case args of
-	[exe:args] -> parseTestOpts {opts & runs=[{gDefault{|*|} & executable=exe, name=exe}:opts.runs]} args
-	[]         -> Error "--run requires a parameter"
-parseTestOpts opts ["--strategy":args] = case args of
-	["default":args]      -> parseTestOpts {opts & strategy=S_Default} args
-	["failed-first":args] -> parseTestOpts {opts & strategy=S_FailedFirst} args
-	[s:args]              -> Error $ "Unknown strategy '" +++ s +++ "'"
-	[]                    -> Error "--strategy requires a parameter"
-parseTestOpts opts [arg:args] = Error $ "Unknown option '" +++ arg +++ "'"