Rope util funcs

haskell-lsp-types/haskell-lsp-types.cabal

@@ -1,5 +1,5 @@
 name:                haskell-lsp-types
-version:             0.12.0.0
+version:             0.12.1.0
 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types
 
 description:         An implementation of the types to allow language implementors to

haskell-lsp.cabal

@@ -1,5 +1,5 @@
 name:                haskell-lsp
-version:             0.12.0.0
+version:             0.12.1.0
 synopsis:            Haskell library for the Microsoft Language Server Protocol
 
 description:         An implementation of the types, and basic message server to
@@ -50,7 +50,7 @@ library
                      , mtl
                      , network-uri
                      , parsec
-                     , rope-utf16-splay >= 0.2
+                     , rope-utf16-splay >= 0.3.1.0
                      , sorted-list == 0.2.1.*
                      , stm
                      , temporary
@@ -124,6 +124,13 @@ test-suite haskell-lsp-test
                      , sorted-list == 0.2.1.*
                      , stm
                      , text
+                     -- For GHCI tests
+                     -- , async
+                     -- , haskell-lsp-types
+                     -- , hslogger
+                     -- , temporary
+                     -- , time
+                     -- , unordered-containers
   build-tool-depends:  hspec-discover:hspec-discover
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
   default-language:    Haskell2010

src/Language/Haskell/LSP/Utility.hs

@@ -43,12 +43,10 @@ str2lbs = TLE.encodeUtf8 . TL.pack
 lbs2str :: LBS.ByteString -> String
 lbs2str = TL.unpack. TLE.decodeUtf8
 
-
 -- ---------------------------------------------------------------------
 
 logs :: String -> IO ()
 logs s = debugM _LOG_NAME s
 
 logm :: B.ByteString -> IO ()
 logm str = logs (lbs2str str)
-

src/Language/Haskell/LSP/VFS.hs

@@ -19,15 +19,22 @@ module Language.Haskell.LSP.VFS
   , persistFileVFS
   , closeVFS
 
+  -- * manipulating the file contents
+  , rangeLinesFromVfs
+  , PosPrefixInfo(..)
+  , getCompletionPrefix
+
   -- * for tests
   , applyChanges
   , applyChange
   , changeChars
   ) where
 
-import           Control.Lens
+import           Control.Lens hiding ( parts )
 import           Control.Monad
+import           Data.Char (isUpper, isAlphaNum)
 import           Data.Text ( Text )
+import qualified Data.Text as T
 import           Data.List
 import           Data.Ord
 #if __GLASGOW_HASKELL__ < 804
