Skip to content

Commit bcddfda

Browse files
committed
[feat] syntactic highlighting
Use the GHC AST and lsp semantic tokens to convince the language server to give highlighting even without any editor highlighting plugins.
1 parent d2ac68b commit bcddfda

File tree

13 files changed

+351
-144
lines changed

13 files changed

+351
-144
lines changed

cabal.project

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,10 @@ packages:
1010

1111
index-state: 2025-07-09T16:51:20Z
1212

13+
optimization: False
14+
profiling: True
15+
profiling-detail: late
16+
1317
tests: True
1418
test-show-details: direct
1519

@@ -26,6 +30,8 @@ test-options: -j1
2630
-- haddock shown on hover
2731
package *
2832
ghc-options: -haddock
33+
profiling: True
34+
profiling-detail: late
2935

3036
constraints:
3137
-- C++ is hard to distribute, especially on older GHCs

exe/Wrapper.hs

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@ main = do
9898
Left err -> do
9999
T.hPutStrLn stderr (prettyError err NoShorten)
100100
case args of
101-
Ghcide (GhcideArguments { argsCommand = Main.LSP }) ->
101+
Ghcide (GhcideArguments { argsCommand = Main.LSP Main.StdIO }) ->
102102
launchErrorLSP recorder (prettyError err Shorten)
103103

104104
_ -> exitFailure
@@ -274,10 +274,6 @@ launchErrorLSP recorder errorMsg = do
274274
cwd <- getCurrentDirectory
275275
let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) cwd (IdePlugins [])
276276

277-
inH <- Main.argsHandleIn defaultArguments
278-
279-
outH <- Main.argsHandleOut defaultArguments
280-
281277
let parseConfig cfg _ = Right cfg
282278
onConfigChange _ = pure ()
283279

@@ -302,14 +298,16 @@ launchErrorLSP recorder errorMsg = do
302298
let interpretHandler (env, _st) = LSP.Iso (LSP.runLspT env . unErrorLSPM) liftIO
303299
pure (doInitialize, asyncHandlers, interpretHandler)
304300

305-
runLanguageServer (cmapWithPrio pretty recorder)
306-
(Main.argsLspOptions defaultArguments)
307-
inH
308-
outH
309-
(Main.argsDefaultHlsConfig defaultArguments)
310-
parseConfig
311-
onConfigChange
312-
setup
301+
let runServerWithCommunication comm =
302+
runLanguageServer (cmapWithPrio pretty recorder)
303+
(Main.argsLspOptions defaultArguments)
304+
comm
305+
(Main.argsDefaultHlsConfig defaultArguments)
306+
parseConfig
307+
onConfigChange
308+
setup
309+
310+
Main.commKindToCommunication (cmapWithPrio pretty recorder) runServerWithCommunication Main.StdIO
313311

314312
exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c)
315313
exitHandler exit = LSP.notificationHandler SMethod_Exit $ const $ liftIO exit

