Commit b3eb8fad authored by Geraldus's avatar Geraldus Committed by Ben Gamari
Browse files

Complete operators properly



Fix operator completions: list of suitable completions only rather than
everything from imported modules.
Signed-off-by: Geraldus's avatarArthur Fayzrakhmanov (Артур Файзрахманов) <heraldhoi@gmail.com>

ghc: fix operator completions

Reviewers: austin, hvr, thomie, bgamari

Reviewed By: thomie, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1058

GHC Trac Issues: #10576
parent d1ce1aa9
...@@ -111,6 +111,7 @@ import System.IO.Unsafe ( unsafePerformIO ) ...@@ -111,6 +111,7 @@ import System.IO.Unsafe ( unsafePerformIO )
import System.Process import System.Process
import Text.Printf import Text.Printf
import Text.Read ( readMaybe ) import Text.Read ( readMaybe )
import Text.Read.Lex (isSymbolChar)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import System.Posix hiding ( getEnv ) import System.Posix hiding ( getEnv )
...@@ -231,10 +232,12 @@ ghciCommands = map mkCmd [ ...@@ -231,10 +232,12 @@ ghciCommands = map mkCmd [
-- NOTE: in order for us to override the default correctly, any custom entry -- NOTE: in order for us to override the default correctly, any custom entry
-- must be a SUBSET of word_break_chars. -- must be a SUBSET of word_break_chars.
word_break_chars :: String word_break_chars :: String
word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~" word_break_chars = spaces ++ specials ++ symbols
specials = "(),;[]`{}"
spaces = " \t\n" symbols, specials, spaces :: String
in spaces ++ specials ++ symbols symbols = "!#$%&*+/<=>?@\\^|-~"
specials = "(),;[]`{}"
spaces = " \t\n"
flagWordBreakChars :: String flagWordBreakChars :: String
flagWordBreakChars = " \t\n" flagWordBreakChars = " \t\n"
...@@ -2770,13 +2773,24 @@ completeGhciCommand, completeMacro, completeIdentifier, completeModule, ...@@ -2770,13 +2773,24 @@ completeGhciCommand, completeMacro, completeIdentifier, completeModule,
completeHomeModuleOrFile, completeExpression completeHomeModuleOrFile, completeExpression
:: CompletionFunc GHCi :: CompletionFunc GHCi
-- | Provide completions for last word in a given string.
--
-- Takes a tuple of two strings. First string is a reversed line to be
-- completed. Second string is likely unused, 'completeCmd' always passes an
-- empty string as second item in tuple.
ghciCompleteWord :: CompletionFunc GHCi ghciCompleteWord :: CompletionFunc GHCi
ghciCompleteWord line@(left,_) = case firstWord of ghciCompleteWord line@(left,_) = case firstWord of
-- If given string starts with `:` colon, and there is only one following
-- word then provide REPL command completions. If there is more than one
-- word complete either filename or builtin ghci commands or macros.
':':cmd | null rest -> completeGhciCommand line ':':cmd | null rest -> completeGhciCommand line
| otherwise -> do | otherwise -> do
completion <- lookupCompletion cmd completion <- lookupCompletion cmd
completion line completion line
-- If given string starts with `import` keyword provide module name
-- completions
"import" -> completeModule line "import" -> completeModule line
-- otherwise provide identifier completions
_ -> completeExpression line _ -> completeExpression line
where where
(firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left
...@@ -2801,10 +2815,16 @@ completeMacro = wrapIdentCompleter $ \w -> do ...@@ -2801,10 +2815,16 @@ completeMacro = wrapIdentCompleter $ \w -> do
cmds <- liftIO $ readIORef macros_ref cmds <- liftIO $ readIORef macros_ref
return (filter (w `isPrefixOf`) (map cmdName cmds)) return (filter (w `isPrefixOf`) (map cmdName cmds))
completeIdentifier = wrapIdentCompleter $ \w -> do completeIdentifier line@(left, _) =
rdrs <- GHC.getRdrNamesInScope -- Note: `left` is a reversed input
dflags <- GHC.getSessionDynFlags case left of
return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs)) (x:_) | isSymbolChar x -> wrapCompleter (specials ++ spaces) complete line
_ -> wrapIdentCompleter complete line
where
complete w = do
rdrs <- GHC.getRdrNamesInScope
dflags <- GHC.getSessionDynFlags
return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))
completeModule = wrapIdentCompleter $ \w -> do completeModule = wrapIdentCompleter $ \w -> do
dflags <- GHC.getSessionDynFlags dflags <- GHC.getSessionDynFlags
......
...@@ -30,6 +30,8 @@ module Text.Read.Lex ...@@ -30,6 +30,8 @@ module Text.Read.Lex
, readOctP , readOctP
, readDecP , readDecP
, readHexP , readHexP
, isSymbolChar
) )
where where
...@@ -214,18 +216,19 @@ lexSymbol = ...@@ -214,18 +216,19 @@ lexSymbol =
return (Punc s) -- Reserved-ops count as punctuation return (Punc s) -- Reserved-ops count as punctuation
else else
return (Symbol s) return (Symbol s)
where where
isSymbolChar c = not (isPuncChar c) && case generalCategory c of reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"]
MathSymbol -> True
CurrencySymbol -> True isSymbolChar :: Char -> Bool
ModifierSymbol -> True isSymbolChar c = not (isPuncChar c) && case generalCategory c of
OtherSymbol -> True MathSymbol -> True
DashPunctuation -> True CurrencySymbol -> True
OtherPunctuation -> not (c `elem` "'\"") ModifierSymbol -> True
ConnectorPunctuation -> c /= '_' OtherSymbol -> True
_ -> False DashPunctuation -> True
reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"] OtherPunctuation -> not (c `elem` "'\"")
ConnectorPunctuation -> c /= '_'
_ -> False
-- ---------------------------------------------------------------------- -- ----------------------------------------------------------------------
-- identifiers -- identifiers
......
module Level1 where
l1 = undefined :: ()
module Level2.Level2 where
l2 = undefined :: ()
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
module TopLevel (module Level1, module Level2.Level2) where
import Level1
import Level2.Level2
# testcase for module import completions, e.g. `:complete repl "import Mod"`
test('prog015', normal, ghci_script, ['prog015.script'])
:load TopLevel
:complete repl "import Le"
-- should list Level1 and Level2.Levele2
:complete repl 1 "import Le"
-- should list Level1
:complete repl 2-3 "import Le"
-- should list Level2.Level2
:complete repl "import Level."
-- should list nothing
:complete repl "import Level2"
-- should list Level2.Levele2
:complete repl "import Level2."
-- same output
:complete repl "import Level2.W"
-- should list nothing
:complete repl "import Level2.L"
-- should list Level2.Level2
\ No newline at end of file
2 2 "import "
"Level1"
"Level2.Level2"
1 2 "import "
"Level1"
1 2 "import "
"Level2.Level2"
0 0 "import "
1 1 "import "
"Level2.Level2"
1 1 "import "
"Level2.Level2"
0 0 "import "
1 1 "import "
"Level2.Level2"
\ No newline at end of file
module Level1 where
level1Fun1 :: ()
level1Fun1 = ()
level1Fun2 :: ()
level1Fun2 = ()
module Level2.Level2 where
level2Fun1 :: ()
level2Fun1 = ()
level2Fun2 :: ()
level2Fun2 = ()
level2Fun3 :: ()
level2Fun3 = ()
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
module TopLevel (module Level1, module Level2.Level2) where
import Level1
import Level2.Level2
topLevelFun :: ()
topLevelFun = ()
# testcase for regular identifier completions, e.g. `:complete repl "fun"`
test('prog016', normal, ghci_script, ['prog016.script'])
:load TopLevel
:complete repl "lev"
-- should list all 5 functions
:complete repl "levWRONG"
-- should list nothing
:complete repl 1 "lev"
-- should list one function
:complete repl 2-4 "lev"
-- should list three results
:complete repl 4-10 "lev"
-- should list last two results
:complete repl "level1"
-- should list two results
:complete repl "level2"
-- should list three results
:complete repl "Level"
-- should list five results
:complete repl "Level.l"
-- should list no results
:complete repl "Level1.l"
-- should list two results
:complete repl "Level2.Level2"
-- should list three results
\ No newline at end of file
5 5 ""
"level1Fun1"
"level1Fun2"
"level2Fun1"
"level2Fun2"
"level2Fun3"
0 0 ""
1 5 ""
"level1Fun1"
3 5 ""
"level1Fun2"
"level2Fun1"
"level2Fun2"
2 5 ""
"level2Fun2"
"level2Fun3"
2 2 ""
"level1Fun1"
"level1Fun2"
3 3 ""
"level2Fun1"
"level2Fun2"
"level2Fun3"
5 5 ""
"Level1.level1Fun1"
"Level1.level1Fun2"
"Level2.Level2.level2Fun1"
"Level2.Level2.level2Fun2"
"Level2.Level2.level2Fun3"
0 0 ""
2 2 ""
"Level1.level1Fun1"
"Level1.level1Fun2"
3 3 ""
"Level2.Level2.level2Fun1"
"Level2.Level2.level2Fun2"
"Level2.Level2.level2Fun3"
\ No newline at end of file
module Level1 where
(..--) = undefined :: ()
(..-+) = undefined :: ()
(..++) = undefined :: ()
module Level2.Level2 where
(..+=..) = undefined :: ()
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
module TopLevel (module Level1, module Level2.Level2) where
import Level1
import Level2.Level2
-- ASCII syms
(..-) = undefined :: ()
(..+) = undefined :: ()
(..=) = undefined :: ()
(..>>) = undefined :: ()
(..!>) = undefined :: ()
-- General Punctuation
() = undefined :: () -- U+2050
(⁐⁑) = undefined :: () -- ... U+2051
-- supAndSubScriptR
-- likely everything is this group is rejected
-- moved to failing T10550a test
-- currencySymbolR
() = undefined :: () -- U+20BD
(₽€) = undefined :: () -- ... U+20AC
-- letterLikeSymbolR
() = undefined :: () -- U+2140
(⅀⅀) = undefined :: () -- ... U+2140
-- numberFormsR
-- likely everything is this group is rejected
-- moved to failing T10550b test
-- enclosedAlphanumericsR
() = undefined :: () -- U+24A1
(⒡Ⓞ) = undefined :: () -- ... U+24C4
-- some from this group is rejected, e.g. ③
-- added to failing T10550d test
-- enclosedAlphanumericSupplementR
(🄐) = undefined :: () -- U+1F110
(🄐🄐) = undefined :: () -- ... U+1F110
-- some from this group is rejected, e.g. 🄀
-- added failing test case T10550d
-- enclosedIdeographicSupplementR
(🈐) = undefined :: () -- U+1F210
(🈐🈭) = undefined :: () -- ... U+1F22D
-- arrowsR
() = undefined :: () -- U+2190
(←→) = undefined :: () -- ... U+2192
-- supplementalArrowsAR
() = undefined :: () -- U+27F9
(⟹⟿) = undefined :: () -- .. U+27FF
-- supplementalArrowsBR
() = undefined :: () -- U+2934
(⤴⤵) = undefined :: () -- ... U+2935
-- supplementalArrowsCR
(🡘) = undefined :: () -- U+1F858
(🡘🢕) = undefined :: () -- ... U+1F895
-- miscellaneousSymbolsAndArrowsR
() = undefined :: () -- U+2B24
(⬤⬱) = undefined :: () -- ... U+2B31
-- dingbatArrowsR
() = undefined :: () -- U+27BE
(➾➔) = undefined :: () -- ... U+2794
-- mathematicalOperators
() = undefined :: () -- U+2200
(∀⋙) = undefined :: () -- ... U+22D9
-- miscellaneousMathematicalSymbolsAR
() = undefined :: () -- U+27D1
(⟑⟑) = undefined :: () -- ... U+27E9
-- some from this group is rejected, e.g. ⟨
-- added failing test case T10550e
-- miscellaneousMathematicalSymbolsBR
() = undefined :: () -- U+29E6
(⧦⧵) = undefined :: () -- ... U+29F5
-- supplementalMathematicalOperatorsR
() = undefined :: () -- U+2A36
(⨶⫫) = undefined :: () -- ... U+2AEB
-- mathematicalAlphanumericSymbolsR
(𝛌) = undefined :: () -- U+1D6CC
(𝛌𝕘) = undefined :: () -- ... U+1D558
-- miscellaneousTechnicalR
() = undefined :: () -- U+2318
(⌘⌥) = undefined :: () -- ... U+2325
-- controlPicturesR
() = undefined :: () -- U+2418
(␘␡) = undefined :: () -- ... U+2421
-- characterRecognitionR
() = undefined :: () -- U+2441
(⑁⑅) = undefined :: () -- ... U+2445
-- byzantineMusicalSymbolsR
(𝀐) = undefined :: () -- U+1DO1O
(𝀐𝃆) = undefined :: () -- ... U+1D0C6
-- musicalSymbolsR
(𝄢) = undefined :: () -- U+1D122
(𝄢𝇇) = undefined :: () -- ... U+1D1C7
-- ancientGreekMusicalNotationR
(𝉀) = undefined :: () -- U+1D240
(𝉀𝈒) = undefined :: () -- ... U+1D212
-- mahjongTilesR
(🀐) = undefined :: () -- U+1F010
(🀐🀢) = undefined :: () -- ... U+1F022
-- dominoTilesR
(🀱) = undefined :: () -- U+1F031
(🀱🁧) = undefined :: () -- ... U+1F067
-- playingCardsR
(🂿) = undefined :: () -- U+1F0BF
(🂿🃠) = undefined :: () -- ... U+1F0E0
-- miscellaneousSymbolsR
() = undefined :: () -- U+2600
(☀☭) = undefined :: () -- ... U+262D
-- emoticonsR
-- likely everything is this group is rejected
-- added failing test case T10550f
-- miscellaneousSymbolsAndPictographsR
(🌓) = undefined :: () -- U+1F313
(🌓🐇) = undefined :: () -- ... U+1F407
-- transportAndMapSymbolsR
(🚭) = undefined :: () -- U+1F6AD
(🚭🚀) = undefined :: () -- ... U+1F680
-- dingbatsR
() = undefined :: () -- U+2714
(✔✩) = undefined :: () -- ... U+2729
-- combiningDiacriticalMarksForSymbolsR
-- combining unicode symbols should be handled and tested in some smart manner
-- added failing T10550g test case
-- boxDrawingR
() = undefined :: () -- U+2501
(━╃) = undefined :: () -- ... U+2543
-- blockElementsR
() = undefined :: () -- U+2599
(▙▟) = undefined :: () -- ... U+259F
-- geometricShapesR
() = undefined :: () -- U+25B3
(△◉) = undefined :: () -- ... U+25C9
-- geometricShapesExtendedR
(🞋) = undefined :: () -- U+1F78B
(🞋🞯) = undefined :: () -- ... U+1F7AF
-- ornamentalDingbatsR
(🙫) = undefined :: () -- U+1F66B
(🙫🙢) = undefined :: () -- ... U+1F662
-- arabicMathematicalAlphabeticSymbolsR
(𞺂) = undefined :: () -- U+1EE82
(𞺂𞹟) = undefined :: () -- ... U+1EE5F
-- alchemicalSymbolsR
(🜄) = undefined :: () -- U+1F704
(🜄🝪) = undefined :: () -- ... U+1F76A
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment