added Snippet

Author: Soupstraw

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)

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