@@ -177,3 +184,58 @@ changeChars str start len new = mconcat [before, Rope.fromText new, after']
     after' = Rope.drop len after
 
 -- ---------------------------------------------------------------------
+
+-- TODO:AZ:move this to somewhere sane
+-- | Describes the line at the current cursor position
+data PosPrefixInfo = PosPrefixInfo
+  { fullLine :: T.Text
+    -- ^ The full contents of the line the cursor is at
+
+  , prefixModule :: T.Text
+    -- ^ If any, the module name that was typed right before the cursor position.
+    --  For example, if the user has typed "Data.Maybe.from", then this property
+    --  will be "Data.Maybe"
+
+  , prefixText :: T.Text
+    -- ^ The word right before the cursor position, after removing the module part.
+    -- For example if the user has typed "Data.Maybe.from",
+    -- then this property will be "from"
+  , cursorPos :: J.Position
+    -- ^ The cursor position
+  } deriving (Show,Eq)
+
+getCompletionPrefix :: (Monad m) => J.Position -> VirtualFile -> m (Maybe PosPrefixInfo)
+getCompletionPrefix pos@(J.Position l c) (VirtualFile _ yitext _) =
+      return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad
+        let headMaybe [] = Nothing
+            headMaybe (x:_) = Just x
+            lastMaybe [] = Nothing
+            lastMaybe xs = Just $ last xs
+
+        curLine <- headMaybe $ T.lines $ Rope.toText
+                             $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine l yitext
+        let beforePos = T.take c curLine
+        curWord <- case T.last beforePos of
+                     ' ' -> return "" -- don't count abc as the curword in 'abc '
+                     _ -> lastMaybe (T.words beforePos)
+
+        let parts = T.split (=='.')
+                      $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord
+        case reverse parts of
+          [] -> Nothing
+          (x:xs) -> do
+            let modParts = dropWhile (not . isUpper . T.head)
+                                $ reverse $ filter (not .T.null) xs
+                modName = T.intercalate "." modParts
+            return $ PosPrefixInfo curLine modName x pos
+
+-- ---------------------------------------------------------------------
+
+rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text
+rangeLinesFromVfs (VirtualFile _ yitext _) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r
+  where
+    (_ ,s1) = Rope.splitAtLine lf yitext
+    (s2, _) = Rope.splitAtLine (lt - lf) s1
+    r = Rope.toText s2
+
+-- ---------------------------------------------------------------------

stack-8.0.2.yaml

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

stack-8.2.2.yaml

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

stack-8.4.2.yaml

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

stack-8.4.3.yaml

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

stack-8.4.4.yaml

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

stack-8.6.1.yaml

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

stack-8.6.3.yaml

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

stack-8.6.4.yaml

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

test/VspSpec.hs

@@ -6,6 +6,7 @@ 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 Data.Text as T
 
 import           Test.Hspec
 
@@ -29,6 +30,9 @@ spec = describe "VSP functions" vspSpec
 mkRange :: Int -> Int -> Int -> Int -> Maybe J.Range
 mkRange ls cs le ce = Just $ J.Range (J.Position ls cs) (J.Position le ce)
 
+vfsFromText :: T.Text -> VirtualFile
+vfsFromText text = VirtualFile 0 (Rope.fromText text) Nothing
+
 -- ---------------------------------------------------------------------
 
 vspSpec :: Spec
@@ -266,3 +270,55 @@ vspSpec = do
           [ "a𐐀b"
           , "𐐀𐐀b"
           ]
+
+    -- ---------------------------------
+
+  describe "LSP utilities" $ do
+    it "splits at a line" $ do
+      let
+        orig = unlines
+          [ "module Foo where"
+          , "-- fooo"
+          , "foo :: Int"
+          , "foo = bb"
+          , ""
+          , "bb = 5"
+          , ""
+          , "baz = do"
+          , "  putStrLn \"hello world\""
+          ]
+        (left,right) = Rope.splitAtLine 4 (fromString orig)
+
+      lines (Rope.toString left) `shouldBe`
+          [ "module Foo where"
+          , "-- fooo"
+          , "foo :: Int"
+          , "foo = bb"
+          ]
+      lines (Rope.toString right) `shouldBe`
+          [ ""
+          , "bb = 5"
+          , ""
+          , "baz = do"
+          , "  putStrLn \"hello world\""
+          ]
+
+    -- ---------------------------------
+
+    it "getCompletionPrefix" $ do
+      let
+        orig = T.unlines
+          [ "{-# ings #-}"
+          , "import Data.List"
+          ]
+      pp4 <- getCompletionPrefix (J.Position 0 4) (vfsFromText orig)
+      pp4 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "" (J.Position 0 4))
+
+      pp5 <- getCompletionPrefix (J.Position 0 5) (vfsFromText orig)
+      pp5 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "i" (J.Position 0 5))
+
+      pp6 <- getCompletionPrefix (J.Position 0 6) (vfsFromText orig)
+      pp6 `shouldBe` Just (PosPrefixInfo "{-# ings #-}" "" "in" (J.Position 0 6))
+
+      pp14 <- getCompletionPrefix (J.Position 1 14) (vfsFromText orig)
+      pp14 `shouldBe` Just (PosPrefixInfo "import Data.List" "Data" "Li" (J.Position 1 14))