Skip to content

Commit 0ba6a8e

Browse files
committed
WIP
1 parent 3b687a5 commit 0ba6a8e

File tree

10 files changed

+56
-34
lines changed

10 files changed

+56
-34
lines changed

cabal.project

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,9 @@ packages:
2727
./plugins/hls-alternate-number-format-plugin
2828
./plugins/hls-qualify-imported-names-plugin
2929
./plugins/hls-selection-range-plugin
30+
../lsp/lsp-types
31+
../lsp/lsp
32+
../lsp/lsp-test
3033

3134
-- Standard location for temporary packages needed for particular environments
3235
-- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
@@ -39,9 +42,13 @@ package *
3942
ghc-options: -haddock
4043
test-show-details: direct
4144

45+
package lsp
46+
-- The lsp test suite requires aeson 2, which we don't want to assume
47+
tests: false
48+
4249
write-ghc-environment-files: never
4350

44-
index-state: 2022-01-24T21:03:03Z
51+
index-state: 2022-02-19T21:03:03Z
4552

4653
constraints:
4754
hyphenation +embed

flake.nix

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -273,6 +273,7 @@
273273
# @guibou: I'm not sure theses lines are needed
274274
export LD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib:${capstone}/lib
275275
export DYLD_LIBRARY_PATH=${gmp}/lib:${zlib}/lib:${ncurses}/lib:${capstone}/lib
276+
export NIX_GHC_LIBDIR=${hpkgs.ghc}/lib/ghc-${hpkgs.ghc.version}
276277
export PATH=$PATH:$HOME/.local/bin
277278
278279
# Enable the shell hooks

ghcide/ghcide.cabal

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ library
4242
bytestring,
4343
case-insensitive,
4444
containers,
45+
co-log-core,
4546
data-default,
4647
deepseq,
4748
directory,
@@ -63,8 +64,8 @@ library
6364
lens,
6465
list-t,
6566
hiedb == 0.4.1.*,
66-
lsp-types ^>= 1.4.0.1,
67-
lsp ^>= 1.4.0.0 ,
67+
lsp-types ^>= 1.5.0.0,
68+
lsp ^>= 1.5.0.0 ,
6869
monoid-subclasses,
6970
mtl,
7071
network-uri,
@@ -75,7 +76,6 @@ library
7576
random,
7677
regex-tdfa >= 1.3.1.0,
7778
retrie,
78-
rope-utf16-splay,
7979
safe,
8080
safe-exceptions,
8181
hls-graph ^>= 1.6,
@@ -85,6 +85,7 @@ library
8585
stm-containers,
8686
syb,
8787
text,
88+
text-rope,
8889
time,
8990
transformers,
9091
unordered-containers >= 0.2.10.0,
@@ -396,14 +397,14 @@ test-suite ghcide-tests
396397
QuickCheck,
397398
quickcheck-instances,
398399
random,
399-
rope-utf16-splay,
400400
regex-tdfa ^>= 1.3.1,
401401
safe,
402402
safe-exceptions,
403403
shake,
404404
sqlite-simple,
405405
stm,
406406
stm-containers,
407+
text-rope,
407408
hls-graph,
408409
tasty,
409410
tasty-expected-failure,

ghcide/src/Development/IDE/Core/FileStore.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ import qualified Data.ByteString as BS
3636
import Data.Either.Extra
3737
import qualified Data.Map.Strict as Map
3838
import Data.Maybe
39-
import qualified Data.Rope.UTF16 as Rope
39+
import qualified Data.Text.Utf16.Rope as Rope
4040
import qualified Data.Text as T
4141
import Data.Time
4242
import Data.Time.Clock.POSIX
@@ -239,7 +239,7 @@ getFileContentsImpl vfs file = do
239239
time <- use_ GetModificationTime file
240240
res <- liftIO $ ideTryIOException file $ do
241241
mbVirtual <- getVirtualFile vfs $ filePathToUri' file
242-
pure $ Rope.toText . _text <$> mbVirtual
242+
pure $ virtualFileText <$> mbVirtual
243243
case res of
244244
Left err -> return ([err], Nothing)
245245
Right contents -> return ([], Just (time, contents))

ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,6 @@ import qualified Data.IntMap.Strict as IntMap
9090
import Data.List
9191
import qualified Data.Map as M
9292
import Data.Maybe
93-
import qualified Data.Rope.UTF16 as Rope
9493
import qualified Data.Set as Set
9594
import qualified Data.Text as T
9695
import qualified Data.Text.Encoding as T
@@ -560,7 +559,7 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe
560559
mvf <- getVirtualFile vfs $ filePathToUri' file
561560
case mvf of
562561
Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
563-
Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf)
562+
Just vf -> pure (virtualFileText vf, Just $ _lsp_version vf)
564563
let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res
565564
del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource
566565
pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver)

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

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Control.Concurrent.STM
1717
import Control.Monad.Extra
1818
import Control.Monad.IO.Class
1919
import Control.Monad.Reader
20+
import qualified Colog.Core as L
2021
import Data.Aeson (Value)
2122
import Data.Maybe
2223
import qualified Data.Set as Set
@@ -44,6 +45,7 @@ import qualified Development.IDE.Session as Session
4445
import qualified Development.IDE.Types.Logger as Logger
4546
import Development.IDE.Types.Shake (WithHieDb)
4647
import System.IO.Unsafe (unsafeInterleaveIO)
48+
import Data.Text.Prettyprint.Doc (pretty)
4749

