Skip to content

Commit fa04b1f

Browse files
Switch test or executable target to option
- this allows the '--' to signify that all remaining arguments are to the test/executable
1 parent c88cabc commit fa04b1f

File tree

1 file changed

+30
-14
lines changed

1 file changed

+30
-14
lines changed

bootstrap/src/Fpm.hs

Lines changed: 30 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,8 @@ import Control.Monad.Extra ( concatMapM
1717
, when
1818
)
1919
import Data.Hashable ( hash )
20-
import Data.List ( isSuffixOf
20+
import Data.List ( intercalate
21+
, isSuffixOf
2122
, find
2223
, nub
2324
)
@@ -35,6 +36,7 @@ import Development.Shake.FilePath ( (</>)
3536
import Options.Applicative ( Parser
3637
, (<**>)
3738
, (<|>)
39+
, auto
3840
, command
3941
, execParser
4042
, fullDesc
@@ -45,6 +47,7 @@ import Options.Applicative ( Parser
4547
, long
4648
, many
4749
, metavar
50+
, option
4851
, optional
4952
, progDesc
5053
, short
@@ -89,14 +92,14 @@ data Arguments =
8992
, runCompiler :: FilePath
9093
, runFlags :: [String]
9194
, runTarget :: Maybe String
92-
, runArgs :: Maybe String
95+
, runArgs :: Maybe [String]
9396
}
9497
| Test
9598
{ testRelease :: Bool
9699
, testCompiler :: FilePath
97100
, testFlags :: [String]
98101
, testTarget :: Maybe String
99-
, testArgs :: Maybe String
102+
, testArgs :: Maybe [String]
100103
}
101104

102105
data TomlSettings = TomlSettings {
@@ -182,7 +185,7 @@ app args settings = case args of
182185
(map
183186
(++ case runArgs of
184187
Nothing -> ""
185-
Just theArgs -> " " ++ theArgs
188+
Just theArgs -> " " ++ (intercalate " " theArgs)
186189
)
187190
canonicalExecutables
188191
)
@@ -200,8 +203,9 @@ app args settings = case args of
200203
Nothing -> putStrLn "Executable Not Found"
201204
Just specified -> do
202205
exitCode <- case runArgs of
203-
Nothing -> system specified
204-
Just theArgs -> system (specified ++ " " ++ theArgs)
206+
Nothing -> system specified
207+
Just theArgs ->
208+
system (specified ++ " " ++ (intercalate " " theArgs))
205209
exitWith exitCode
206210
Test { testTarget = whichOne, testArgs = testArgs } -> do
207211
build settings
@@ -224,7 +228,7 @@ app args settings = case args of
224228
(map
225229
(++ case testArgs of
226230
Nothing -> ""
227-
Just theArgs -> " " ++ theArgs
231+
Just theArgs -> " " ++ (intercalate " " theArgs)
228232
)
229233
canonicalExecutables
230234
)
@@ -242,8 +246,9 @@ app args settings = case args of
242246
Nothing -> putStrLn "Test Not Found"
243247
Just specified -> do
244248
exitCode <- case testArgs of
245-
Nothing -> system specified
246-
Just theArgs -> system (specified ++ " " ++ theArgs)
249+
Nothing -> system specified
250+
Just theArgs ->
251+
system (specified ++ " " ++ (intercalate " " theArgs))
247252
exitWith exitCode
248253
_ -> putStrLn "Shouldn't be able to get here"
249254

@@ -420,11 +425,17 @@ runArguments =
420425
)
421426
)
422427
<*> optional
423-
(strArgument
424-
(metavar "TARGET" <> help "Name of the executable to run")
428+
(strOption
429+
(long "target" <> metavar "TARGET" <> help
430+
"Name of the executable to run"
431+
)
425432
)
426433
<*> optional
427-
(strArgument (metavar "ARGS" <> help "Arguments to the executable"))
434+
(many
435+
(strArgument
436+
(metavar "ARGS" <> help "Arguments to the executable(s) (should follow '--')")
437+
)
438+
)
428439

429440
testArguments :: Parser Arguments
430441
testArguments =
@@ -449,8 +460,13 @@ testArguments =
449460
)
450461
)
451462
<*> optional
452-
(strArgument (metavar "TARGET" <> help "Name of the test to run"))
453-
<*> optional (strArgument (metavar "ARGS" <> help "Arguments to the test"))
463+
(strOption (long "target" <> metavar "TARGET" <> help "Name of the test to run"))
464+
<*> optional
465+
(many
466+
(strArgument
467+
(metavar "ARGS" <> help "Arguments to the test(s) (should follow '--')")
468+
)
469+
)
454470

455471
getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath]
456472
getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns

0 commit comments

Comments
 (0)