Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
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
25 changes: 14 additions & 11 deletions ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,7 @@ import Development.IDE hiding (line)
import Development.IDE.Spans.AtPoint (pointCommand)


import qualified Development.IDE.Plugin.Completions.Types as C
import GHC.Plugins (Depth (AllTheWay),
mkUserStyle,
neverQualify,
Expand Down Expand Up @@ -202,7 +203,7 @@ mkCompl
_preselect = Nothing,
_sortText = Nothing,
_filterText = Nothing,
_insertText = Just insertText,
_insertText = Just $ snippetToText insertText,
_insertTextFormat = Just InsertTextFormat_Snippet,
_insertTextMode = Nothing,
_textEdit = Nothing,
Expand Down Expand Up @@ -242,10 +243,9 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..}
isTypeCompl = isTcOcc origName
typeText = Nothing
label = stripOccNamePrefix $ printOutputable origName
insertText = case isInfix of
insertText = snippetText $ case isInfix of
Nothing -> label
Just LeftSide -> label <> "`"

Just Surrounded -> label
additionalTextEdits =
imp <&> \x ->
Expand Down Expand Up @@ -294,7 +294,7 @@ defaultCompletionItemWithLabel label =
fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
fromIdentInfo doc identInfo@IdentInfo{..} q = CI
{ compKind= occNameToComKind name
, insertText=rend
, insertText= snippetText rend
, provenance = DefinedIn mod
, label=rend
, typeText = Nothing
Expand Down Expand Up @@ -458,10 +458,11 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod
]

mkLocalComp pos n ctyp ty =
CI ctyp pn (Local pos) pn ty Nothing (ctyp `elem` [CompletionItemKind_Struct, CompletionItemKind_Interface]) Nothing (Just $ NameDetails (ms_mod $ pm_mod_summary pm) occ) True
CI ctyp sn (Local pos) pn ty Nothing (ctyp `elem` [CompletionItemKind_Struct, CompletionItemKind_Interface]) Nothing (Just $ NameDetails (ms_mod $ pm_mod_summary pm) occ) True
where
occ = rdrNameOcc $ unLoc n
pn = showForSnippet n
sn = snippetText pn

findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result
Expand Down Expand Up @@ -638,7 +639,7 @@ getCompletions
dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem)
dotFieldSelectorToCompl recname label = (True, CI
{ compKind = CompletionItemKind_Field
, insertText = label
, insertText = snippetText label
, provenance = DefinedIn recname
, label = label
, typeText = Nothing
Expand Down Expand Up @@ -667,7 +668,7 @@ getCompletions
endLoc = upperRange oldPos
localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc
localBindsToCompItem :: Name -> Maybe Type -> CompItem
localBindsToCompItem name typ = CI ctyp pn thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True
localBindsToCompItem name typ = CI ctyp (snippetText pn) thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True
where
occ = nameOccName name
ctyp = occNameToComKind occ
Expand Down Expand Up @@ -736,7 +737,8 @@ uniqueCompl candidate unique =
-- filter global completions when we already have a local one
|| not(isLocalCompletion candidate) && isLocalCompletion unique
then EQ
else compare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique)
else compare (importedFrom candidate) (importedFrom unique) <>
snippetLexOrd (insertText candidate) (insertText unique)
other -> other
where
importedFrom :: CompItem -> T.Text
Expand Down Expand Up @@ -805,9 +807,10 @@ mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r
}

placeholder_pairs = zip compl ([1..]::[Int])
snippet_parts = map (\(x, i) -> x <> "=${" <> T.pack (show i) <> ":_" <> x <> "}") placeholder_pairs
snippet = T.intercalate (T.pack ", ") snippet_parts
buildSnippet = ctxStr <> " {" <> snippet <> "}"
snippet_parts = placeholder_pairs <&> \(x, i) ->
snippetText x <> "=" <> snippetVariableDefault (T.pack $ show i) (C.SText $ "_" <> x)
snippet = mconcat $ intersperse ", " snippet_parts
buildSnippet = snippetText ctxStr <> " {" <> snippet <> "}"

getImportQual :: LImportDecl GhcPs -> Maybe T.Text
getImportQual (L _ imp)
Expand Down
50 changes: 49 additions & 1 deletion ghcide/src/Development/IDE/Plugin/Completions/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,11 @@ import qualified Data.Text as T

import Data.Aeson
import Data.Aeson.Types
import Data.Function (on)
import Data.Hashable (Hashable)
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import Data.String (IsString (..))
import Data.Text (Text)
import Development.IDE.GHC.Compat
import Development.IDE.Graph (RuleResult)
Expand Down Expand Up @@ -81,9 +85,53 @@ data Provenance
| Local SrcSpan
deriving (Eq, Ord, Show)

newtype Snippet = Snippet [SnippetAny]
deriving (Eq, Show)
deriving newtype (Semigroup, Monoid)

instance IsString Snippet where
fromString = snippetText . T.pack

data SnippetAny
= SText Text
| STabStop Int
| SPlaceholder Int SnippetAny
| SChoice Int (NonEmpty Text)
| SVariable Text (Maybe SnippetAny)
deriving (Eq, Show)

snippetText :: Text -> Snippet
snippetText = Snippet . L.singleton . SText

snippetVariable :: Text -> Snippet
snippetVariable n = Snippet . L.singleton $ SVariable n Nothing

snippetVariableDefault :: Text -> SnippetAny -> Snippet
snippetVariableDefault n d = Snippet . L.singleton . SVariable n $ Just d

snippetToText :: Snippet -> Text
snippetToText (Snippet l) = foldMap (snippetAnyToText False) l
where
snippetAnyToText isNested = \case
SText t -> sanitizeText isNested t
STabStop i -> "${" <> T.pack (show i) <> "}"
SPlaceholder i s -> "${" <> T.pack (show i) <> ":" <> snippetAnyToText True s <> "}"
SChoice i (c :| cs) -> "${" <> T.pack (show i) <> "|" <> c <> foldMap ("," <>) cs <> "}"
SVariable n md -> "${" <> n <> maybe mempty (\x -> ":" <> snippetAnyToText True x) md <> "}"
sanitizeText isNested = T.foldl' (sanitizeChar isNested) mempty
sanitizeChar isNested t = (t <>) . \case
'$' -> "\\$"
'\\' -> "\\\\"
',' | isNested -> "\\,"
'|' | isNested -> "\\|"
c -> T.singleton c

snippetLexOrd :: Snippet -> Snippet -> Ordering
snippetLexOrd = compare `on` snippetToText

data CompItem = CI
{ compKind :: CompletionItemKind
, insertText :: T.Text -- ^ Snippet for the completion
, insertText :: Snippet -- ^ Snippet for the completion
, provenance :: Provenance -- ^ From where this item is imported from.
, label :: T.Text -- ^ Label to display to the user.
, typeText :: Maybe T.Text
Expand Down
Loading