Fix #4935 and #4871

ghcide/src/Development/IDE/Types/Diagnostics.hs

@@ -164,7 +164,7 @@ ideErrorWithSource source sev fdFilePath msg origMsg =
   in
   ideErrorFromLspDiag lspDiagnostic fdFilePath origMsg
 
--- | Defines whether a particular diagnostic should be reported
+-- | Defines whether a particular diagnostic should be reported
 --   back to the user.
 --
 --   One important use case is "missing signature" code lenses,

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

@@ -84,7 +84,7 @@ data WithPriority a = WithPriority { priority :: Priority, callStack_ :: CallSta
 --   You shouldn't call warning/error if the user has caused an error, only
 --   if our code has gone wrong and is itself erroneous (e.g. we threw an exception).
 newtype Recorder msg = Recorder
-  { logger_ :: forall m. (MonadIO m) => msg -> m () }
+  { logger_ :: forall m. MonadIO m => msg -> m () }
 
 logWith :: (HasCallStack, MonadIO m) => Recorder (WithPriority msg) -> Priority -> msg -> m ()
 logWith recorder priority msg = withFrozenCallStack $ logger_ recorder (WithPriority priority callStack msg)
@@ -108,7 +108,7 @@ cmap :: (a -> b) -> Recorder b -> Recorder a
 cmap = contramap
 
 cmapWithPrio :: (a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
-cmapWithPrio f = cmap (fmap f)
+cmapWithPrio = cmap . fmap
 
 cmapIO :: (a -> IO b) -> Recorder b -> Recorder a
 cmapIO f Recorder{ logger_ } =

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

@@ -327,8 +327,8 @@ instance ToJSON PluginConfig where
 
 data PluginDescriptor (ideState :: Type) =
   PluginDescriptor { pluginId           :: !PluginId
-                   , pluginDescription  :: !T.Text
                    -- ^ Unique identifier of the plugin.
+                   , pluginDescription  :: !T.Text
                    , pluginPriority     :: Natural
                    -- ^ Plugin handlers are called in priority order, higher priority first
                    , pluginRules        :: !(Rules ())

plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs

@@ -8,6 +8,9 @@ import           Control.Monad.Trans.Maybe
 import           Data.Either.Extra                       (eitherToMaybe)
 import qualified Data.Text                               as T
 import           Development.IDE.GHC.Compat
+#if !MIN_VERSION_ghc(9,11,0)
+import           GHC.Data.Bag                            (bagToList)
+#endif
 import           GHC.Parser.Annotation
 import           Ide.Plugin.Class.Types
 import           Ide.Plugin.Class.Utils
@@ -65,15 +68,26 @@ addMethodDecls ps mDecls range withSig
         case break (inRange range . getLoc) allDecls of
             (before, L l inst : after) ->
                 let
+                    indent = case inst of
+                                InstD _ (ClsInstD{..}) | fstBind:_ <-
+#if !MIN_VERSION_ghc(9,11,0)
+                                                                      bagToList $
+#endif
+                                                                      cid_binds cid_inst,
+                                                         (RealSrcSpan indent _) <- getLoc fstBind
+                                  -> srcSpanStartCol indent
+                                _ -> defaultIndent + 1
+#if MIN_VERSION_ghc(9,11,0) || !MIN_VERSION_ghc(9,9,0)
+                           - 1
+#endif
+#if MIN_VERSION_ghc(9,9,0)
                     instSpan = realSrcSpan $ getLoc l
-#if MIN_VERSION_ghc(9,11,0)
-                    instCol = srcSpanStartCol instSpan - 1
-#else
                     instCol = srcSpanStartCol instSpan
+#if MIN_VERSION_ghc(9,11,0)
+                            - 1
 #endif
-#if MIN_VERSION_ghc(9,9,0)
                     instRow = srcSpanEndLine instSpan
-                    methodEpAnn = noAnnSrcSpanDP $ deltaPos 1 (instCol + defaultIndent)
+                    methodEpAnn = noAnnSrcSpanDP $ deltaPos 1 indent
                     -- Put each TyCl method/type signature on separate line, indented by 2 spaces relative to instance decl
                     newLine (L _ e) = L methodEpAnn e
 
@@ -85,7 +99,7 @@ addMethodDecls ps mDecls range withSig
                             in setEntryDP followingDecl delta)
 #else
                     newLine (L l e) =
-                        let dp = deltaPos 1 (instCol + defaultIndent - 1)
+                        let dp = deltaPos 1 indent
                         in L (noAnnSrcSpanDP (getLoc l) dp <> l) e
 
                     resetFollowing = id

plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs

@@ -37,7 +37,7 @@ isBindingName name =
   let bindingName = occNameString $ nameOccName name
    in isPrefixOf bindingPrefix bindingName && not (isSuperClassesBindingPrefix bindingName)
 
--- | Check if some `HasSrcSpan` value in the given range
+-- | Check if some `HasSrcSpan` value is in the given range
 inRange :: Range -> SrcSpan -> Bool
 inRange range s = maybe False (subRange range) (srcSpanToRange s)
 

plugins/hls-class-plugin/test/Main.hs

@@ -66,6 +66,8 @@ codeActionTests = testGroup
       getActionByTitle "Add placeholders for 'g','h'"
   , goldenWithClass "Creates a placeholder when all top-level decls are indented" "T7" "" $
       getActionByTitle "Add placeholders for 'g','h','i'"
+  , goldenWithClass "Creates a placeholder when non-missing methods have non-default indentation" "T10" "" $
+      getActionByTitle "Add placeholders for 'g'"
   , testGroup "with preprocessors"
     [ knownBrokenInEnv [GhcVer GHC910]
         "See issue https://github.com/haskell/haskell-language-server/issues/4731 for details." $
@@ -167,7 +169,7 @@ goldenCodeLens title path idx =
         executeCommand $ fromJust $ (List.sort lens !! idx) ^. L.command
         void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit)
 
-goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session CodeAction) -> TestTree
+goldenWithClass :: TestName -> FilePath -> FilePath -> ([CodeAction] -> Session CodeAction) -> TestTree
 goldenWithClass title path desc findAction =
   goldenWithHaskellDoc def classPlugin title testDataDir path (desc <.> "expected") "hs" $ \doc -> do
     _ <- waitForDiagnosticsFrom doc

plugins/hls-class-plugin/test/testdata/T10.expected.hs

@@ -0,0 +1,16 @@
+module T7 where
+
+    data X = X
+
+    class Test a where
+      f :: a -> a
+      g :: a
+
+    instance Test X where
+       f X = X
+       g = _
+
+
+
+
+    whiteSpaceBeforeAndIndentationOfThisShouldBePreserved = ()

plugins/hls-class-plugin/test/testdata/T10.hs

@@ -0,0 +1,15 @@
+module T7 where
+
+    data X = X
+
+    class Test a where
+      f :: a -> a
+      g :: a
+
+    instance Test X where
+       f X = X
+
+
+
+
+    whiteSpaceBeforeAndIndentationOfThisShouldBePreserved = ()