Skip to content

Commit 0262ff5

Browse files
committed
address feedback
1 parent e2de534 commit 0262ff5

File tree

3 files changed

+32
-31
lines changed

3 files changed

+32
-31
lines changed

ghcide/src/Development/IDE/Plugin/Completions.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ import qualified Language.LSP.VFS as VFS
4848
import Numeric.Natural
4949
import Text.Fuzzy.Parallel (Scored (..))
5050

51-
import qualified GHC.LanguageExtensions as LangExt
51+
import qualified GHC.LanguageExtensions as LangExt
5252
import Language.LSP.Types
5353

5454
data Log = LogShake Shake.Log deriving Show
@@ -142,12 +142,14 @@ getCompletionsLSP ide plId
142142
exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap $ exportsMap
143143
exportsCompls = mempty{anyQualCompls = exportsCompItems}
144144
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules
145-
145+
146146
-- get HieAst if OverloadedRecordDot is enabled
147-
let uses_th_qq (ms_hspp_opts -> dflags) = xopt LangExt.OverloadedRecordDot dflags
147+
let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags
148148
ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath
149-
astres <- case ms of
150-
Just ms' -> if uses_th_qq . msrModSummary $ ms' then useWithStaleFast GetHieAst npath else return Nothing
149+
astres <- case ms of
150+
Just ms' -> if uses_overloaded_record_dot ms'
151+
then useWithStaleFast GetHieAst npath
152+
else return Nothing
151153
Nothing -> return Nothing
152154

153155
pure (opts, fmap (,pm,binds) compls, moduleExports, astres)
@@ -162,7 +164,7 @@ getCompletionsLSP ide plId
162164
plugins = idePlugins $ shakeExtras ide
163165
config <- getCompletionsConfig plId
164166

165-
allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports
167+
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports
166168
pure $ InL (List $ orderedCompletions allCompletions)
167169
_ -> return (InL $ List [])
168170
_ -> return (InL $ List [])

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -14,14 +14,14 @@ module Development.IDE.Plugin.Completions.Logic (
1414
) where
1515

1616
import Control.Applicative
17-
import Data.Char (isUpper)
17+
import Data.Char (isAlphaNum, isUpper)
1818
import Data.Generics
1919
import Data.List.Extra as List hiding
2020
(stripPrefix)
2121
import qualified Data.Map as Map
2222

23-
import Data.Maybe (fromMaybe, isJust,
24-
mapMaybe, catMaybes)
23+
import Data.Maybe (catMaybes, fromMaybe,
24+
isJust, mapMaybe)
2525
import qualified Data.Text as T
2626
import qualified Text.Fuzzy.Parallel as Fuzzy
2727

@@ -31,7 +31,7 @@ import Data.Either (fromRight)
3131
import Data.Function (on)
3232
import Data.Functor
3333
import qualified Data.HashMap.Strict as HM
34-
import qualified Data.Map.Strict as M
34+
import qualified Data.Map.Strict as M
3535

3636
import qualified Data.HashSet as HashSet
3737
import Data.Monoid (First (..))
@@ -69,11 +69,10 @@ import qualified Language.LSP.VFS as VFS
6969
import Text.Fuzzy.Parallel (Scored (score),
7070
original)
7171

72-
import Development.IDE
73-
import Data.Coerce (coerce)
72+
import Data.Coerce (coerce)
73+
import Development.IDE
7474

75-
import Data.Char (isAlphaNum)
76-
import qualified Data.Rope.UTF16 as Rope
75+
import qualified Data.Rope.UTF16 as Rope
7776

7877
-- Chunk size used for parallelizing fuzzy matching
7978
chunkSize :: Int
@@ -615,14 +614,14 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
615614
lpos = lowerRange position'
616615
hpos = upperRange position'
617616
in getCContext lpos pm <|> getCContext hpos pm
618-
617+
619618
dotFieldSelectorToCompl :: T.Text -> (Bool, CompItem)
620619
dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing)
621620

