diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for haskell-lsp +## 0.12.0.0 -- 2019-05-05 + +* Added A NFData instance for Diagnostics (@DavidM-D/@ndmitchell) +* Switch to using the rope-utf16-splay library for ropes (@ollef) + ## 0.11.0.0 -- 2019-04-28 * Add support for cancellable requests within `withProgress` and diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -32,7 +32,7 @@ import Language.Haskell.LSP.VFS import System.Exit import qualified System.Log.Logger as L -import qualified Yi.Rope as Yi +import qualified Data.Rope.UTF16 as Rope -- --------------------------------------------------------------------- @@ -195,7 +195,7 @@ mdoc <- liftIO $ Core.getVirtualFileFunc lf doc case mdoc of Just (VirtualFile _version str) -> do - liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: vf got:" ++ (show $ Yi.toString str) + liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: vf got:" ++ (show $ Rope.toString str) Nothing -> do liftIO $ U.logs "reactor:processing NotDidChangeTextDocument: vf returned Nothing" diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal --- a/haskell-lsp.cabal +++ b/haskell-lsp.cabal @@ -1,5 +1,5 @@ name: haskell-lsp -version: 0.11.0.0 +version: 0.12.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol description: An implementation of the types, and basic message server to @@ -14,7 +14,7 @@ license-file: LICENSE author: Alan Zimmerman maintainer: alan.zimm@gmail.com -copyright: Alan Zimmerman, 2016-2018 +copyright: Alan Zimmerman, 2016-2019 category: Development build-type: Simple extra-source-files: ChangeLog.md, README.md @@ -45,17 +45,17 @@ , filepath , hslogger , hashable - , haskell-lsp-types == 0.11.* + , haskell-lsp-types == 0.12.* , lens >= 4.15.2 , mtl , network-uri , parsec + , rope-utf16-splay >= 0.2 , sorted-list == 0.2.1.* , stm , text , time , unordered-containers - , yi-rope hs-source-dirs: src default-language: Haskell2010 @@ -78,13 +78,13 @@ , mtl , network-uri , parsec + , rope-utf16-splay >= 0.2 , stm , text , time , transformers , unordered-containers , vector - , yi-rope -- the package library. Comment this out if you want repl changes to propagate , haskell-lsp @@ -119,10 +119,10 @@ , lens >= 4.15.2 , network-uri , quickcheck-instances + , rope-utf16-splay >= 0.2 , sorted-list == 0.2.1.* , stm , text - , yi-rope build-tool-depends: hspec-discover:hspec-discover ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010 diff --git a/src/Language/Haskell/LSP/VFS.hs b/src/Language/Haskell/LSP/VFS.hs --- a/src/Language/Haskell/LSP/VFS.hs +++ b/src/Language/Haskell/LSP/VFS.hs @@ -21,9 +21,7 @@ -- * for tests , applyChanges , applyChange - , deleteChars , addChars , changeChars - , yiSplitAt ) where import Control.Lens @@ -37,10 +35,11 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import Data.Maybe +import Data.Rope.UTF16 ( Rope ) +import qualified Data.Rope.UTF16 as Rope import qualified Language.Haskell.LSP.Types as J import qualified Language.Haskell.LSP.Types.Lens as J import Language.Haskell.LSP.Utility -import qualified Yi.Rope as Yi -- --------------------------------------------------------------------- {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} @@ -50,7 +49,7 @@ data VirtualFile = VirtualFile { _version :: Int - , _text :: Yi.YiString + , _text :: Rope } deriving (Show) type VFS = Map.Map J.Uri VirtualFile @@ -61,7 +60,7 @@ openVFS vfs (J.NotificationMessage _ _ params) = do let J.DidOpenTextDocumentParams (J.TextDocumentItem uri _ version text) = params - return $ Map.insert uri (VirtualFile version (Yi.fromText text)) vfs + return $ Map.insert uri (VirtualFile version (Rope.fromText text)) vfs -- --------------------------------------------------------------------- @@ -132,87 +131,33 @@ -- | Apply the list of changes. -- Changes should be applied in the order that they are -- received from the client. -applyChanges :: Yi.YiString -> [J.TextDocumentContentChangeEvent] -> Yi.YiString +applyChanges :: Rope -> [J.TextDocumentContentChangeEvent] -> Rope applyChanges = foldl' applyChange -- --------------------------------------------------------------------- -applyChange :: Yi.YiString -> J.TextDocumentContentChangeEvent -> Yi.YiString +applyChange :: Rope -> J.TextDocumentContentChangeEvent -> Rope applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str) - = Yi.fromText str -applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range fm _to)) (Just len) txt) = - if txt == "" - then -- delete len chars from fm - deleteChars str fm len - else -- add or change, based on length - if len == 0 - then addChars str fm txt - -- Note: changeChars comes from applyEdit, emacs will split it into a - -- delete and an add - else changeChars str fm len txt -applyChange str (J.TextDocumentContentChangeEvent (Just r@(J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt) - = applyChange str (J.TextDocumentContentChangeEvent (Just r) (Just len) txt) - where len = Yi.length region - (beforeEnd, afterEnd) = Yi.splitAtLine el str - lastLine = Yi.take ec afterEnd - lastLine' | sl == el = Yi.drop sc lastLine - | otherwise = lastLine - (_beforeStart, afterStartBeforeEnd) = Yi.splitAtLine sl beforeEnd - region = Yi.drop sc afterStartBeforeEnd <> lastLine' -applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt) - = str - --- --------------------------------------------------------------------- - -deleteChars :: Yi.YiString -> J.Position -> Int -> Yi.YiString -deleteChars str (J.Position l c) len = str' - where - (before,after) = Yi.splitAtLine l str - -- after contains the area we care about, starting with the selected line. - -- Due to LSP zero-based coordinates - beforeOnLine = Yi.take c after - after' = Yi.drop (c + len) after - str' = Yi.append before (Yi.append beforeOnLine after') - --- --------------------------------------------------------------------- - -addChars :: Yi.YiString -> J.Position -> Text -> Yi.YiString -addChars str (J.Position l c) new = str' + = Rope.fromText str +applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) _to)) (Just len) txt) + = changeChars str start len txt where - (before,after) = Yi.splitAtLine l str - -- after contains the area we care about, starting with the selected line. - -- Due to LSP zero-based coordinates - beforeOnLine = Yi.take c after - after' = Yi.drop c after - str' = Yi.concat [before, beforeOnLine, (Yi.fromText new), after'] - --- --------------------------------------------------------------------- - -changeChars :: Yi.YiString -> J.Position -> Int -> Text -> Yi.YiString -changeChars str (J.Position ls cs) len new = str' + start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str +applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt) + = changeChars str start len txt where - (before,after) = yiSplitAt ls cs str - after' = Yi.drop len after - - str' = Yi.concat [before, (Yi.fromText new), after'] - --- changeChars :: Yi.YiString -> J.Position -> J.Position -> String -> Yi.YiString --- changeChars str (J.Position ls cs) (J.Position le ce) new = str' --- where --- (before,_after) = yiSplitAt ls cs str --- (_before,after) = yiSplitAt le ce str - --- str' = Yi.concat [before, (Yi.fromString new), after] --- -- str' = Yi.concat [before] --- -- str' = Yi.concat [_before] + start = Rope.rowColumnCodeUnits (Rope.RowColumn sl sc) str + end = Rope.rowColumnCodeUnits (Rope.RowColumn el ec) str + len = end - start +applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt) + = str -- --------------------------------------------------------------------- -yiSplitAt :: Int -> Int -> Yi.YiString -> (Yi.YiString, Yi.YiString) -yiSplitAt l c str = (before,after) +changeChars :: Rope -> Int -> Int -> Text -> Rope +changeChars str start len new = mconcat [before, Rope.fromText new, after'] where - (b,a) = Yi.splitAtLine l str - before = Yi.concat [b,Yi.take c a] - after = Yi.drop c a + (before, after) = Rope.splitAt start str + after' = Rope.drop len after -- --------------------------------------------------------------------- diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module TypesSpec where -import Data.Monoid +import Data.Monoid ((<>)) import qualified Language.Haskell.LSP.Types as J import Test.Hspec diff --git a/test/VspSpec.hs b/test/VspSpec.hs --- a/test/VspSpec.hs +++ b/test/VspSpec.hs @@ -2,9 +2,10 @@ module VspSpec where +import Data.String +import qualified Data.Rope.UTF16 as Rope import Language.Haskell.LSP.VFS import qualified Language.Haskell.LSP.Types as J -import qualified Yi.Rope as Yi import Test.Hspec @@ -62,9 +63,9 @@ , "-- fooo" , "foo :: Int" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 2 1 2 5) (Just 4) "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "abcdg" , "module Foo where" , "-oo" @@ -79,9 +80,9 @@ , "-- fooo" , "foo :: Int" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 2 1 2 5) Nothing "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "abcdg" , "module Foo where" , "-oo" @@ -99,9 +100,9 @@ , "-- fooo" , "foo :: Int" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) (Just 8) "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "abcdg" , "module Foo where" , "foo :: Int" @@ -116,9 +117,9 @@ , "-- fooo" , "foo :: Int" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) Nothing "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "abcdg" , "module Foo where" , "foo :: Int" @@ -134,9 +135,9 @@ , "foo :: Int" , "foo = bb" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 1 0 3 0) (Just 19) "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "module Foo where" , "foo = bb" ] @@ -150,9 +151,9 @@ , "foo :: Int" , "foo = bb" ] - new = applyChange (Yi.fromString orig) + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 1 0 3 0) Nothing "" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "module Foo where" , "foo = bb" ] @@ -167,8 +168,9 @@ , "module Foo where" , "foo :: Int" ] - new = addChars (Yi.fromString orig) (J.Position 1 16) "\n-- fooo" - lines (Yi.toString new) `shouldBe` + new = applyChange (fromString orig) + $ J.TextDocumentContentChangeEvent (mkRange 1 16 1 16) (Just 0) "\n-- fooo" + lines (Rope.toString new) `shouldBe` [ "abcdg" , "module Foo where" , "-- fooo" @@ -184,8 +186,9 @@ [ "module Foo where" , "foo = bb" ] - new = addChars (Yi.fromString orig) (J.Position 1 8) "\n-- fooo\nfoo :: Int" - lines (Yi.toString new) `shouldBe` + new = applyChange (fromString orig) + $ J.TextDocumentContentChangeEvent (mkRange 1 8 1 8) Nothing "\n-- fooo\nfoo :: Int" + lines (Rope.toString new) `shouldBe` [ "module Foo where" , "foo = bb" , "-- fooo" @@ -209,10 +212,10 @@ , "baz = do" , " putStrLn \"hello world\"" ] - -- new = changeChars (Yi.fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" - new = applyChange (Yi.fromString orig) + -- new = changeChars (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 7 0 7 8) (Just 8) "baz =" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "module Foo where" , "-- fooo" , "foo :: Int" @@ -237,10 +240,10 @@ , "baz = do" , " putStrLn \"hello world\"" ] - -- new = changeChars (Yi.fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" - new = applyChange (Yi.fromString orig) + -- new = changeChars (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz =" + new = applyChange (fromString orig) $ J.TextDocumentContentChangeEvent (mkRange 7 0 7 8) Nothing "baz =" - lines (Yi.toString new) `shouldBe` + lines (Rope.toString new) `shouldBe` [ "module Foo where" , "-- fooo" , "foo :: Int" @@ -250,4 +253,16 @@ , "" , "baz =" , " putStrLn \"hello world\"" + ] + it "indexes using utf-16 code units" $ do + let + orig = unlines + [ "a𐐀b" + , "a𐐀b" + ] + new = applyChange (fromString orig) + $ J.TextDocumentContentChangeEvent (mkRange 1 0 1 3) (Just 3) "𐐀𐐀" + lines (Rope.toString new) `shouldBe` + [ "a𐐀b" + , "𐐀𐐀b" ]