Skip to content

Commit 3a2b23e

Browse files
SoupstrawSoupstraw
authored
Escape dollar signs in completion snippets (#4745)
* Escape dollar signs in completion snippets * added Snippet * Added comments
1 parent 4808791 commit 3a2b23e

File tree

2 files changed

+70
-12
lines changed

2 files changed

+70
-12
lines changed

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

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ import Development.IDE hiding (line)
6969
import Development.IDE.Spans.AtPoint (pointCommand)
7070

7171

72+
import qualified Development.IDE.Plugin.Completions.Types as C
7273
import GHC.Plugins (Depth (AllTheWay),
7374
mkUserStyle,
7475
neverQualify,
@@ -202,7 +203,7 @@ mkCompl
202203
_preselect = Nothing,
203204
_sortText = Nothing,
204205
_filterText = Nothing,
205-
_insertText = Just insertText,
206+
_insertText = Just $ snippetToText insertText,
206207
_insertTextFormat = Just InsertTextFormat_Snippet,
207208
_insertTextMode = Nothing,
208209
_textEdit = Nothing,
@@ -242,10 +243,9 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..}
242243
isTypeCompl = isTcOcc origName
243244
typeText = Nothing
244245
label = stripOccNamePrefix $ printOutputable origName
245-
insertText = case isInfix of
246+
insertText = snippetText $ case isInfix of
246247
Nothing -> label
247248
Just LeftSide -> label <> "`"
248-
249249
Just Surrounded -> label
250250
additionalTextEdits =
251251
imp <&> \x ->
@@ -294,7 +294,7 @@ defaultCompletionItemWithLabel label =
294294
fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
295295
fromIdentInfo doc identInfo@IdentInfo{..} q = CI
296296
{ compKind= occNameToComKind name
297-
, insertText=rend
297+
, insertText= snippetText rend
298298
, provenance = DefinedIn mod
299299
, label=rend
300300
, typeText = Nothing
@@ -458,10 +458,11 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod
458458
]
459459

460460
mkLocalComp pos n ctyp ty =
461-
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
461+
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
462462
where
463463
occ = rdrNameOcc $ unLoc n
464464
pn = showForSnippet n
465+
sn = snippetText pn
465466

466467
findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem]
467468
findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result
@@ -638,7 +639,7 @@ getCompletions
638639
dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem)
639640
dotFieldSelectorToCompl recname label = (True, CI
640641
{ compKind = CompletionItemKind_Field
641-
, insertText = label
642+
, insertText = snippetText label
642643
, provenance = DefinedIn recname
643644
, label = label
644645
, typeText = Nothing
@@ -667,7 +668,7 @@ getCompletions
667668
endLoc = upperRange oldPos
668669
localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc
669670
localBindsToCompItem :: Name -> Maybe Type -> CompItem
670-
localBindsToCompItem name typ = CI ctyp pn thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True
671+
localBindsToCompItem name typ = CI ctyp (snippetText pn) thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True
671672
where
672673
occ = nameOccName name
673674
ctyp = occNameToComKind occ
@@ -736,7 +737,8 @@ uniqueCompl candidate unique =
736737
-- filter global completions when we already have a local one
737738
|| not(isLocalCompletion candidate) && isLocalCompletion unique
738739
then EQ
739-
else compare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique)
740+
else compare (importedFrom candidate) (importedFrom unique) <>
741+
snippetLexOrd (insertText candidate) (insertText unique)
740742
other -> other
741743
where
742744
importedFrom :: CompItem -> T.Text
@@ -805,9 +807,10 @@ mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r
805807
}
806808

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

812815
getImportQual :: LImportDecl GhcPs -> Maybe T.Text
813816
getImportQual (L _ imp)

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

Lines changed: 56 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,11 @@ import qualified Data.Text as T
1414

1515
import Data.Aeson
1616
import Data.Aeson.Types
17+
import Data.Function (on)
1718
import Data.Hashable (Hashable)
19+
import qualified Data.List as L
20+
import Data.List.NonEmpty (NonEmpty (..))
21+
import Data.String (IsString (..))
1822
import Data.Text (Text)
1923
import Development.IDE.GHC.Compat
2024
import Development.IDE.Graph (RuleResult)
@@ -81,9 +85,60 @@ data Provenance
8185
| Local SrcSpan
8286
deriving (Eq, Ord, Show)
8387

88+
newtype Snippet = Snippet [SnippetAny]
89+
deriving (Eq, Show)
90+
deriving newtype (Semigroup, Monoid)
91+
92+
instance IsString Snippet where
93+
fromString = snippetText . T.pack
94+
95+
-- | @SnippetAny@ can be used to construct sanitized snippets. See the LSP
96+
-- spec for more details.
97+
data SnippetAny
98+
= SText Text
99+
-- ^ Literal text
100+
| STabStop Int (Maybe SnippetAny)
101+
-- ^ Creates a tab stop, i.e. parts of the snippet that are meant to be
102+
-- filled in by the user and that can be jumped between using the tab key.
103+
-- The optional field can be used to provide a placeholder value.
104+
| SChoice Int (NonEmpty Text)
105+
-- ^ Presents a choice between the provided values to the user
106+
| SVariable Text (Maybe SnippetAny)
107+
-- ^ Snippet variable. See the spec for possible values. The optional field
108+
-- can be used to provide a default value for when the variable is not set.
109+
deriving (Eq, Show)
110+
111+
snippetText :: Text -> Snippet
112+
snippetText = Snippet . L.singleton . SText
113+
114+
snippetVariable :: Text -> Snippet
115+
snippetVariable n = Snippet . L.singleton $ SVariable n Nothing
116+
117+
snippetVariableDefault :: Text -> SnippetAny -> Snippet
118+
snippetVariableDefault n d = Snippet . L.singleton . SVariable n $ Just d
119+
120+
snippetToText :: Snippet -> Text
121+
snippetToText (Snippet l) = foldMap (snippetAnyToText False) l
122+
where
123+
snippetAnyToText isNested = \case
124+
SText t -> sanitizeText isNested t
125+
STabStop i ph -> "${" <> T.pack (show i) <> foldMap (\p -> ":" <> snippetAnyToText True p) ph <> "}"
126+
SChoice i (c :| cs) -> "${" <> T.pack (show i) <> "|" <> c <> foldMap ("," <>) cs <> "}"
127+
SVariable n md -> "${" <> n <> foldMap (\x -> ":" <> snippetAnyToText True x) md <> "}"
128+
sanitizeText isNested = T.foldl' (sanitizeChar isNested) mempty
129+
sanitizeChar isNested t = (t <>) . \case
130+
'$' -> "\\$"
131+
'\\' -> "\\\\"
132+
',' | isNested -> "\\,"
133+
'|' | isNested -> "\\|"
134+
c -> T.singleton c
135+
136+
snippetLexOrd :: Snippet -> Snippet -> Ordering
137+
snippetLexOrd = compare `on` snippetToText
138+
84139
data CompItem = CI
85140
{ compKind :: CompletionItemKind
86-
, insertText :: T.Text -- ^ Snippet for the completion
141+
, insertText :: Snippet -- ^ Snippet for the completion
87142
, provenance :: Provenance -- ^ From where this item is imported from.
88143
, label :: T.Text -- ^ Label to display to the user.
89144
, typeText :: Maybe T.Text

0 commit comments

Comments
 (0)