[Git][ghc/ghc][master] [#23663] Show Flag Suggestions in GHCi
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Aug 4 16:30:02 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a1899d8f by Aaron Allen at 2023-08-04T12:29:24-04:00
[#23663] Show Flag Suggestions in GHCi
Makes suggestions when using `:set` in GHCi with a misspelled flag. This
mirrors how invalid flags are handled when passed to GHC directly. Logic
for producing flag suggestions was moved to GHC.Driver.Sesssion so it
can be shared.
resolves #23663
- - - - -
9 changed files:
- compiler/GHC/Driver/Session.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- testsuite/tests/ghc-e/should_fail/Makefile
- testsuite/tests/ghc-e/should_fail/T18441fail2.stderr
- + testsuite/tests/ghc-e/should_fail/T23663.stderr
- testsuite/tests/ghc-e/should_fail/all.T
- testsuite/tests/safeHaskell/ghci/p12.stderr
- testsuite/tests/safeHaskell/ghci/p5.stderr
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -173,6 +173,7 @@ module GHC.Driver.Session (
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
parseDynamicFlagsFull,
+ flagSuggestions,
-- ** Available DynFlags
allNonDeprecatedFlags,
@@ -271,7 +272,7 @@ import Data.Functor.Identity
import Data.Ord
import Data.Char
-import Data.List (intercalate, sortBy)
+import Data.List (intercalate, sortBy, partition)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -882,6 +883,20 @@ safeFlagCheck cmdl dflags =
-- Force this to avoid retaining reference to old DynFlags value
!safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer
+-- | Produce a list of suggestions for a user provided flag that is invalid.
+flagSuggestions
+ :: [String] -- valid flags to match against
+ -> String
+ -> [String]
+flagSuggestions flags userInput
+ -- fixes #11789
+ -- If the flag contains '=',
+ -- this uses both the whole and the left side of '=' for comparing.
+ | elem '=' userInput =
+ let (flagsWithEq, flagsWithoutEq) = partition (elem '=') flags
+ fName = takeWhile (/= '=') userInput
+ in (fuzzyMatch userInput flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq)
+ | otherwise = fuzzyMatch userInput flags
{- **********************************************************************
%* *
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -3144,10 +3144,7 @@ newDynFlags interactive_only minus_opts = do
(idflags1, leftovers, warns) <- DynFlags.parseDynamicFlagsCmdLine idflags0 lopts
liftIO $ printOrThrowDiagnostics logger (initPrintConfig idflags1) (initDiagOpts idflags1) (GhcDriverMessage <$> warns)
- when (not $ null leftovers)
- (throwGhcException . CmdLineError
- $ "Some flags have not been recognized: "
- ++ (concat . intersperse ", " $ map unLoc leftovers))
+ when (not $ null leftovers) (unknownFlagsErr $ map unLoc leftovers)
when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do
liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"
@@ -3197,6 +3194,15 @@ newDynFlags interactive_only minus_opts = do
return ()
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwGhcException $ CmdLineError $ concatMap oneError fs
+ where
+ oneError f =
+ "unrecognised flag: " ++ f ++ "\n" ++
+ (case flagSuggestions ghciFlags f of
+ [] -> ""
+ suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs))
+ ghciFlags = nubSort $ flagsForCompletion True
unsetOptions :: GhciMonad m => String -> m ()
unsetOptions str
=====================================
ghc/Main.hs
=====================================
@@ -1140,15 +1140,6 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
where
oneError f =
"unrecognised flag: " ++ f ++ "\n" ++
- (case match f (nubSort allNonDeprecatedFlags) of
+ (case flagSuggestions (nubSort allNonDeprecatedFlags) f of
[] -> ""
suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs))
- -- fixes #11789
- -- If the flag contains '=',
- -- this uses both the whole and the left side of '=' for comparing.
- match f allFlags
- | elem '=' f =
- let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags
- fName = takeWhile (/= '=') f
- in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq)
- | otherwise = fuzzyMatch f allFlags
=====================================
testsuite/tests/ghc-e/should_fail/Makefile
=====================================
@@ -76,3 +76,6 @@ T18441fail17:
T18441fail18:
-'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" || echo $$? >&2
+
+T23663:
+ -'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":set -XCUSKS" || echo $$? >&2 # misspelled flag
=====================================
testsuite/tests/ghc-e/should_fail/T18441fail2.stderr
=====================================
@@ -1,2 +1,3 @@
-<interactive>: Some flags have not been recognized: -Xabcde
+<interactive>: unrecognised flag: -Xabcde
+
1
=====================================
testsuite/tests/ghc-e/should_fail/T23663.stderr
=====================================
@@ -0,0 +1,5 @@
+<interactive>: unrecognised flag: -XCUSKS
+did you mean one of:
+ -XCUSKs
+
+1
=====================================
testsuite/tests/ghc-e/should_fail/all.T
=====================================
@@ -54,3 +54,5 @@ test('T18441fail17', req_interp, makefile_test, ['T18441fail17'])
test('T18441fail18', req_interp, makefile_test, ['T18441fail18'])
test('T18441fail19', [ignore_stderr, exit_code(1)], run_command, ['{compiler} -e ":cd abcd"'])
+
+test('T23663', req_interp, makefile_test, ['T23663'])
=====================================
testsuite/tests/safeHaskell/ghci/p12.stderr
=====================================
@@ -1,6 +1,12 @@
-Some flags have not been recognized: -XNoSafe
-Some flags have not been recognized: -fno-package-trust
+unrecognised flag: -XNoSafe
+did you mean one of:
+ -XSafe
+
+unrecognised flag: -fno-package-trust
+did you mean one of:
+ -fpackage-trust
+
<no location info>: error: [GHC-75165]
Data.ByteString: Can't be safely imported!
- The package (bytestring-0.11.3.0) the module resides in isn't trusted.
+ The package (bytestring-0.11.4.0) the module resides in isn't trusted.
=====================================
testsuite/tests/safeHaskell/ghci/p5.stderr
=====================================
@@ -1,7 +1,16 @@
-Some flags have not been recognized: -XNoSafe
+unrecognised flag: -XNoSafe
+did you mean one of:
+ -XSafe
+
<no location info>: Incompatible Safe Haskell flags! (Safe, Trustworthy)
Usage: For basic information, try the `--help' option.
-Some flags have not been recognized: -XNoTrustworthy
+unrecognised flag: -XNoTrustworthy
+did you mean one of:
+ -XTrustworthy
+
<no location info>: Incompatible Safe Haskell flags! (Safe, Unsafe)
Usage: For basic information, try the `--help' option.
-Some flags have not been recognized: -XNoUnsafe
+unrecognised flag: -XNoUnsafe
+did you mean one of:
+ -XUnsafe
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1899d8f446db6b8c59576b8e3ef1910823592b1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1899d8f446db6b8c59576b8e3ef1910823592b1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230804/3ee07505/attachment-0001.html>
More information about the ghc-commits
mailing list