Skip to content

Feat: basic record dot completions #3080

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 10 commits into from
Sep 26, 2022
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
address feedback
  • Loading branch information
coltenwebb committed Sep 26, 2022
commit b7a70260f40c023b0b5604ceb9efdbfd5eedcec4
14 changes: 8 additions & 6 deletions ghcide/src/Development/IDE/Plugin/Completions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ import qualified Language.LSP.VFS as VFS
import Numeric.Natural
import Text.Fuzzy.Parallel (Scored (..))

import qualified GHC.LanguageExtensions as LangExt
import qualified GHC.LanguageExtensions as LangExt
import Language.LSP.Types

data Log = LogShake Shake.Log deriving Show
Expand Down Expand Up @@ -142,12 +142,14 @@ getCompletionsLSP ide plId
exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap $ exportsMap
exportsCompls = mempty{anyQualCompls = exportsCompItems}
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules

-- get HieAst if OverloadedRecordDot is enabled
let uses_th_qq (ms_hspp_opts -> dflags) = xopt LangExt.OverloadedRecordDot dflags
let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags
ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath
astres <- case ms of
Just ms' -> if uses_th_qq . msrModSummary $ ms' then useWithStaleFast GetHieAst npath else return Nothing
astres <- case ms of
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Possibly stupid question, but why guard here? What happens if we just guard getting the HIE AST on whether or not we have record dot?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If I understand you correctly, that's exactly what I'm trying to do here. Maybe there's a simpler way to do this?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, it was a stupid question: I missed that the uses_overloaded_record_dot predicate needs the module summary!

Just ms' -> if uses_overloaded_record_dot ms'
then useWithStaleFast GetHieAst npath
else return Nothing
Nothing -> return Nothing

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

allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports
pure $ InL (List $ orderedCompletions allCompletions)
_ -> return (InL $ List [])
_ -> return (InL $ List [])
Expand Down
39 changes: 19 additions & 20 deletions ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,14 +14,14 @@ module Development.IDE.Plugin.Completions.Logic (
) where

import Control.Applicative
import Data.Char (isUpper)
import Data.Char (isAlphaNum, isUpper)
import Data.Generics
import Data.List.Extra as List hiding
(stripPrefix)
import qualified Data.Map as Map

import Data.Maybe (fromMaybe, isJust,
mapMaybe, catMaybes)
import Data.Maybe (catMaybes, fromMaybe,
isJust, mapMaybe)
import qualified Data.Text as T
import qualified Text.Fuzzy.Parallel as Fuzzy

Expand All @@ -31,7 +31,7 @@ import Data.Either (fromRight)
import Data.Function (on)
import Data.Functor
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import qualified Data.Map.Strict as M

import qualified Data.HashSet as HashSet
import Data.Monoid (First (..))
Expand Down Expand Up @@ -70,11 +70,10 @@ import qualified Language.LSP.VFS as VFS
import Text.Fuzzy.Parallel (Scored (score),
original)

import Development.IDE
import Data.Coerce (coerce)
import Data.Coerce (coerce)
import Development.IDE

import Data.Char (isAlphaNum)
import qualified Data.Rope.UTF16 as Rope
import qualified Data.Rope.UTF16 as Rope

-- Chunk size used for parallelizing fuzzy matching
chunkSize :: Int
Expand Down Expand Up @@ -617,14 +616,14 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
lpos = lowerRange position'
hpos = upperRange position'
in getCContext lpos pm <|> getCContext hpos pm

dotFieldSelectorToCompl :: T.Text -> (Bool, CompItem)
dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing)

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

Expand All @@ -638,7 +637,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
g :: Type -> [(Bool, CompItem)]
g (TyConApp theTyCon _) = map dotFieldSelectorToCompl $ getSels theTyCon
g _ = []

nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a
nodeInfoH (HieFromDisk _) = nodeInfo'
nodeInfoH HieFresh = nodeInfo
Expand Down Expand Up @@ -692,7 +691,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
thisModName = Local $ nameSrcSpan name

compls
| T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($Nothing) <$> anyQualCompls)
| T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($ Nothing) <$> anyQualCompls)
| not $ null tst = tst
| otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls))
++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls)
Expand Down Expand Up @@ -955,28 +954,28 @@ mergeListsBy cmp all_lists = merge_lists all_lists
getCompletionPrefix :: (Monad m) => Position -> VFS.VirtualFile -> m (Maybe PosPrefixInfo)
getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) =
return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad
let headMaybe [] = Nothing
let headMaybe [] = Nothing
headMaybe (x:_) = Just x
lastMaybe [] = Nothing
lastMaybe xs = Just $ last xs
lastMaybe [] = Nothing
lastMaybe [x] = Just x
lastMaybe (_:xs) = lastMaybe xs

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

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

completionPrefixPos :: PosPrefixInfo -> Position
completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1)
completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1)
10 changes: 5 additions & 5 deletions ghcide/src/Development/IDE/Plugin/Completions/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -139,10 +139,10 @@ instance Semigroup CachedCompletions where
CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e')


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

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

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