Merge branch 'master' into lockless-diagnostics

Author: pepeiborra

ghcide/.hlint.yaml

@@ -112,6 +112,7 @@
     - Development.IDE.Spans.Documentation
     - Development.IDE.Spans.Common
     - Development.IDE.Spans.AtPoint
+    - Development.IDE.Spans.Pragmas
     - Development.IDE.Plugin.CodeAction
     - Development.IDE.Plugin.Completions
     - Development.IDE.Plugin.Completions.Logic

ghcide/ghcide.cabal

@@ -186,6 +186,7 @@ library
         Development.IDE.Spans.Documentation
         Development.IDE.Spans.AtPoint
         Development.IDE.Spans.LocalBindings
+        Development.IDE.Spans.Pragmas
         Development.IDE.Types.Diagnostics
         Development.IDE.Types.Exports
         Development.IDE.Types.HscEnvEq

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

@@ -20,7 +20,6 @@ import           Data.List.Extra                          as List hiding
 import qualified Data.Map                                 as Map
 
 import           Data.Maybe                               (fromMaybe, isJust,
-                                                           listToMaybe,
                                                            mapMaybe)
 import qualified Data.Text                                as T
 import qualified Text.Fuzzy.Parallel                      as Fuzzy
@@ -480,7 +479,7 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result
                         (showGhc . unLoc $ con_name) field_labels mn doc Nothing
                  | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn
                  , Just  con_details <- [getFlds con_args]
-                 , let field_names = mapMaybe extract con_details
+                 , let field_names = concatMap extract con_details
                  , let field_labels = showGhc . unLoc <$> field_names
                  , (not . List.null) field_labels
                  ]
@@ -493,11 +492,18 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result
                              _           -> Nothing
 
         extract ConDeclField{..}
-             -- TODO: Why is cd_fld_names a list?
-            | Just fld_name <- rdrNameFieldOcc . unLoc <$> listToMaybe cd_fld_names = Just fld_name
-            | otherwise = Nothing
+            -- NOTE: 'cd_fld_names' is grouped so that the fields
+            -- sharing the same type declaration to fit in the same group; e.g.
+            --
+            -- @
+            --   data Foo = Foo {arg1, arg2 :: Int, arg3 :: Int, arg4 :: Bool}
+            -- @
+            --
+            -- is encoded as @[[arg1, arg2], [arg3], [arg4]]@
+            -- Hence, we must concat nested arguments into one to get all the fields.
+            = map (rdrNameFieldOcc . unLoc) cd_fld_names
         -- XConDeclField
-        extract _ = Nothing
+        extract _ = []
 findRecordCompl _ _ _ _ = []
 
 ppr :: Outputable a => a -> T.Text

ghcide/src/Development/IDE/Spans/Pragmas.hs

@@ -43,6 +43,7 @@ library
     , dependent-sum
     , Diff                  ^>=0.4.0
     , dlist
+    , extra
     , ghc
     , hashable
     , hls-graph             >=1.4 && < 1.6
@@ -54,6 +55,7 @@ library
     , process
     , regex-tdfa            >=1.3.1.0
     , text
+    , transformers
     , unordered-containers
 
   if os(windows)

hls-plugin-api/hls-plugin-api.cabal

@@ -26,14 +26,22 @@ module Ide.PluginUtils
     installSigUsr1Handler,
     subRange,
     usePropertyLsp,
+    response,
+    handleMaybe,
+    handleMaybeM,
     )
 where
 
 
+import           Control.Monad.Extra             (maybeM)
+import           Control.Monad.Trans.Class       (lift)
+import           Control.Monad.Trans.Except      (ExceptT, runExceptT, throwE)
 import           Data.Algorithm.Diff
 import           Data.Algorithm.DiffOutput
+import           Data.Bifunctor                  (Bifunctor (first))
 import           Data.Containers.ListUtils       (nubOrdOn)
 import qualified Data.HashMap.Strict             as H
