1{-# LANGUAGE OverloadedStrings #-}
2module VspSpec where
3
4
5import           Data.String
6import qualified Data.Rope.UTF16 as Rope
7import           Language.LSP.VFS
8import qualified Language.LSP.Types as J
9import qualified Data.Text as T
10
11import           Test.Hspec
12
13-- ---------------------------------------------------------------------
14
15main :: IO ()
16main = hspec spec
17
18spec :: Spec
19spec = describe "VSP functions" vspSpec
20
21-- -- |Used when running from ghci, and it sets the current directory to ./tests
22-- tt :: IO ()
23-- tt = do
24--   cd ".."
25--   hspec spec
26
27-- ---------------------------------------------------------------------
28
29
30mkRange :: Int -> Int -> Int -> Int -> Maybe J.Range
31mkRange ls cs le ce = Just $ J.Range (J.Position ls cs) (J.Position le ce)
32
33vfsFromText :: T.Text -> VirtualFile
34vfsFromText text = VirtualFile 0 0 (Rope.fromText text)
35
36-- ---------------------------------------------------------------------
37
38vspSpec :: Spec
39vspSpec = do
40  describe "applys changes in order" $ do
41    it "handles vscode style undos" $ do
42      let orig = "abc"
43          changes =
44            [ J.TextDocumentContentChangeEvent (mkRange 0 2 0 3) Nothing ""
45            , J.TextDocumentContentChangeEvent (mkRange 0 1 0 2) Nothing ""
46            , J.TextDocumentContentChangeEvent (mkRange 0 0 0 1) Nothing ""
47            ]
48      applyChanges orig changes `shouldBe` ""
49    it "handles vscode style redos" $ do
50      let orig = ""
51          changes =
52            [ J.TextDocumentContentChangeEvent (mkRange 0 1 0 1) Nothing "a"
53            , J.TextDocumentContentChangeEvent (mkRange 0 2 0 2) Nothing "b"
54            , J.TextDocumentContentChangeEvent (mkRange 0 3 0 3) Nothing "c"
55            ]
56      applyChanges orig changes `shouldBe` "abc"
57
58    -- ---------------------------------
59
60  describe "deletes characters" $ do
61    it "deletes characters within a line" $ do
62      -- based on vscode log
63      let
64        orig = unlines
65          [ "abcdg"
66          , "module Foo where"
67          , "-- fooo"
68          , "foo :: Int"
69          ]
70        new = applyChange (fromString orig)
71                $ J.TextDocumentContentChangeEvent (mkRange 2 1 2 5) (Just 4) ""
72      lines (Rope.toString new) `shouldBe`
73          [ "abcdg"
74          , "module Foo where"
75          , "-oo"
76          , "foo :: Int"
77          ]
78
79    it "deletes characters within a line (no len)" $ do
80      let
81        orig = unlines
82          [ "abcdg"
83          , "module Foo where"
84          , "-- fooo"
85          , "foo :: Int"
86          ]
87        new = applyChange (fromString orig)
88                $ J.TextDocumentContentChangeEvent (mkRange 2 1 2 5) Nothing ""
89      lines (Rope.toString new) `shouldBe`
90          [ "abcdg"
91          , "module Foo where"
92          , "-oo"
93          , "foo :: Int"
94          ]
95
96    -- ---------------------------------
97
98    it "deletes one line" $ do
99      -- based on vscode log
100      let
101        orig = unlines
102          [ "abcdg"
103          , "module Foo where"
104          , "-- fooo"
105          , "foo :: Int"
106          ]
107        new = applyChange (fromString orig)
108                $ J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) (Just 8) ""
109      lines (Rope.toString new) `shouldBe`
110          [ "abcdg"
111          , "module Foo where"
112          , "foo :: Int"
113          ]
114
115    it "deletes one line(no len)" $ do
116      -- based on vscode log
117      let
118        orig = unlines
119          [ "abcdg"
120          , "module Foo where"
121          , "-- fooo"
122          , "foo :: Int"
123          ]
124        new = applyChange (fromString orig)
125                $ J.TextDocumentContentChangeEvent (mkRange 2 0 3 0) Nothing ""
126      lines (Rope.toString new) `shouldBe`
127          [ "abcdg"
128          , "module Foo where"
129          , "foo :: Int"
130          ]
131    -- ---------------------------------
132
133    it "deletes two lines" $ do
134      -- based on vscode log
135      let
136        orig = unlines
137          [ "module Foo where"
138          , "-- fooo"
139          , "foo :: Int"
140          , "foo = bb"
141          ]
142        new = applyChange (fromString orig)
143                $ J.TextDocumentContentChangeEvent (mkRange 1 0 3 0) (Just 19) ""
144      lines (Rope.toString new) `shouldBe`
145          [ "module Foo where"
146          , "foo = bb"
147          ]
148
149    it "deletes two lines(no len)" $ do
150      -- based on vscode log
151      let
152        orig = unlines
153          [ "module Foo where"
154          , "-- fooo"
155          , "foo :: Int"
156          , "foo = bb"
157          ]
158        new = applyChange (fromString orig)
159                $ J.TextDocumentContentChangeEvent (mkRange 1 0 3 0) Nothing ""
160      lines (Rope.toString new) `shouldBe`
161          [ "module Foo where"
162          , "foo = bb"
163          ]
164    -- ---------------------------------
165
166  describe "adds characters" $ do
167    it "adds one line" $ do
168      -- based on vscode log
169      let
170        orig = unlines
171          [ "abcdg"
172          , "module Foo where"
173          , "foo :: Int"
174          ]
175        new = applyChange (fromString orig)
176                $ J.TextDocumentContentChangeEvent (mkRange 1 16 1 16) (Just 0) "\n-- fooo"
177      lines (Rope.toString new) `shouldBe`
178          [ "abcdg"
179          , "module Foo where"
180          , "-- fooo"
181          , "foo :: Int"
182          ]
183
184    -- ---------------------------------
185
186    it "adds two lines" $ do
187      -- based on vscode log
188      let
189        orig = unlines
190          [ "module Foo where"
191          , "foo = bb"
192          ]
193        new = applyChange (fromString orig)
194                $ J.TextDocumentContentChangeEvent (mkRange 1 8 1 8) Nothing "\n-- fooo\nfoo :: Int"
195      lines (Rope.toString new) `shouldBe`
196          [ "module Foo where"
197          , "foo = bb"
198          , "-- fooo"
199          , "foo :: Int"
200          ]
201
202    -- ---------------------------------
203
204  describe "changes characters" $ do
205    it "removes end of a line" $ do
206      -- based on vscode log
207      let
208        orig = unlines
209          [ "module Foo where"
210          , "-- fooo"
211          , "foo :: Int"
212          , "foo = bb"
213          , ""
214          , "bb = 5"
215          , ""
216          , "baz = do"
217          , "  putStrLn \"hello world\""
218          ]
219        -- new = changeChars (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz ="
220        new = applyChange (fromString orig)
221                $ J.TextDocumentContentChangeEvent (mkRange 7 0 7 8) (Just 8) "baz ="
222      lines (Rope.toString new) `shouldBe`
223          [ "module Foo where"
224          , "-- fooo"
225          , "foo :: Int"
226          , "foo = bb"
227          , ""
228          , "bb = 5"
229          , ""
230          , "baz ="
231          , "  putStrLn \"hello world\""
232          ]
233    it "removes end of a line(no len)" $ do
234      -- based on vscode log
235      let
236        orig = unlines
237          [ "module Foo where"
238          , "-- fooo"
239          , "foo :: Int"
240          , "foo = bb"
241          , ""
242          , "bb = 5"
243          , ""
244          , "baz = do"
245          , "  putStrLn \"hello world\""
246          ]
247        -- new = changeChars (fromString orig) (J.Position 7 0) (J.Position 7 8) "baz ="
248        new = applyChange (fromString orig)
249                $ J.TextDocumentContentChangeEvent (mkRange 7 0 7 8) Nothing "baz ="
250      lines (Rope.toString new) `shouldBe`
251          [ "module Foo where"
252          , "-- fooo"
253          , "foo :: Int"
254          , "foo = bb"
255          , ""
256          , "bb = 5"
257          , ""
258          , "baz ="
259          , "  putStrLn \"hello world\""
260          ]
261    it "indexes using utf-16 code units" $ do
262      let
263        orig = unlines
264          [ "a��b"
265          , "a��b"
266          ]
267        new = applyChange (fromString orig)
268                $ J.TextDocumentContentChangeEvent (mkRange 1 0 1 3) (Just 3) "����"
269      lines (Rope.toString new) `shouldBe`
270          [ "a��b"
271          , "����b"
272          ]
273
274    -- ---------------------------------
275
276  describe "LSP utilities" $ do
277    it "splits at a line" $ do
278      let
279        orig = unlines
280          [ "module Foo where"
281          , "-- fooo"
282          , "foo :: Int"
283          , "foo = bb"
284          , ""
285          , "bb = 5"
286          , ""
287          , "baz = do"
288          , "  putStrLn \"hello world\""
289          ]
290        (left,right) = Rope.splitAtLine 4 (fromString orig)
291
292      lines (Rope.toString left) `shouldBe`
293          [ "module Foo where"
294          , "-- fooo"
295          , "foo :: Int"
296          , "foo = bb"
297          ]
298      lines (Rope.toString right) `shouldBe`
299          [ ""
300          , "bb = 5"
301          , ""
302          , "baz = do"
303          , "  putStrLn \"hello world\""
304          ]
305
306    -- ---------------------------------
307
308    it "getCompletionPrefix" $ do
309      let
310        orig = T.unlines
311          [ "{-# ings #-}"
312          , "import Data.List"
313          ]
314      pp4 <- getCompletionPrefix (J.Position 0 4) (vfsFromText orig)
315      pp4 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "" (J.Position 0 4))
316
317      pp5 <- getCompletionPrefix (J.Position 0 5) (vfsFromText orig)
318      pp5 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "i" (J.Position 0 5))
319
320      pp6 <- getCompletionPrefix (J.Position 0 6) (vfsFromText orig)
321      pp6 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "in" (J.Position 0 6))
322
323      pp14 <- getCompletionPrefix (J.Position 1 14) (vfsFromText orig)
324      pp14 `shouldBe` Just (PosPrefixInfo "import Data.List" "Data" "Li" (J.Position 1 14))
325
326      pp00 <- getCompletionPrefix (J.Position 0 0) (vfsFromText orig)
327      pp00 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "" (J.Position 0 0))
328