Switch to rope-utf16-splay for ropes

* This makes the licensing story simpler because rope-utf16-splay is
BSD3 licensed. (haskell#16)
* LSP uses UTF-16 code unit based indexing, while the Yi rope library
indexes by characters. This means that haskell-lsp would previously not
correctly count characters that are encoded as two code units in
UTF-16. The rope-utf16-splay library uses code unit indexing, which
fixes this issue.
* From my benchmarks, this new library, which uses splay trees
internally, can be about twice as fast as finger tree based ones (like
the Yi one) for use cases that are similar to what haskell-lsp might be
doing (many consecutive modifications).

example/Main.hs

@@ -32,7 +32,7 @@ import qualified Language.Haskell.LSP.Utility          as U
 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 @@ reactor lf inp = do
         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"
 

haskell-lsp.cabal

@@ -49,12 +49,12 @@ library
                      , 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
 
@@ -77,13 +77,13 @@ executable lsp-hello
                      , 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
 
@@ -112,8 +112,8 @@ test-suite haskell-lsp-test
                      -- , hspec-jenkins
                      , lens >= 4.15.2
                      , network-uri
+                     , rope-utf16-splay >= 0.2
                      , sorted-list == 0.2.1.*
-                     , yi-rope
                      , haskell-lsp
                      , text
                      , stm

src/Language/Haskell/LSP/VFS.hs

@@ -21,9 +21,7 @@ module Language.Haskell.LSP.VFS
   -- * for tests
   , applyChanges
   , applyChange
-  , deleteChars , addChars
   , changeChars
-  , yiSplitAt
   ) where
 
 import           Control.Lens
@@ -37,10 +35,11 @@ import           Data.Monoid
 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 @@ import qualified Yi.Rope as Yi
 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.DidOpenTextDocumentNotification -> IO VFS
 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 @@ data TextDocumentContentChangeEvent =
 -- | 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'
+  = 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 + 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'
+    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) = 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'
-  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
 
 -- ---------------------------------------------------------------------

stack-8.0.2.yaml

@@ -6,6 +6,7 @@ packages:
 extra-deps:
 - sorted-list-0.2.1.0
 - aeson-1.2.4.0
+- rope-utf16-splay-0.2.0.0
 flags: {}
 extra-package-dbs: []
 nix:

stack-8.2.2.yaml

@@ -5,6 +5,7 @@ packages:
 - ./haskell-lsp-types
 extra-deps:
 - sorted-list-0.2.1.0
+- rope-utf16-splay-0.2.0.0
 flags: {}
 extra-package-dbs: []
 nix:

stack-8.4.2.yaml

@@ -5,7 +5,7 @@ packages:
 - ./haskell-lsp-types
 
 extra-deps:
-- yi-rope-0.11
+- rope-utf16-splay-0.2.0.0
 
 flags: {}
 extra-package-dbs: []

stack-8.4.3.yaml

@@ -5,6 +5,7 @@ packages:
 - ./haskell-lsp-types
 
 extra-deps:
+- rope-utf16-splay-0.2.0.0
 
 flags: {}
 extra-package-dbs: []

stack-8.6.1.yaml

@@ -5,6 +5,7 @@ packages:
 - ./haskell-lsp-types
 
 extra-deps:
+- rope-utf16-splay-0.2.0.0
 
 flags: {}
 extra-package-dbs: []

stack-8.6.3.yaml

@@ -5,6 +5,7 @@ packages:
 - ./haskell-lsp-types
 
 extra-deps:
+- rope-utf16-splay-0.2.0.0
 
 flags: {}
 extra-package-dbs: []

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 @@ vspSpec = do
           , "-- 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 @@ vspSpec = do
           , "-- 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 @@ vspSpec = do
           , "-- 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 @@ vspSpec = do
           , "-- 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 @@ vspSpec = do
           , "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 @@ vspSpec = do
           , "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 @@ vspSpec = do
           , "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 @@ vspSpec = do
           [ "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 @@ vspSpec = do
           , "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 @@ vspSpec = do
           , "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"