Skip to content

Commit 96a2550

Browse files
jetjinserjetjinser
committed
Merge remote-tracking branch 'upstream/master' into inlay-hints-record-wildcards
2 parents a4103bd + 9565d0b commit 96a2550

File tree

24 files changed

+446
-91
lines changed

24 files changed

+446
-91
lines changed

‎docs/features.md

+7-1
Original file line numberDiff line numberDiff line change
@@ -111,6 +111,7 @@ Completions for language pragmas.
111111
## Formatting
112112

113113
Format your code with various Haskell code formatters.
114+
The default Haskell code formatter is `ormolu`, and the Haskell formatter can be configured via the `formattingProvider` option.
114115

115116
| Formatter | Provided by |
116117
| --------------- | ---------------------------- |
@@ -119,12 +120,17 @@ Format your code with various Haskell code formatters.
119120
| Ormolu | `hls-ormolu-plugin` |
120121
| Stylish Haskell | `hls-stylish-haskell-plugin` |
121122

123+
---
124+
122125
Format your cabal files with a cabal code formatter.
126+
The default cabal code formatter is `cabal-gild`, which needs to be available on the `$PATH`,
127+
or the location needs to be explicitly provided.
128+
To change the cabal formatter, edit the `cabalFormattingProvider` option.
123129

124130
| Formatter | Provided by |
125131
|-----------------|------------------------------|
126132
| cabal-fmt | `hls-cabal-fmt-plugin` |
127-
133+
| cabal-gild | `hls-cabal-gild-plugin` |
128134

129135
## Document symbols
130136

‎ghcide/src/Development/IDE/Core/OfInterest.hs

+1
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import Development.IDE.Graph
2929
import Control.Concurrent.STM.Stats (atomically,
3030
modifyTVar')
3131
import Data.Aeson (toJSON)
32+
import qualified Data.Aeson as Aeson
3233
import qualified Data.ByteString as BS
3334
import Data.Maybe (catMaybes)
3435
import Development.IDE.Core.ProgressReporting

‎ghcide/src/Development/IDE/Core/Shake.hs

+29-10
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,8 @@ module Development.IDE.Core.Shake(
7373
garbageCollectDirtyKeysOlderThan,
7474
Log(..),
7575
VFSModified(..), getClientConfigAction,
76-
ThreadQueue(..)
76+
ThreadQueue(..),
77+
runWithSignal
7778
) where
7879

7980
import Control.Concurrent.Async
@@ -123,6 +124,10 @@ import Development.IDE.Core.FileUtils (getModTime)
123124
import Development.IDE.Core.PositionMapping
124125
import Development.IDE.Core.ProgressReporting
125126
import Development.IDE.Core.RuleTypes
127+
import Development.IDE.Types.Options as Options
128+
import qualified Language.LSP.Protocol.Message as LSP
129+
import qualified Language.LSP.Server as LSP
130+
126131
import Development.IDE.Core.Tracing
127132
import Development.IDE.Core.WorkerThread
128133
import Development.IDE.GHC.Compat (NameCache,
@@ -147,11 +152,11 @@ import qualified Development.IDE.Types.Exports as ExportsMap
147152
import Development.IDE.Types.KnownTargets
148153
import Development.IDE.Types.Location
149154
import Development.IDE.Types.Monitoring (Monitoring (..))
150-
import Development.IDE.Types.Options
151155
import Development.IDE.Types.Shake
152156
import qualified Focus
153157
import GHC.Fingerprint
154158
import GHC.Stack (HasCallStack)
159+
import GHC.TypeLits (KnownSymbol)
155160
import HieDb.Types
156161
import Ide.Logger hiding (Priority)
157162
import qualified Ide.Logger as Logger
@@ -165,7 +170,6 @@ import qualified Language.LSP.Protocol.Lens as L
165170
import Language.LSP.Protocol.Message
166171
import Language.LSP.Protocol.Types
167172
import qualified Language.LSP.Protocol.Types as LSP
168-
import qualified Language.LSP.Server as LSP
169173
import Language.LSP.VFS hiding (start)
170174
import qualified "list-t" ListT
171175
import OpenTelemetry.Eventlog hiding (addEvent)
@@ -1350,29 +1354,28 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
13501354
let uri' = filePathToUri' fp
13511355
let delay = if null newDiags then 0.1 else 0
13521356
registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
1353-
join $ mask_ $ do
1354-
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
1355-
let action = when (lastPublish /= newDiags) $ case lspEnv of
1357+
join $ mask_ $ do
1358+
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
1359+
let action = when (lastPublish /= newDiags) $ case lspEnv of
13561360
Nothing -> -- Print an LSP event.
13571361
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags)
13581362
Just env -> LSP.runLspT env $ do
13591363
liftIO $ tag "count" (show $ Prelude.length newDiags)
13601364
liftIO $ tag "key" (show k)
13611365
LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $
13621366
LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) newDiags
1363-
return action
1367+
return action
13641368
where
13651369
diagsFromRule :: Diagnostic -> Diagnostic
13661370
diagsFromRule c@Diagnostic{_range}
13671371
| coerce ideTesting = c & L.relatedInformation ?~
1368-
[
1369-
DiagnosticRelatedInformation
1372+
[ DiagnosticRelatedInformation
13701373
(Location
13711374
(filePathToUri $ fromNormalizedFilePath fp)
13721375
_range
13731376
)
13741377
(T.pack $ show k)
1375-
]
1378+
]
13761379
| otherwise = c
13771380

