From d389f5ffbd454d2eaa03601945602b1eaac65b50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Thu, 23 Oct 2025 12:37:27 +0300 Subject: [PATCH 1/2] Escape dollar signs in completion snippets --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 0a5cecaca8..cc10d3a134 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -202,7 +202,7 @@ mkCompl _preselect = Nothing, _sortText = Nothing, _filterText = Nothing, - _insertText = Just insertText, + _insertText = Just $ sanitize insertText, _insertTextFormat = Just InsertTextFormat_Snippet, _insertTextMode = Nothing, _textEdit = Nothing, @@ -227,6 +227,7 @@ mkCompl pprLineCol (UnhelpfulLoc fs) = T.pack $ unpackFS fs pprLineCol (RealSrcLoc loc _) = "line " <> printOutputable (srcLocLine loc) <> ", column " <> printOutputable (srcLocCol loc) + sanitize = T.replace "$" "\\$" mkAdditionalEditsCommand :: Maybe PluginId -> ExtendImport -> Maybe Command From af036a0e8a42682a7eb97148ed5df3c1d22fe52a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Thu, 23 Oct 2025 20:24:11 +0300 Subject: [PATCH 2/2] added Snippet --- .../IDE/Plugin/Completions/Logic.hs | 26 +++++----- .../IDE/Plugin/Completions/Types.hs | 50 ++++++++++++++++++- 2 files changed, 63 insertions(+), 13 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index cc10d3a134..018d08cb06 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -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, @@ -202,7 +203,7 @@ mkCompl _preselect = Nothing, _sortText = Nothing, _filterText = Nothing, - _insertText = Just $ sanitize insertText, + _insertText = Just $ snippetToText insertText, _insertTextFormat = Just InsertTextFormat_Snippet, _insertTextMode = Nothing, _textEdit = Nothing, @@ -227,7 +228,6 @@ mkCompl pprLineCol (UnhelpfulLoc fs) = T.pack $ unpackFS fs pprLineCol (RealSrcLoc loc _) = "line " <> printOutputable (srcLocLine loc) <> ", column " <> printOutputable (srcLocCol loc) - sanitize = T.replace "$" "\\$" mkAdditionalEditsCommand :: Maybe PluginId -> ExtendImport -> Maybe Command @@ -243,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 -> @@ -295,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 @@ -459,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 @@ -639,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 @@ -668,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 @@ -737,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 @@ -806,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) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 338b969bab..d03505275a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -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) @@ -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