summaryrefslogtreecommitdiff
path: root/compiler/main/CmdLineParser.hs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2008-06-14 13:38:48 +0000
committerIan Lynagh <igloo@earth.li>2008-06-14 13:38:48 +0000
commit0079141c61f673039ccd879cd75174b33eb40b8f (patch)
treec2a5acb06ae12ac98d05ce2291fc9cb0815b1c2e /compiler/main/CmdLineParser.hs
parent95b686571a3dc625b6e331417be24747c8552132 (diff)
downloadhaskell-0079141c61f673039ccd879cd75174b33eb40b8f.tar.gz
Use a proper datatype, rather than pairs, for flags
Diffstat (limited to 'compiler/main/CmdLineParser.hs')
-rw-r--r--compiler/main/CmdLineParser.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 8ec2f6a3ef..710faf6a8a 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -11,7 +11,8 @@
module CmdLineParser (
processArgs, OptKind(..),
- CmdLineP(..), getCmdLineState, putCmdLineState
+ CmdLineP(..), getCmdLineState, putCmdLineState,
+ Flag(..),
) where
#include "HsVersions.h"
@@ -19,6 +20,10 @@ module CmdLineParser (
import Util
import Panic
+data Flag m = Flag { flagName :: String, -- flag, without the leading -
+ flagOptKind :: (OptKind m) -- What to do if we see it
+ }
+
data OptKind m -- Suppose the flag is -f
= NoArg (m ()) -- -f all by itself
| HasArg (String -> m ()) -- -farg or -f arg
@@ -33,7 +38,7 @@ data OptKind m -- Suppose the flag is -f
| AnySuffixPred (String -> Bool) (String -> m ())
processArgs :: Monad m
- => [(String, OptKind m)] -- cmdline parser spec
+ => [Flag m] -- cmdline parser spec
-> [String] -- args
-> m (
[String], -- spare args
@@ -94,12 +99,13 @@ processOneArg action rest arg args
AnySuffixPred _ f -> Right (f dash_arg, args)
-findArg :: [(String,OptKind a)] -> String -> Maybe (String,OptKind a)
+findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
findArg spec arg
- = case [ (removeSpaces rest, k)
- | (pat,k) <- spec,
- Just rest <- [maybePrefixMatch pat arg],
- arg_ok k rest arg ]
+ = case [ (removeSpaces rest, optKind)
+ | flag <- spec,
+ let optKind = flagOptKind flag,
+ Just rest <- [maybePrefixMatch (flagName flag) arg],
+ arg_ok optKind rest arg ]
of
[] -> Nothing
(one:_) -> Just one