4850
data Log
4951
= LogRegisteringIdeConfig !IdeConfiguration
@@ -52,6 +54,7 @@ data Log
5254
| LogReactorThreadStopped
5355
| LogCancelledRequest !SomeLspId
5456
| LogSession Session.Log
57+
| LogLsp LSP.LspServerLog
5558
deriving Show
5659

5760
instance Pretty Log where
@@ -71,6 +74,7 @@ instance Pretty Log where
7174
LogCancelledRequest requestId ->
7275
"Cancelled request" <+> viaShow requestId
7376
LogSession log -> pretty log
77+
LogLsp log -> pretty log
7478

7579
issueTrackerUrl :: T.Text
7680
issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"
@@ -152,8 +156,22 @@ runLanguageServer recorder options inH outH getHieDbLoc defaultConfig onConfigur
152156
, LSP.options = modifyOptions options
153157
}
154158

159+
-- Adapt our 'Recorder' into a 'LogAction' for 'lsp'
160+
let sevToPrio = \case
161+
L.Debug -> Debug
162+
L.Info -> Info
163+
L.Warning -> Warning
164+
L.Error -> Error
165+
let
166+
-- The IO-based logger the sever uses when starting up.
167+
ioLogger = L.LogAction $ \(L.WithSeverity l sev) -> logWith recorder (sevToPrio sev) (LogLsp l)
168+
-- The LPS-enabled logger the server uses once started. For now we just use the same logger.
169+
lspLogger = L.hoistLogAction liftIO ioLogger
170+
155171
void $ untilMVar clientMsgVar $
156172
void $ LSP.runServerWithHandles
173+
ioLogger
174+
lspLogger
157175
inH
158176
outH
159177
serverDefinition

