diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index d91a12ddad..1dfebd9798 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/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, diff --git a/hls-plugin-api/src/Ide/Logger.hs b/hls-plugin-api/src/Ide/Logger.hs index d9d1eb95b3..5dbea5fe71 100644 --- a/hls-plugin-api/src/Ide/Logger.hs +++ b/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_ } = diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 59a8db8505..340469938a 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/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 ()) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index 93ea2657ea..069e0398f1 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/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 diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs index ae4579d115..d7a34fb924 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/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) diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index 566ba6e154..68d3fa1006 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/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 diff --git a/plugins/hls-class-plugin/test/testdata/T10.expected.hs b/plugins/hls-class-plugin/test/testdata/T10.expected.hs new file mode 100644 index 0000000000..54322231ba --- /dev/null +++ b/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 = () diff --git a/plugins/hls-class-plugin/test/testdata/T10.hs b/plugins/hls-class-plugin/test/testdata/T10.hs new file mode 100644 index 0000000000..71dfafac82 --- /dev/null +++ b/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 = ()