Use a proper datatype, rather than pairs, for flags

[ghc-hetmet.git] / compiler / main / CmdLineParser.hs

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 8ec2f6a..710faf6 100644 (file)
--- 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