flake.nix

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@
6666
# This removes a rebuild with a different GHC version. The drawback of
6767
# this approach is that our shell may pull two GHC versions in scope.
6868
buildInputs = [
69+
hpkgs.haskell-language-server
6970
# Compiler toolchain
7071
hpkgs.ghc
7172
hpkgs.haskell-language-server

ghcide/exe/Arguments.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@
44
module Arguments(Arguments(..), getArguments) where
55

66
import Development.IDE (IdeState)
7-
import Development.IDE.Main (Command (..), commandP)
7+
import Development.IDE.Main (Command (..), CommunicationKind (..),
8+
commandP)
89
import Ide.Types (IdePlugins)
910
import Options.Applicative
1011

@@ -44,4 +45,4 @@ arguments plugins = Arguments
4445
<*> switch (long "conservative-change-tracking" <> help "disable reactive change tracking (for testing/debugging)")
4546
where
4647
checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
47-
lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client")
48+
lspCommand = LSP StdIO <$ flag' True (long "lsp" <> help "Start talking to an LSP client")

ghcide/ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ library
5151
, bytestring
5252
, case-insensitive
5353
, co-log-core
54+
, websockets
5455
, containers
5556
, cryptohash-sha1 >=0.11.100 && <0.12
5657
, data-default

ghcide/src/Development/IDE/GHC/Compat/Core.hs

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -630,11 +630,37 @@ instance HasSrcSpan SrcSpan where
630630
instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where
631631
getLoc = GHC.getLoc
632632

633+
#if MIN_VERSION_ghc(9,11,0)
634+
instance HasSrcSpan (GHC.EpToken sym) where
635+
getLoc = GHC.getHasLoc
636+
#else
637+
instance HasSrcSpan (GHC.EpToken sym) where
638+
getLoc = GHC.getHasLoc . \case
639+
GHC.NoEpTok -> Nothing
640+
GHC.EpTok loc -> Just loc
641+
#endif
642+
633643
#if MIN_VERSION_ghc(9,9,0)
634644
instance HasSrcSpan (EpAnn a) where
635645
getLoc = GHC.getHasLoc
636646
#endif
637647

648+
#if !MIN_VERSION_ghc(9,11,0)
649+
instance HasSrcSpan GHC.AddEpAnn where
650+
getLoc (GHC.AddEpAnn _ loc) = getLoc loc
651+
652+
instance HasSrcSpan GHC.EpaLocation where
653+
getLoc loc = GHC.getHasLoc loc
654+
#endif
655+
656+
#if !MIN_VERSION_ghc(9,11,0)
657+
instance HasSrcSpan GHC.LEpaComment where
658+
getLoc :: GHC.LEpaComment -> SrcSpan
659+
getLoc (GHC.L l _) = case l of
660+
SrcLoc.EpaDelta {} -> panic "compiler inserted epadelta into NoCommentsLocation"
661+
SrcLoc.EpaSpan span -> span
662+
#endif
663+
638664
#if MIN_VERSION_ghc(9,9,0)
639665
instance HasSrcSpan (SrcLoc.GenLocated (EpAnn ann) a) where
640666
getLoc (L l _) = getLoc l

ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module Development.IDE.LSP.LanguageServer
1111
, Log(..)
1212
, ThreadQueue
1313
, runWithWorkerThreads
14+
, Communication (..)
1415
) where
1516

1617
import Control.Concurrent.STM
@@ -27,16 +28,19 @@ import Ide.Types (traceWithSpan)
2728
import Language.LSP.Protocol.Message
2829
import Language.LSP.Protocol.Types
2930
import qualified Language.LSP.Server as LSP
30-
import System.IO
3131
import UnliftIO.Async
3232
import UnliftIO.Concurrent
3333
import UnliftIO.Directory
3434
import UnliftIO.Exception
3535

3636
import qualified Colog.Core as Colog
3737
import Control.Exception (BlockedIndefinitelyOnMVar (..))
38+
import Control.Exception.Backtrace (BacktraceMechanism (..),
39+
setBacktraceMechanismState)
3840
import Control.Monad.IO.Unlift (MonadUnliftIO)
3941
import Control.Monad.Trans.Cont (evalContT)
42+
import Data.ByteString
43+
import Data.ByteString.Lazy
4044
import Development.IDE.Core.IdeConfiguration
4145
import Development.IDE.Core.Shake hiding (Log)
4246
import Development.IDE.Core.Tracing
@@ -82,13 +86,17 @@ instance Pretty Log where
8286
LogLspServer msg -> pretty msg
8387
LogServerShutdownMessage -> "Received shutdown message"
8488

89+
data Communication
90+
= Communication
91+
{ inwards :: IO StrictByteString
92+
, outwards :: LazyByteString -> IO ()
93+
}
8594

8695
runLanguageServer
8796
:: forall config a m. (Show config)
8897
=> Recorder (WithPriority Log)
8998
-> LSP.Options
90-
-> Handle -- input
91-
-> Handle -- output
99+
-> Communication
92100
-> config
93101
-> (config -> Value -> Either T.Text config)
94102
-> (config -> m config ())
@@ -97,7 +105,7 @@ runLanguageServer
97105
LSP.Handlers (m config),
98106
(LanguageContextEnv config, a) -> m config <~> IO))
99107
-> IO ()
100-
runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigChange setup = do
108+
runLanguageServer recorder options comm defaultConfig parseConfig onConfigChange setup = do
101109
-- This MVar becomes full when the server thread exits or we receive exit message from client.
102110
-- LSP server will be canceled when it's full.
103111
clientMsgVar <- newEmptyMVar
@@ -120,11 +128,11 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
120128
lspCologAction = toCologActionWithPrio (cmapWithPrio LogLspServer recorder)
121129

122130
void $ untilMVar clientMsgVar $
123-
void $ LSP.runServerWithHandles
131+
void $ LSP.runServerWith
124132
lspCologAction
125133
lspCologAction
126-
inH
127-
outH
134+
(inwards comm)
135+
(outwards comm)
128136
serverDefinition
129137

130138
setupLSP ::

0 commit comments

Comments
 (0)