622621
-- we need the hieast to be fresh
623622
-- not fresh, hasfield won't have a chance. it would to another larger change to ghc IfaceTyCon to contain record fields
624623
tst :: [(Bool, CompItem)]
625-
tst = case maybe_ast_res of
624+
tst = case maybe_ast_res of
626625
Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) (theFunc HieFresh)
627626
_ -> []
628627

@@ -636,7 +635,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
636635
g :: Type -> [(Bool, CompItem)]
637636
g (TyConApp theTyCon _) = map dotFieldSelectorToCompl $ getSels theTyCon
638637
g _ = []
639-
638+
640639
nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a
641640
nodeInfoH (HieFromDisk _) = nodeInfo'
642641
nodeInfoH HieFresh = nodeInfo
@@ -690,7 +689,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
690689
thisModName = Local $ nameSrcSpan name
691690

692691
compls
693-
| T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($Nothing) <$> anyQualCompls)
692+
| T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($ Nothing) <$> anyQualCompls)
694693
| not $ null tst = tst
695694
| otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls))
696695
++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls)
@@ -953,28 +952,28 @@ mergeListsBy cmp all_lists = merge_lists all_lists
953952
getCompletionPrefix :: (Monad m) => Position -> VFS.VirtualFile -> m (Maybe PosPrefixInfo)
954953
getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) =
955954
return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad
956-
let headMaybe [] = Nothing
955+
let headMaybe [] = Nothing
957956
headMaybe (x:_) = Just x
958-
lastMaybe [] = Nothing
959-
lastMaybe xs = Just $ last xs
957+
lastMaybe [] = Nothing
958+
lastMaybe [x] = Just x
959+
lastMaybe (_:xs) = lastMaybe xs
960960

961961
curLine <- headMaybe $ T.lines $ Rope.toText
962962
$ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext
963963
let beforePos = T.take (fromIntegral c) curLine
964964
curWord <-
965-
if | T.null beforePos -> Just ""
965+
if | T.null beforePos -> Just ""
966966
| T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc '
967-
| otherwise -> lastMaybe (T.words beforePos)
967+
| otherwise -> lastMaybe (T.words beforePos)
968968

969969
let parts = T.split (=='.')
970970
$ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord
971971
case reverse parts of
972972
[] -> Nothing
973973
(x:xs) -> do
974-
let modParts = dropWhile (\_ -> False)
975-
$ reverse $ filter (not .T.null) xs
974+
let modParts = reverse $ filter (not .T.null) xs
976975
modName = T.intercalate "." modParts
977976
return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos }
978977

979978
completionPrefixPos :: PosPrefixInfo -> Position
980-
completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1)
979+
completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1)

ghcide/src/Development/IDE/Plugin/Completions/Types.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -139,10 +139,10 @@ instance Semigroup CachedCompletions where
139139
CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e')
140140

141141

142-
-- moved here from Language.LSP.VHS
142+
-- moved here from Language.LSP.VFS
143143
-- | Describes the line at the current cursor position
144144
data PosPrefixInfo = PosPrefixInfo
145-
{ fullLine :: !T.Text
145+
{ fullLine :: !T.Text
146146
-- ^ The full contents of the line the cursor is at
147147

148148
, prefixScope :: !T.Text
@@ -152,10 +152,10 @@ data PosPrefixInfo = PosPrefixInfo
152152
-- If OverloadedRecordDot is enabled, "Shape.rect.width" will be
153153
-- "Shape.rect"
154154

155-
, prefixText :: !T.Text
155+
, prefixText :: !T.Text
156156
-- ^ The word right before the cursor position, after removing the module part.
157157
-- For example if the user has typed "Data.Maybe.from",
158158
-- then this property will be "from"
159-
, cursorPos :: !J.Position
159+
, cursorPos :: !J.Position
160160
-- ^ The cursor position
161-
} deriving (Show,Eq)
161+
} deriving (Show,Eq)

0 commit comments

Comments
 (0)