projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7640181
)
Improve runghc's argument handling
author
Ian Lynagh
<igloo@earth.li>
Sun, 19 Aug 2007 00:04:36 +0000
(
00:04
+0000)
committer
Ian Lynagh
<igloo@earth.li>
Sun, 19 Aug 2007 00:04:36 +0000
(
00:04
+0000)
utils/runghc/runghc.hs
patch
|
blob
|
history
diff --git
a/utils/runghc/runghc.hs
b/utils/runghc/runghc.hs
index
a55fdca
..
707dc62
100644
(file)
--- a/
utils/runghc/runghc.hs
+++ b/
utils/runghc/runghc.hs
@@
-39,20
+39,27
@@
import System.Directory ( findExecutable )
main :: IO ()
main = do
args <- getArgs
main :: IO ()
main = do
args <- getArgs
- case args of
- "-f" : ghc : args' -> doIt ghc args'
- ('-' : 'f' : ghc) : args' -> doIt (dropWhile isSpace ghc) args'
- _ -> do
+ case getGhcLoc args of
+ (Just ghc, args') -> doIt ghc args'
+ (Nothing, args') -> do
mb_ghc <- findExecutable "ghc"
case mb_ghc of
Nothing -> dieProg ("cannot find ghc")
mb_ghc <- findExecutable "ghc"
case mb_ghc of
Nothing -> dieProg ("cannot find ghc")
- Just ghc -> doIt ghc args
+ Just ghc -> doIt ghc args'
+
+getGhcLoc :: [String] -> (Maybe FilePath, [String])
+getGhcLoc ("-f" : ghc : args) = (Just ghc, args)
+getGhcLoc (('-' : 'f' : ghc) : args) = (Just ghc, args)
+-- If you need the first GHC flag to be a -f flag then you can pass --
+-- first
+getGhcLoc ("--" : args) = (Nothing, args)
+getGhcLoc args = (Nothing, args)
doIt :: String -> [String] -> IO ()
doIt ghc args = do
doIt :: String -> [String] -> IO ()
doIt ghc args = do
- let (ghc_args, rest) = break notArg args
+ let (ghc_args, rest) = getGhcArgs args
case rest of
case rest of
- [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
+ [] -> dieProg usage
filename : prog_args -> do
let expr = "System.Environment.withProgName " ++ show filename ++
" (System.Environment.withArgs " ++ show prog_args ++
filename : prog_args -> do
let expr = "System.Environment.withProgName " ++ show filename ++
" (System.Environment.withArgs " ++ show prog_args ++
@@
-72,9
+79,18
@@
doIt ghc args = do
-- of the IO in order to show it (see #1200).
exitWith res
-- of the IO in order to show it (see #1200).
exitWith res
-notArg :: String -> Bool
-notArg ('-':_) = False
-notArg _ = True
+getGhcArgs :: [String] -> ([String], [String])
+getGhcArgs args = case break pastArgs args of
+ (xs, "--":ys) -> (xs, ys)
+ (xs, ys) -> (xs, ys)
+
+pastArgs :: String -> Bool
+-- You can use -- to mark the end of the flags, in caes you need to use
+-- a file called -foo.hs for some reason. You almost certainly shouldn't,
+-- though.
+pastArgs "--" = True
+pastArgs ('-':_) = False
+pastArgs _ = True
dieProg :: String -> IO a
dieProg msg = do
dieProg :: String -> IO a
dieProg msg = do
@@
-82,3
+98,6
@@
dieProg msg = do
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
+usage :: String
+usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."
+