ghcide/src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@ import Control.Applicative ((<|>))
2323
import Control.Arrow (second,
2424
(>>>))
2525
import Control.Concurrent.STM.Stats (atomically)
26-
import Control.Monad (guard, join,
27-
msum)
26+
import Control.Monad (guard, join)
2827
import Control.Monad.IO.Class
2928
import Data.Char
3029
import qualified Data.DList as DL
@@ -37,7 +36,6 @@ import Data.List.NonEmpty (NonEmpty ((:
3736
import qualified Data.List.NonEmpty as NE
3837
import qualified Data.Map as M
3938
import Data.Maybe
40-
import qualified Data.Rope.UTF16 as Rope
4139
import qualified Data.Set as S
4240
import qualified Data.Text as T
4341
import Data.Tuple.Extra (fst3)
@@ -47,7 +45,6 @@ import Development.IDE.Core.Service
4745
import Development.IDE.GHC.Compat
4846
import Development.IDE.GHC.Compat.Util
4947
import Development.IDE.GHC.Error
50-
import Development.IDE.GHC.ExactPrint
5148
import Development.IDE.GHC.Util (prettyPrint,
5249
printRdrName,
5350
traceAst,
@@ -79,7 +76,7 @@ import Language.LSP.Types (CodeAction (
7976
WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
8077
type (|?) (InR),
8178
uriToFilePath)
82-
import Language.LSP.VFS
79+
import qualified Language.LSP.VFS as VFS
8380
import Text.Regex.TDFA (mrAfter,
8481
(=~), (=~~))
8582

@@ -94,7 +91,7 @@ codeAction
9491
codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs}) = do
9592
contents <- LSP.getVirtualFile $ toNormalizedUri uri
9693
liftIO $ do
97-
let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
94+
let text = VFS.virtualFileText <$> contents
9895
mbFile = toNormalizedFilePath' <$> uriToFilePath uri
9996
diag <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
10097
(join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile

ghcide/test/exe/Main.hs

Lines changed: 15 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -22,14 +22,14 @@ import Control.Exception (bracket_, catch,
2222
import qualified Control.Lens as Lens
2323
import Control.Monad
2424
import Control.Monad.IO.Class (MonadIO, liftIO)
25-
import Data.Aeson (fromJSON, toJSON)
25+
import Data.Aeson (toJSON)
2626
import qualified Data.Aeson as A
2727
import Data.Default
2828
import Data.Foldable
2929
import Data.List.Extra
3030
import Data.Maybe
31-
import Data.Rope.UTF16 (Rope)
32-
import qualified Data.Rope.UTF16 as Rope
31+
import Data.Text.Utf16.Rope (Rope)
32+
import qualified Data.Text.Utf16.Rope as Rope
3333
import qualified Data.Set as Set
3434
import qualified Data.Text as T
3535
import Development.IDE.Core.PositionMapping (PositionResult (..),
@@ -6476,7 +6476,7 @@ positionMappingTests =
64766476
rope <- genRope
64776477
range <- genRange rope
64786478
PrintableText replacement <- arbitrary
6479-
let newRope = applyChange rope (TextDocumentContentChangeEvent (Just range) Nothing replacement)
6479+
newRope <- applyChange mempty rope (TextDocumentContentChangeEvent (Just range) Nothing replacement)
64806480
newPos <- genPosition newRope
64816481
pure (range, replacement, newPos)
64826482
forAll
@@ -6499,19 +6499,19 @@ genRope = Rope.fromText . getPrintableText <$> arbitrary
64996499

65006500
genPosition :: Rope -> Gen Position
65016501
genPosition r = do
6502-
let rows = Rope.rows r
6503-
row <- choose (0, max 0 $ rows - 1) `suchThat` inBounds @UInt
6504-
let columns = Rope.columns (nthLine row r)
6502+
let lines = Rope.lengthInLines r
6503+
line <- choose (0, max 0 $ lines - 1) `suchThat` inBounds @UInt
6504+
let columns = Rope.length (nthLine line r)
65056505
column <- choose (0, max 0 $ columns - 1) `suchThat` inBounds @UInt
6506-
pure $ Position (fromIntegral row) (fromIntegral column)
6506+
pure $ Position (fromIntegral line) (fromIntegral column)
65076507

65086508
genRange :: Rope -> Gen Range
65096509
genRange r = do
6510-
let rows = Rope.rows r
6510+
let lines = Rope.lengthInLines r
65116511
startPos@(Position startLine startColumn) <- genPosition r
6512-
let maxLineDiff = max 0 $ rows - 1 - fromIntegral startLine
6512+
let maxLineDiff = max 0 $ lines - 1 - fromIntegral startLine
65136513
endLine <- choose (fromIntegral startLine, fromIntegral startLine + maxLineDiff) `suchThat` inBounds @UInt
6514-
let columns = Rope.columns (nthLine (fromIntegral endLine) r)
6514+
let columns = Rope.length (nthLine (fromIntegral endLine) r)
65156515
endColumn <-
65166516
if fromIntegral startLine == endLine
65176517
then choose (fromIntegral startColumn, columns)
@@ -6523,12 +6523,11 @@ inBounds :: forall b a . (Integral a, Integral b, Bounded b) => a -> Bool
65236523
inBounds a = let i = toInteger a in i <= toInteger (maxBound @b) && i >= toInteger (minBound @b)
65246524

65256525
-- | Get the ith line of a rope, starting from 0. Trailing newline not included.
6526-
nthLine :: Int -> Rope -> Rope
6526+
nthLine :: Word -> Rope -> Rope
65276527
nthLine i r
6528-
| i < 0 = error $ "Negative line number: " <> show i
6529-
| i == 0 && Rope.rows r == 0 = r
6530-
| i >= Rope.rows r = error $ "Row number out of bounds: " <> show i <> "/" <> show (Rope.rows r)
6531-
| otherwise = Rope.takeWhile (/= '\n') $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (i - 1) r
6528+
| i == 0 && Rope.lengthInLines r == 0 = r
6529+
| i >= Rope.lengthInLines r = error $ "Row number out of bounds: " <> show i <> "/" <> show (Rope.lengthInLines r)
6530+
| otherwise = fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (i - 1) r
65326531

65336532
getWatchedFilesSubscriptionsUntil :: forall m. SServerMethod m -> Session [DidChangeWatchedFilesRegistrationOptions]
65346533
getWatchedFilesSubscriptionsUntil m = do

hls-plugin-api/hls-plugin-api.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ library
5050
, hslogger
5151
, lens
5252
, lens-aeson
53-
, lsp ^>=1.4.0.0
53+
, lsp ^>=1.5.0.0
5454
, opentelemetry
5555
, optparse-applicative
5656
, process

hls-test-utils/hls-test-utils.cabal

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,9 +45,9 @@ library
4545
, hls-graph
4646
, hls-plugin-api ^>=1.3
4747
, lens
48-
, lsp ^>=1.4
48+
, lsp ^>=1.5
4949
, lsp-test ^>=0.14
50-
, lsp-types ^>=1.4.0.1
50+
, lsp-types ^>=1.5.0.0
5151
, tasty
5252
, tasty-expected-failure
5353
, tasty-golden

0 commit comments

Comments
 (0)