13781381

@@ -1444,3 +1447,19 @@ updatePositionMappingHelper ver changes mappingForUri = snd $
14441447
EM.mapAccumRWithKey (\acc _k (delta, _) -> let new = addOldDelta delta acc in (new, (delta, acc)))
14451448
zeroMapping
14461449
(EM.insert ver (mkDelta changes, zeroMapping) mappingForUri)
1450+
1451+
-- | sends a signal whenever shake session is run/restarted
1452+
-- being used in cabal and hlint plugin tests to know when its time
1453+
-- to look for file diagnostics
1454+
kickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [NormalizedFilePath] -> Proxy s -> Action ()
1455+
kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $
1456+
LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
1457+
toJSON $ map fromNormalizedFilePath files
1458+
1459+
-- | Add kick start/done signal to rule
1460+
runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
1461+
runWithSignal msgStart msgEnd files rule = do
1462+
ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras
1463+
kickSignal testing lspEnv files msgStart
1464+
void $ uses rule files
1465+
kickSignal testing lspEnv files msgEnd

‎haskell-language-server.cabal

+4-1
Original file line numberDiff line numberDiff line change
@@ -245,6 +245,7 @@ library hls-cabal-plugin
245245
Ide.Plugin.Cabal.FieldSuggest
246246
Ide.Plugin.Cabal.LicenseSuggest
247247
Ide.Plugin.Cabal.Orphans
248+
Ide.Plugin.Cabal.Outline
248249
Ide.Plugin.Cabal.Parse
249250

250251

@@ -282,6 +283,7 @@ test-suite hls-cabal-plugin-tests
282283
Completer
283284
Context
284285
Utils
286+
Outline
285287
build-depends:
286288
, base
287289
, bytestring
@@ -714,7 +716,6 @@ library hls-hlint-plugin
714716
, hlint >= 3.5 && < 3.9
715717
, hls-plugin-api == 2.9.0.1
716718
, lens
717-
, lsp
718719
, mtl
719720
, refact
720721
, regex-tdfa
@@ -725,6 +726,8 @@ library hls-hlint-plugin
725726
, unordered-containers
726727
, ghc-lib-parser-ex
727728
, apply-refact
729+
--
730+
, lsp-types
728731

729732
if flag(ghc-lib)
730733
cpp-options: -DGHC_LIB

‎hls-test-utils/src/Test/Hls.hs

+22-5
Original file line numberDiff line numberDiff line change
@@ -61,14 +61,17 @@ module Test.Hls
6161
WithPriority(..),
6262
Recorder,
6363
Priority(..),
64-
TestConfig(..),
64+
captureKickDiagnostics,
65+
kick,
66+
TestConfig(..)
6567
)
6668
where
6769

6870
import Control.Applicative.Combinators
6971
import Control.Concurrent.Async (async, cancel, wait)
7072
import Control.Concurrent.Extra
7173
import Control.Exception.Safe
74+
import Control.Lens ((^.))
7275
import Control.Lens.Extras (is)
7376
import Control.Monad (guard, unless, void)
7477
import Control.Monad.Extra (forM)
@@ -80,7 +83,7 @@ import qualified Data.Aeson as A
8083
import Data.ByteString.Lazy (ByteString)
8184
import Data.Default (Default, def)
8285
import qualified Data.Map as M
83-
import Data.Maybe (fromMaybe)
86+
import Data.Maybe (fromMaybe, mapMaybe)
8487
import Data.Proxy (Proxy (Proxy))
8588
import qualified Data.Text as T
8689
import qualified Data.Text.Lazy as TL
@@ -114,6 +117,7 @@ import Ide.PluginUtils (idePluginsToPluginDes
114117
pluginDescToIdePlugins)
115118
import Ide.Types
116119
import Language.LSP.Protocol.Capabilities
120+
import qualified Language.LSP.Protocol.Lens as L
117121
import Language.LSP.Protocol.Message
118122
import qualified Language.LSP.Protocol.Message as LSP
119123
import Language.LSP.Protocol.Types hiding (Null)
@@ -231,14 +235,14 @@ goldenWithTestConfig
231235
:: Pretty b
232236
=> TestConfig b
233237
-> TestName
234-
-> FilePath
238+
-> VirtualFileTree
235239
-> FilePath
236240
-> FilePath
237241
-> FilePath
238242
-> (TextDocumentIdentifier -> Session ())
239243
-> TestTree
240-
goldenWithTestConfig config title testDataDir path desc ext act =
241-
goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
244+
goldenWithTestConfig config title tree path desc ext act =
245+
goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
242246
$ runSessionWithTestConfig config $ const
243247
$ TL.encodeUtf8 . TL.fromStrict
244248
<$> do
@@ -869,6 +873,17 @@ setHlsConfig config = do
869873
-- requests!
870874
skipManyTill anyMessage (void configurationRequest)
871875

