Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
84f2cd75
Commit
84f2cd75
authored
May 21, 2004
by
simonmar
Browse files
Improve command-line parsing
parent
e1346ef6
Changes
4
Hide whitespace changes
Inline
Side-by-side
Distribution/Setup.hs
View file @
84f2cd75
...
...
@@ -84,7 +84,6 @@ data Action = ConfigCmd ConfigFlags -- config
|
BuildCmd
-- build
|
InstallCmd
(
Maybe
FilePath
)
-- install
|
SDistCmd
-- sdist
|
InfoCmd
-- info
|
RegisterCmd
-- register
|
UnregisterCmd
-- unregister
|
HelpCmd
-- help
...
...
@@ -108,35 +107,45 @@ parseArgs args
[]
->
if
HelpFlag
`
elem
`
flags
then
Right
(
HelpCmd
,
unkFlags
)
else
case
commands'
of
[]
->
Left
[
"
No command detecte
d"
]
[]
->
Left
[
"
Missing comman
d"
]
[
h
]
->
parseCommands
h
flags
unkFlags
c
->
Left
[
"M
ore than one command detected
: "
++
(
concat
$
intersperse
", "
c
)]
c
->
Left
[
"M
ultiple commands
: "
++
(
concat
$
intersperse
", "
c
)]
where
parseCommands
::
String
-- command
->
[
Flag
]
->
[
String
]
-- unknown flags
->
Either
[
String
]
CommandLineOpts
parseCommands
"configure"
flags
unkFlags
parseCommands
str
flags
unkFlags
=
case
str
of
"configure"
->
parseConfigure
flags
unkFlags
"install"
->
parseInstall
flags
unkFlags
"build"
->
noFlags
str
BuildCmd
flags
unkFlags
"sdist"
->
noFlags
str
SDistCmd
flags
unkFlags
"register"
->
noFlags
str
RegisterCmd
flags
unkFlags
"unregister"
->
noFlags
str
UnregisterCmd
flags
unkFlags
_
->
Left
[
"Unrecognised command: "
++
str
]
parseConfigure
flags
unkFlags
|
not
(
any
isInstallPrefix
flags
)
=
case
getConfigFlags
flags
of
Left
err
->
Left
[
err
]
Right
configFlags
->
Right
(
ConfigCmd
configFlags
,
unkFlags
)
parseCommands
"install"
[
InstPrefix
m
]
unkFlags
|
otherwise
=
commandSyntaxError
"configure"
parseInstall
[
InstPrefix
m
]
unkFlags
=
Right
(
InstallCmd
$
Just
m
,
unkFlags
)
parse
Commands
"i
nstall
"
[]
unkFlags
parse
I
nstall
[]
unkFlags
=
Right
(
InstallCmd
Nothing
,
unkFlags
)
parseCommands
"build"
[]
unkFlags
=
Right
(
BuildCmd
,
unkFlags
)
parseCommands
"sdist"
[]
unkFlags
=
Right
(
SDistCmd
,
unkFlags
)
parseCommands
"info"
[]
unkFlags
=
Right
(
InfoCmd
,
unkFlags
)
parseCommands
"register"
[]
unkFlags
=
Right
(
RegisterCmd
,
unkFlags
)
parseCommands
"unregister"
[]
unkFlags
=
Right
(
UnregisterCmd
,
unkFlags
)
parseCommands
c
_
_
=
Left
$
[
"command line syntax error for command: "
++
c
]
parseInstall
_
_
=
commandSyntaxError
"install"
noFlags
str
cmd
[]
unkFlags
=
Right
(
cmd
,
unkFlags
)
noFlags
str
cmd
_
unkFlags
=
commandSyntaxError
str
commandSyntaxError
c
=
Left
[
"Syntax error for command: "
++
c
]
isInstallPrefix
::
Flag
->
Bool
isInstallPrefix
(
InstPrefix
_
)
=
True
...
...
@@ -181,7 +190,7 @@ options :: [OptDescr Flag]
options
=
[
Option
"g"
[
"ghc"
]
(
NoArg
GhcFlag
)
"compile with GHC"
,
Option
"n"
[
"nhc"
]
(
NoArg
NhcFlag
)
"compile with NHC"
,
Option
""
[
"hugs"
]
(
NoArg
HugsFlag
)
"compile with hugs"
,
Option
"w"
[
"with-compiler"
]
(
ReqArg
WithCompiler
"
COMPILER
PATH"
)
Option
"w"
[
"with-compiler"
]
(
ReqArg
WithCompiler
"PATH"
)
"give the path to a particular compiler"
,
Option
""
[
"prefix"
]
(
ReqArg
Prefix
"DIR"
)
"bake this prefix in preparation of installation"
,
...
...
@@ -197,7 +206,6 @@ commands = [("configure", "configure this package"),
(
"build"
,
""
),
(
"install"
,
""
),
(
"sdist"
,
""
),
(
"info"
,
""
),
(
"register"
,
""
),
(
"unregister"
,
""
)
]
...
...
@@ -239,7 +247,6 @@ hunitTests =
|
(
flag
,
flagCmd
)
<-
[(
"build"
,
BuildCmd
),
(
"install"
,
InstallCmd
Nothing
),
(
"sdist"
,
SDistCmd
),
(
"info"
,
InfoCmd
),
(
"register"
,
RegisterCmd
)]
]
]
...
...
Distribution/Simple.hs
View file @
84f2cd75
...
...
@@ -85,10 +85,15 @@ defaultMain pkgconfig
concat
(
intersperse
","
(
extra_flags
)))
localbuildinfo
<-
configure
pkgconfig
flags
writePersistBuildConfig
localbuildinfo
Left
er
->
putStrLn
$
show
er
Left
err
->
do
hPutStr
stderr
(
unlines
err
)
hPutStr
stderr
(
optionHelpString
helpprefix
)
-- (BuildCmd, _) -> doBuildInstall build p
-- (InstallCmd _, _) -> doBuildInstall install p
-- (InfoCmd, _) -> print p
_other
->
die
"unimplemented command
\n
"
return
()
emptyPackageConfig
::
PackageConfig
...
...
Distribution/Simple/Utils.hs
View file @
84f2cd75
...
...
@@ -83,4 +83,3 @@ isPathSeparator ch =
die
::
String
->
IO
a
die
msg
=
do
hPutStr
stderr
msg
;
exitWith
(
ExitFailure
1
)
Distribution/TODO
View file @
84f2cd75
...
...
@@ -43,7 +43,6 @@
--with-compiler=
--prefix=
--instprefix=
--help (for compatibility? it's really more of an action)
* 1.0
** actions
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment