35e2d88 · ghcide · git.iko.soy

git.iko.soy/ghcide

Use FromServerMessage directly (#1583)

Previously we had two layers of indirection: In the compiler we emitted Event, we then translated this to ClientNotification which was then translated to FromServerMessage. Apart from being confusing and convoluted this also resulted in us doing the conversion to generic LSP types too late so we had scenario specific code in places where it shouldn’t be. This PR removes the indirection and just uses FromServerMessage directly.

commit35e2d881dd97f1252fc250b6d0c5452d1a1dc936 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateTue 11 Jun 2019, 16:03 (7 years ago) parent44b366e

5 files changed+29−26

compare with master

unifiedsplit

BUILD.bazel+1 src/Development/IDE/State/Service.hs+2−2 src/Development/IDE/State/Shake.hs+11−5 src/Development/IDE/Types/LSP.hs+11−16 test/Demo.hs+4−3

BUILD.bazel+1

@@ -75,6 +75,7 @@ da_haskell_binary(

7575 "filepath",

7676 "ghc-paths",

7777 "ghc",

78+ "haskell-lsp",

7879 "shake",

7980 "text",

8081 ],

src/Development/IDE/State/Service.hs+2−2

@@ -28,7 +28,7 @@ import Data.Set (Set)

2828import qualified Data.Set as Set

2929import Development.IDE.Functions.GHCError

3030import Development.Shake hiding (Diagnostic, Env, newCache)

31−import Development.IDE.Types.LSP as Compiler

31+import qualified Language.Haskell.LSP.Messages as LSP

3232

3333import UniqSupply

3434

@@ -69,7 +69,7 @@ unsafeClearDiagnostics = unsafeClearAllDiagnostics

6969

7070-- | Initialise the Compiler Service.

7171initialise :: Rules ()

72− -> (Event -> IO ())

72+ -> (LSP.FromServerMessage -> IO ())

7373 -> Logger.Handle

7474 -> IdeOptions

7575 -> VFSHandle

src/Development/IDE/State/Shake.hs+11−5

@@ -56,7 +56,6 @@ import Data.Either

5656import Data.List.Extra

5757import qualified Data.Text as T

5858import Development.IDE.Logger as Logger

59−import Development.IDE.Types.LSP

6059import Development.IDE.Types.Diagnostics hiding (getAllDiagnostics)

6160import qualified Development.IDE.Types.Diagnostics as D

6261import Control.Concurrent.Extra

@@ -64,6 +63,8 @@ import Control.Exception

6463import Control.DeepSeq

6564import System.Time.Extra

6665import Data.Typeable

66+import qualified Language.Haskell.LSP.Messages as LSP

67+import qualified Language.Haskell.LSP.Types as LSP

6768import System.FilePath hiding (makeRelative)

6869import qualified Development.Shake as Shake

6970import Control.Monad.Extra

@@ -76,7 +77,7 @@ import Numeric.Extra

7677

7778-- information we stash inside the shakeExtra field

7879data ShakeExtras = ShakeExtras

79− {eventer :: Event -> IO ()

80+ {eventer :: LSP.FromServerMessage -> IO ()

8081 ,logger :: Logger.Handle

8182 ,globals :: Var (Map.HashMap TypeRep Dynamic)

8283 ,state :: Var Values

@@ -211,7 +212,7 @@ getValues state key file = do

211212 pure $ fmap (fromJust . fromDynamic @v) v

212213

213214-- | Open a 'IdeState', should be shut using 'shakeShut'.

214−shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler

215+shakeOpen :: (LSP.FromServerMessage -> IO ()) -- ^ diagnostic handler

215216 -> Logger.Handle

216217 -> ShakeOptions

217218 -> Rules ()

@@ -396,14 +397,19 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, state} current = do

396397 let newDiags = getFileDiagnostics fp newDiagsStore

397398 pure (newDiagsStore, (newDiags, oldDiags))

398399 when (newDiags /= oldDiags) $

399− sendEvent $ EventFileDiagnostics (fp, newDiags)

400+ sendEvent $ publishDiagnosticsNotification fp newDiags

400401

402+publishDiagnosticsNotification :: FilePath -> [Diagnostic] -> LSP.FromServerMessage

403+publishDiagnosticsNotification fp diags =

404+ LSP.NotPublishDiagnostics $

405+ LSP.NotificationMessage "2.0" LSP.TextDocumentPublishDiagnostics $

406+ LSP.PublishDiagnosticsParams (filePathToUri' fp) (List diags)

401407

402408setPriority :: (Enum a) => a -> Action ()

403409setPriority p =

404410 deprioritize (fromIntegral . negate $ fromEnum p)

405411

406−sendEvent :: Event -> Action ()

412+sendEvent :: LSP.FromServerMessage -> Action ()

407413sendEvent e = do

408414 ShakeExtras{eventer} <- getShakeExtras

409415 liftIO $ eventer e

src/Development/IDE/Types/LSP.hs+11−16

@@ -1,18 +1,19 @@

22-- SPDX-License-Identifier: Apache-2.0

3−

3+{-# LANGUAGE PatternSynonyms #-}

44module Development.IDE.Types.LSP

55 ( HoverText(..)

6− , Event(..)

76 , VirtualResource(..)

87 , getHoverTextContent

8+ , pattern EventFileDiagnostics

99 ) where

1010

1111import Control.DeepSeq

1212import qualified Data.Text as T

13+import Development.IDE.Types.Diagnostics (uriToFilePath')

1314import GHC.Generics

14−

15−import Development.IDE.Types.Diagnostics

15+import Language.Haskell.LSP.Messages

16+import Language.Haskell.LSP.Types

1617

1718-- | Different types of content we can show on hover.

1819data HoverText

@@ -38,15 +39,9 @@ data VirtualResource = VRScenario

3839

3940instance NFData VirtualResource

4041

41−-- | Compiler service events

42−data Event

43− = EventFileDiagnostics !FileDiagnostics

44− -- ^ @EventFileDiagnostics fileDiagnostics@

45− -- How many validations have we finished of how many total

46− -- together with new file diagnostics for a given file.

47− | EventVirtualResourceChanged !VirtualResource T.Text

48− -- ^ @EventVirtualResourceChanged resource contents@ a virtual

49− -- resource @resource@ changed to @contents

50− -- NOTE(JM,MH): Keep the contents lazy as we rely on it in

51− -- 'manageOpenVRs'.

52− deriving Show

42+-- | Pattern synonym to make it a bit more convenient to match on diagnostics

43+-- in things like damlc test.

44+pattern EventFileDiagnostics :: FilePath -> [Diagnostic] -> FromServerMessage

45+pattern EventFileDiagnostics fp diags <-

46+ NotPublishDiagnostics

47+ (NotificationMessage _ _ (PublishDiagnosticsParams (uriToFilePath' -> Just fp) (List diags)))

test/Demo.hs+4−3

@@ -15,6 +15,7 @@ import Development.IDE.Types.Diagnostics

1515import Development.IDE.Types.Options

1616import Development.IDE.Logger

1717import qualified Data.Text.IO as T

18+import Language.Haskell.LSP.Messages

1819import System.Environment

1920import Data.List

2021import Data.Maybe

@@ -63,9 +64,9 @@ main = do

6364

6465

6566-- | Print an LSP event.

66−showEvent :: Lock -> Event -> IO ()

67−showEvent _ (EventFileDiagnostics (_, [])) = return ()

68−showEvent lock (EventFileDiagnostics (file, diags)) =

67+showEvent :: Lock -> FromServerMessage -> IO ()

68+showEvent _ (EventFileDiagnostics _ []) = return ()

69+showEvent lock (EventFileDiagnostics file diags) =

6970 withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,) diags

7071showEvent lock e = withLock lock $ print e

7172