Escape dollar signs in completion snippets (#4745)

* Escape dollar signs in completion snippets * added Snippet * Added comments

Author: Soupstraw

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

@@ -69,6 +69,7 @@ import Development.IDE hiding (line)
 importDevelopment.IDE.Spans.AtPoint (pointCommand)
 
 
+importqualifiedDevelopment.IDE.Plugin.Completions.TypesasC
 importGHC.Plugins (Depth (AllTheWay),
 mkUserStyle,
 neverQualify,
@@ -202,7 +203,7 @@ mkCompl
  _preselect =Nothing,
  _sortText =Nothing,
  _filterText =Nothing,
- _insertText =Just insertText,
+ _insertText =Just$ snippetToText insertText,
  _insertTextFormat =JustInsertTextFormat_Snippet,
  _insertTextMode =Nothing,
  _textEdit =Nothing,
@@ -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
 JustLeftSide-> label <>"`"
-
 JustSurrounded-> label
  additionalTextEdits =
  imp <&>\x ->
@@ -294,7 +294,7 @@ defaultCompletionItemWithLabel label =
 fromIdentInfo::Uri->IdentInfo->MaybeT.Text->CompItem
 fromIdentInfo doc identInfo@IdentInfo{..} q =CI
 {compKind= occNameToComKind name
- , insertText=rend
+ , insertText= snippetText rend
  , provenance =DefinedInmod
  , label=rend
  , typeText =Nothing
@@ -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->TyClDeclGhcPs-> [CompItem]
 findRecordCompl uri mn DataDecl{tcdLName, tcdDataDefn} = result
@@ -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
@@ -667,7 +668,7 @@ getCompletions
  endLoc = upperRange oldPos
  localCompls =map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc
 localBindsToCompItem::Name->MaybeType->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
@@ -736,7 +737,8 @@ uniqueCompl candidate unique =
 -- filter global completions when we already have a local one
 ||not(isLocalCompletion candidate) && isLocalCompletion unique
 thenEQ
-elsecompare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique)
+elsecompare (importedFrom candidate) (importedFrom unique) <>
+ snippetLexOrd (insertText candidate) (insertText unique)
  other -> other
 where
 importedFrom::CompItem->T.Text
@@ -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::LImportDeclGhcPs->MaybeT.Text
 getImportQual (L _ imp)

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

@@ -14,7 +14,11 @@ import qualified Data.Text as T
 
 importData.Aeson
 importData.Aeson.Types
+importData.Function (on)
 importData.Hashable (Hashable)
+importqualifiedData.ListasL
+importData.List.NonEmpty (NonEmpty (..))
+importData.String (IsString (..))
 importData.Text (Text)
 importDevelopment.IDE.GHC.Compat
 importDevelopment.IDE.Graph (RuleResult)
@@ -81,9 +85,60 @@ data Provenance
  | LocalSrcSpan
 deriving (Eq, Ord, Show)
 
+newtypeSnippet=Snippet [SnippetAny]
+deriving (Eq, Show)
+derivingnewtype (Semigroup, Monoid)
+
+instanceIsStringSnippetwhere
+ fromString = snippetText .T.pack
+
+--| @SnippetAny@ can be used to construct sanitized snippets. See the LSP
+-- spec for more details.
+dataSnippetAny
+=STextText
+--^ Literal text
+ | STabStopInt (MaybeSnippetAny)
+--^ Creates a tab stop, i.e. parts of the snippet that are meant to be
+-- filled in by the user and that can be jumped between using the tab key.
+-- The optional field can be used to provide a placeholder value.
+ | SChoiceInt (NonEmptyText)
+--^ Presents a choice between the provided values to the user
+ | SVariableText (MaybeSnippetAny)
+--^ Snippet variable. See the spec for possible values. The optional field
+-- can be used to provide a default value for when the variable is not set.
+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 ph ->"${"<>T.pack (show i) <>foldMap (\p ->":"<> snippetAnyToText True p) ph <>"}"
+SChoice i (c :| cs) ->"${"<>T.pack (show i) <>"|"<> c <>foldMap (","<>) cs <>"}"
+SVariable n md ->"${"<> n <>foldMap (\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
+
 dataCompItem=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::MaybeT.Text