876+
captureKickDiagnostics :: Session () -> Session () -> Session [Diagnostic]
877+
captureKickDiagnostics start done = do
878+
_ <- skipManyTill anyMessage start
879+
messages <- manyTill anyMessage done
880+
pure $ concat $ mapMaybe diagnostics messages
881+
where
882+
diagnostics :: FromServerMessage' a -> Maybe [Diagnostic]
883+
diagnostics = \msg -> case msg of
884+
FromServerMess SMethod_TextDocumentPublishDiagnostics diags -> Just (diags ^. L.params . L.diagnostics)
885+
_ -> Nothing
886+
872887
waitForKickDone :: Session ()
873888
waitForKickDone = void $ skipManyTill anyMessage nonTrivialKickDone
874889

@@ -881,9 +896,11 @@ nonTrivialKickDone = kick (Proxy @"kick/done") >>= guard . not . null
881896
nonTrivialKickStart :: Session ()
882897
nonTrivialKickStart = kick (Proxy @"kick/start") >>= guard . not . null
883898

899+
884900
kick :: KnownSymbol k => Proxy k -> Session [FilePath]
885901
kick proxyMsg = do
886902
NotMess TNotificationMessage{_params} <- customNotification proxyMsg
887903
case fromJSON _params of
888904
Success x -> return x
889905
other -> error $ "Failed to parse kick/done details: " <> show other
906+

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
4141
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
4242
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
4343
import Ide.Plugin.Cabal.Orphans ()
44+
import Ide.Plugin.Cabal.Outline
4445
import qualified Ide.Plugin.Cabal.Parse as Parse
4546
import Ide.Types
4647
import qualified Language.LSP.Protocol.Lens as JL
@@ -90,6 +91,7 @@ descriptor recorder plId =
9091
mconcat
9192
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
9293
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
94+
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
9395
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
9496
]
9597
, pluginNotificationHandlers =
@@ -229,7 +231,7 @@ function invocation.
229231
kick :: Action ()
230232
kick = do
231233
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
232-
void $ uses Types.ParseCabalFile files
234+
Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
233235

234236
-- ----------------------------------------------------------------
235237
-- Code Actions

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs

+17-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where
1+
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where
22

33
import Data.List.NonEmpty (NonEmpty)
44
import qualified Data.List.NonEmpty as NE
@@ -66,3 +66,19 @@ getOptionalSectionName (x:xs) = case x of
6666
Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
6767
_ -> getOptionalSectionName xs
6868

69+
70+
-- | Makes a single text line out of multiple
71+
-- @SectionArg@s. Allows to display conditions,
72+
-- flags, etc in one line, which is easier to read.
73+
--
74+
-- For example, @flag@ @(@ @pedantic@ @)@ will be joined in
75+
-- one line, instead of four @SectionArg@s separately.
76+
onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text
77+
onelineSectionArgs sectionArgs = joinedName
78+
where
79+
joinedName = T.unwords $ map getName sectionArgs
80+
81+
getName :: Syntax.SectionArg Syntax.Position -> T.Text
82+
getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier
83+
getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString
84+
getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs

+7
Original file line numberDiff line numberDiff line change
@@ -180,3 +180,10 @@ lspPositionToCabalPosition :: Position -> Syntax.Position
180180
lspPositionToCabalPosition pos = Syntax.Position
181181
(fromIntegral (pos ^. JL.line) + 1)
182182
(fromIntegral (pos ^. JL.character) + 1)
183+
184+
-- | Convert an 'Syntax.Position' to a LSP 'Position'.
185+
--
186+
-- Cabal Positions start their indexing at 1 while LSP starts at 0.
187+
-- This helper makes sure, the translation is done properly.
188+
cabalPositionToLSPPosition :: Syntax.Position -> Position
189+
cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1)

0 commit comments

Comments
 (0)