-setMode :: CmdLineMode -> String -> ModeM ()
-setMode m flag = updateMode (\_ -> m) flag
-
-updateDoEval :: String -> CmdLineMode -> CmdLineMode
-updateDoEval expr (DoEval exprs) = DoEval (expr : exprs)
-updateDoEval expr _ = DoEval [expr]
-
-updateMode :: (CmdLineMode -> CmdLineMode) -> String -> ModeM ()
-updateMode f flag = do
- (old_mode, old_flag, flags') <- getCmdLineState
- let new_mode = f old_mode
- if null old_flag || flag == old_flag || overridingMode new_mode
- then putCmdLineState (new_mode, flag, flags')
- else if overridingMode old_mode then return ()
- else ghcError (UsageError
- ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
-
--- This returns true for modes that override other modes, e.g.
--- "--interactive --help" and "--help --interactive" are both equivalent
--- to "--help"
-overridingMode :: CmdLineMode -> Bool
-overridingMode ShowUsage = True
-overridingMode ShowVersion = True
-overridingMode ShowNumVersion = True
-overridingMode _ = False
-
-addFlag :: String -> ModeM ()
-addFlag s = do
- (m, f, flags') <- getCmdLineState
- -- XXX Can we get a useful Loc?
- putCmdLineState (m, f, mkGeneralLocated "addFlag" s : flags')
-
+setMode :: Mode -> String -> EwM ModeM ()
+setMode newMode newFlag = liftEwM $ do
+ (mModeFlag, errs, flags') <- getCmdLineState
+ let (modeFlag', errs') =
+ case mModeFlag of
+ Nothing -> ((newMode, newFlag), errs)
+ Just (oldMode, oldFlag) ->
+ case (oldMode, newMode) of
+ -- -c/--make are allowed together, and mean --make -no-link
+ _ | isStopLnMode oldMode && isDoMakeMode newMode
+ || isStopLnMode newMode && isDoMakeMode oldMode ->
+ ((doMakeMode, "--make"), [])
+
+ -- If we have both --help and --interactive then we
+ -- want showGhciUsage
+ _ | isShowGhcUsageMode oldMode &&
+ isDoInteractiveMode newMode ->
+ ((showGhciUsageMode, oldFlag), [])
+ | isShowGhcUsageMode newMode &&
+ isDoInteractiveMode oldMode ->
+ ((showGhciUsageMode, newFlag), [])
+ -- Otherwise, --help/--version/--numeric-version always win
+ | isDominantFlag oldMode -> ((oldMode, oldFlag), [])
+ | isDominantFlag newMode -> ((newMode, newFlag), [])
+ -- We need to accumulate eval flags like "-e foo -e bar"
+ (Right (Right (DoEval esOld)),
+ Right (Right (DoEval [eNew]))) ->
+ ((Right (Right (DoEval (eNew : esOld))), oldFlag),
+ errs)
+ -- Saying e.g. --interactive --interactive is OK
+ _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
+ -- Otherwise, complain
+ _ -> let err = flagMismatchErr oldFlag newFlag
+ in ((oldMode, oldFlag), err : errs)
+ putCmdLineState (Just modeFlag', errs', flags')
+ where isDominantFlag f = isShowGhcUsageMode f ||
+ isShowGhciUsageMode f ||
+ isShowVersionMode f ||
+ isShowNumVersionMode f
+
+flagMismatchErr :: String -> String -> String
+flagMismatchErr oldFlag newFlag
+ = "cannot use `" ++ oldFlag ++ "' with `" ++ newFlag ++ "'"
+
+addFlag :: String -> String -> EwM ModeM ()
+addFlag s flag = liftEwM $ do
+ (m, e, flags') <- getCmdLineState
+ putCmdLineState (m, e, mkGeneralLocated loc s : flags')
+ where loc = "addFlag by " ++ flag ++ " on the commandline"