+import           Data.String                     (IsString (fromString))
 import qualified Data.Text                       as T
 import           Ide.Plugin.Config
 import           Ide.Plugin.Properties
@@ -236,3 +244,15 @@ allLspCmdIds pid commands = concatMap go commands
   where
     go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds
 
+-- ---------------------------------------------------------------------
+
+handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
+handleMaybe msg = maybe (throwE msg) return
+
+handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
+handleMaybeM msg act = maybeM (throwE msg) return $ lift act
+
+response :: Monad m => ExceptT String m a -> m (Either ResponseError a)
+response =
+  fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
+    . runExceptT

hls-plugin-api/src/Ide/PluginUtils.hs

@@ -29,7 +29,6 @@ library
     , ghc-boot-th
     , hls-graph
     , hls-plugin-api       >=1.1 && < 1.3
-    , hls-retrie-plugin
     , hie-compat
     , lens
     , lsp
@@ -41,7 +40,6 @@ library
 
   default-language: Haskell2010
   default-extensions:
-    CPP
     LambdaCase
     NamedFieldPuns
     OverloadedStrings

plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal

@@ -23,7 +23,7 @@ import           Ide.Plugin.Conversion           (FormatType, alternateFormat,
                                                   toFormatTypes)
 import           Ide.Plugin.Literals             (Literal (..), collectLiterals,
                                                   getSrcSpan, getSrcText)
-import           Ide.Plugin.Retrie               (handleMaybe, handleMaybeM,
+import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
                                                   response)
 import           Ide.Types
 import           Language.LSP.Types

plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

@@ -90,10 +90,10 @@ import           Ide.Plugin.Eval.Parse.Comments  (commentsToSections)
 import           Ide.Plugin.Eval.Parse.Option    (parseSetFlags)
 import           Ide.Plugin.Eval.Rules           (queueForEvaluation)
 import           Ide.Plugin.Eval.Types
-import           Ide.Plugin.Eval.Util            (asS, gStrictTry, handleMaybe,
-                                                  handleMaybeM, isLiterate,
-                                                  logWith, response, response',
-                                                  timed)
+import           Ide.Plugin.Eval.Util            (asS, gStrictTry, isLiterate,
+                                                  logWith, response', timed)
+import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
+                                                  response)
 import           Ide.Types
 import           Language.LSP.Server
 import           Language.LSP.Types              hiding

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -7,22 +7,15 @@ module Ide.Plugin.Eval.Util (
     asS,
     timed,
     isLiterate,
-    handleMaybe,
-    handleMaybeM,
-    response,
     response',
     gStrictTry,
     logWith,
 ) where
 
 import           Control.Exception               (SomeException, evaluate)
-import           Control.Monad.Extra             (maybeM)
 import           Control.Monad.IO.Class          (MonadIO (liftIO))
-import           Control.Monad.Trans.Class       (lift)
-import           Control.Monad.Trans.Except      (ExceptT (..), runExceptT,
-                                                  throwE)
+import           Control.Monad.Trans.Except      (ExceptT (..), runExceptT)
 import           Data.Aeson                      (Value (Null))
-import           Data.Bifunctor                  (first)
 import           Data.String                     (IsString (fromString))
 import qualified Data.Text                       as T
 import           Development.IDE                 (IdeState, Priority (..),
@@ -71,17 +64,6 @@ logLevel = Debug -- Info
 isLiterate :: FilePath -> Bool
 isLiterate x = takeExtension x `elem` [".lhs", ".lhs-boot"]
 
-handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
-handleMaybe msg = maybe (throwE msg) return
-
-handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
-handleMaybeM msg act = maybeM (throwE msg) return $ lift act
-
-response :: Functor f => ExceptT String f c -> f (Either ResponseError c)
-response =
-    fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing))
-        . runExceptT
-
 response' :: ExceptT String (LspM c) WorkspaceEdit -> LspM c (Either ResponseError Value)
 response' act = do
     res <- runExceptT act