Move pragmas completion to pragmas plugin

haskell · Aug 28, 2021 · 445a7fc · 445a7fc
1 parent 6fa3e64
commit 445a7fc
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 30 deletions.
diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -299,11 +299,6 @@ mkExtCompl label =
     Nothing Nothing Nothing Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing Nothing Nothing
 
-mkPragmaCompl :: T.Text -> T.Text -> CompletionItem
-mkPragmaCompl label insertText =
-  CompletionItem label (Just CiKeyword) Nothing Nothing
-    Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
-    Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
 fromIdentInfo doc IdentInfo{..} q = CI
@@ -600,14 +595,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
         , enteredQual `T.isPrefixOf` label
         ]
 
-      filtListWithSnippet f list suffix =
-        [ toggleSnippets caps config (f label (snippet <> suffix))
-        | (snippet, label) <- list
-        , Fuzzy.test fullPrefix label
-        ]
-
       filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules
-      filtPragmaCompls = filtListWithSnippet mkPragmaCompl validPragmas
       filtOptsCompls   = filtListWith mkExtCompl
       filtKeywordCompls
           | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts)
@@ -628,8 +616,6 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
     -> return []
     | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine
     -> return $ filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False)
-    | "{-# " `T.isPrefixOf` fullLine
-    -> return $ filtPragmaCompls (pragmaSuffix fullLine)
     | otherwise -> do
         -- assumes that nubOrdBy is stable
         let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls
@@ -655,21 +641,6 @@ uniqueCompl x y =
 -- helper functions for pragmas
 -- ---------------------------------------------------------------------
 
-validPragmas :: [(T.Text, T.Text)]
-validPragmas =
-  [ ("LANGUAGE ${1:extension}"        , "LANGUAGE")
-  , ("OPTIONS_GHC -${1:option}"       , "OPTIONS_GHC")
-  , ("INLINE ${1:function}"           , "INLINE")
-  , ("NOINLINE ${1:function}"         , "NOINLINE")
-  , ("INLINABLE ${1:function}"        , "INLINABLE")
-  , ("WARNING ${1:message}"           , "WARNING")
-  , ("DEPRECATED ${1:message}"        , "DEPRECATED")
-  , ("ANN ${1:annotation}"            , "ANN")
-  , ("RULES"                          , "RULES")
-  , ("SPECIALIZE ${1:function}"       , "SPECIALIZE")
-  , ("SPECIALIZE INLINE ${1:function}", "SPECIALIZE INLINE")
-  ]
-
 pragmaSuffix :: T.Text -> T.Text
 pragmaSuffix fullLine
   |  "}" `T.isSuffixOf` fullLine = mempty

diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs
@@ -163,9 +163,16 @@ completion _ide _ complParams = do
                     | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix
                     = J.List $ map buildCompletion
                         (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)
+                    -- if there already is a closing bracket - complete without one
+                    | isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix
+                    = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing)
+                    -- if there is no closing bracket - complete with one
+                    | isPragmaPrefix (VFS.fullLine pfix)
+                    = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}"))
                     | otherwise
                     = J.List []
                 result Nothing = J.List []
+                isPragmaPrefix line = "{-#" `T.isPrefixOf` line
                 buildCompletion p =
                     J.CompletionItem
                       { _label = p,
@@ -187,8 +194,31 @@ completion _ide _ complParams = do
                         _xdata = Nothing
                       }
         _ -> return $ J.List []
-
 -----------------------------------------------------------------------
+validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)]
+validPragmas mSuffix =
+  [ ("LANGUAGE ${1:extension} #-" <> suffix         , "LANGUAGE",           "{-# LANGUAGE #-}")
+  , ("OPTIONS_GHC -${1:option} #-" <> suffix        , "OPTIONS_GHC",        "{-# OPTIONS_GHC #-}")
+  , ("INLINE ${1:function} #-" <> suffix            , "INLINE",             "{-# INLINE #-}")
+  , ("NOINLINE ${1:function} #-" <> suffix          , "NOINLINE",           "{-# NOINLINE #-}")
+  , ("INLINABLE ${1:function} #-"<> suffix          , "INLINABLE",          "{-# INLINABLE #-}")
+  , ("WARNING ${1:message} #-" <> suffix            , "WARNING",            "{-# WARNING #-}")
+  , ("DEPRECATED ${1:message} #-" <> suffix         , "DEPRECATED",         "{-# DEPRECATED  #-}")
+  , ("ANN ${1:annotation} #-" <> suffix             , "ANN",                "{-# ANN #-}")
+  , ("RULES #-}" <> suffix                          , "RULES",              "{-# RULES #-}")
+  , ("SPECIALIZE ${1:function} #-" <> suffix        , "SPECIALIZE",         "{-# SPECIALIZE #-}")
+  , ("SPECIALIZE INLINE ${1:function} #-"<> suffix  , "SPECIALIZE INLINE",  "{-# SPECIALIZE INLINE #-}")
+  ]
+  where suffix = case mSuffix of
+                  (Just s) -> s
+                  Nothing -> ""
+
+
+mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem
+mkPragmaCompl insertText label detail =
+  J.CompletionItem label (Just J.CiKeyword) Nothing (Just detail)
+    Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet)
+    Nothing Nothing Nothing Nothing Nothing Nothing
 
 -- | Find first line after the last file header pragma
 -- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or LANGUAGE pragma(s)