haskell-lsp 0.12.0.0 → 0.12.1.0

raw patch · 8 files changed

+206/−11 lines, 8 filesdep +temporarydep ~rope-utf16-splayPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: temporary

Dependency ranges changed: rope-utf16-splay

API changes (from Hackage documentation)

Files

• ChangeLog.md +21/−0
• example/Main.hs +1/−1
• haskell-lsp.cabal +10/−2
• src/Language/Haskell/LSP/Core.hs +34/−0
• src/Language/Haskell/LSP/Utility.hs +0/−2
• src/Language/Haskell/LSP/VFS.hs +83/−5
• test/JsonSpec.hs +1/−1
• test/VspSpec.hs +56/−0

@@ -1,5 +1,26 @@ # Revision history for haskell-lsp +## 0.12.1.0 -- 2019-05-08++* Bring over functions from @mpickering's hie-bios.+  So `LspFuncs` now includes++```haskell+    , persistVirtualFileFunc       :: !(J.Uri -> IO FilePath)+    , reverseFileMapFunc           :: !(IO (FilePath -> FilePath))+ ```++* Fix exception on empty filepaths++* Migrate some utility functions from `haskell-ide-engine`, for the+  benefit of other language servers.+  - `rangeLinesFromVfs`+  - `PosPrefixInfo(..)`+  - `getCompletionPrefix`++* Remove `HoverContentsEmpty`. It is unnecessary, and generated+  illegal JSON on the wire.+ ## 0.12.0.0 -- 2019-05-05  * Added A NFData instance for Diagnostics (@DavidM-D/@ndmitchell)

@@ -194,7 +194,7 @@                                  . J.uri         mdoc <- liftIO $ Core.getVirtualFileFunc lf doc         case mdoc of-          Just (VirtualFile _version str) -> do+          Just (VirtualFile _version str _) -> do             liftIO $ U.logs $ "reactor:processing NotDidChangeTextDocument: vf got:" ++ (show $ Rope.toString str)           Nothing -> do             liftIO $ U.logs "reactor:processing NotDidChangeTextDocument: vf returned Nothing"

@@ -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,9 +50,10 @@                      , mtl                      , network-uri                      , parsec-                     , rope-utf16-splay >= 0.2+                     , rope-utf16-splay >= 0.3.1.0                      , sorted-list == 0.2.1.*                      , stm+                     , temporary                      , text                      , time                      , unordered-containers@@ -123,6 +124,13 @@                      , 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

@@ -156,6 +156,8 @@       -- server-provided function.     , sendFunc                     :: !SendFunc     , getVirtualFileFunc           :: !(J.Uri -> IO (Maybe VirtualFile))+    , persistVirtualFileFunc       :: !(J.Uri -> IO FilePath)+    , reverseFileMapFunc           :: !(IO (FilePath -> FilePath))     , publishDiagnosticsFunc       :: !PublishDiagnosticsFunc     , flushDiagnosticsBySourceFunc :: !FlushDiagnosticsBySourceFunc     , getNextReqId                 :: !(IO J.LspId)@@ -417,6 +419,36 @@ getVirtualFile :: TVar (LanguageContextData c) -> J.Uri -> IO (Maybe VirtualFile) getVirtualFile tvarDat uri = Map.lookup uri . resVFS <$> readTVarIO tvarDat +-- | Dump the current text for a given VFS file to a temporary file,+-- and return the path to the file.+persistVirtualFile :: TVar (LanguageContextData c) -> J.Uri -> IO FilePath+persistVirtualFile tvarDat uri = do+  st <- readTVarIO tvarDat+  let vfs = resVFS st+      revMap = reverseMap st++  (fn, new_vfs) <- persistFileVFS vfs uri+  let revMap' =+        -- TODO: Does the VFS make sense for URIs which are not files?+        -- The reverse map should perhaps be (FilePath -> URI)+        case J.uriToFilePath uri of+          Just uri_fp -> Map.insert fn uri_fp revMap+          Nothing -> revMap++  atomically $ modifyTVar' tvarDat (\d -> d { resVFS = new_vfs+                                            , reverseMap = revMap' })+  return fn++-- TODO: should this function return a URI?+-- | If the contents of a VFS has been dumped to a temporary file, map+-- the temporary file name back to the original one.+reverseFileMap :: TVar (LanguageContextData c)+               -> IO (FilePath -> FilePath)+reverseFileMap tvarDat = do+  revMap <- reverseMap <$> readTVarIO tvarDat+  let f fp = fromMaybe fp $ Map.lookup fp revMap+  return f+ -- ---------------------------------------------------------------------  getConfig :: TVar (LanguageContextData c) -> IO (Maybe c)@@ -691,6 +723,8 @@                             (getConfig tvarCtx)                             (resSendResponse ctx0)                             (getVirtualFile tvarCtx)+                            (persistVirtualFile tvarCtx)+                            (reverseFileMap tvarCtx)                             (publishDiagnostics tvarCtx)                             (flushDiagnosticsBySource tvarCtx)                             (getLspId $ resLspId ctx0)

@@ -43,7 +43,6 @@ lbs2str :: LBS.ByteString -> String lbs2str = TL.unpack. TLE.decodeUtf8 - -- ---------------------------------------------------------------------  logs :: String -> IO ()@@ -51,4 +50,3 @@  logm :: B.ByteString -> IO () logm str = logs (lbs2str str)-

@@ -16,22 +16,31 @@   , openVFS   , changeFromClientVFS   , changeFromServerVFS+  , 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 import           Data.Monoid #endif+import           System.IO.Temp import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import           Data.Maybe@@ -50,6 +59,7 @@   VirtualFile {       _version :: Int     , _text    :: Rope+    , _tmp_file :: Maybe FilePath     } deriving (Show)  type VFS = Map.Map J.Uri VirtualFile@@ -60,7 +70,7 @@ openVFS vfs (J.NotificationMessage _ _ params) = do   let J.DidOpenTextDocumentParams          (J.TextDocumentItem uri _ version text) = params-  return $ Map.insert uri (VirtualFile version (Rope.fromText text)) vfs+  return $ Map.insert uri (VirtualFile version (Rope.fromText text) Nothing) vfs  -- --------------------------------------------------------------------- @@ -70,10 +80,10 @@     J.DidChangeTextDocumentParams vid (J.List changes) = params     J.VersionedTextDocumentIdentifier uri version = vid   case Map.lookup uri vfs of-    Just (VirtualFile _ str) -> do+    Just (VirtualFile _ str _) -> do       let str' = applyChanges str changes       -- the client shouldn't be sending over a null version, only the server.-      return $ Map.insert uri (VirtualFile (fromMaybe 0 version) str') vfs+      return $ Map.insert uri (VirtualFile (fromMaybe 0 version) str' Nothing) vfs     Nothing -> do       logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri       return vfs@@ -107,11 +117,24 @@           ps = J.DidChangeTextDocumentParams vid (J.List changeEvents)           notif = J.NotificationMessage "" J.TextDocumentDidChange ps       changeFromClientVFS vfs notif-  +     editToChangeEvent (J.TextEdit range text) = J.TextDocumentContentChangeEvent (Just range) Nothing text  -- --------------------------------------------------------------------- +persistFileVFS :: VFS -> J.Uri -> IO (FilePath, VFS)+persistFileVFS vfs uri =+  case Map.lookup uri vfs of+    Nothing -> error ("File not found in VFS: " ++ show uri ++ show vfs)+    Just (VirtualFile v txt tfile) ->+      case tfile of+        Just tfn -> return (tfn, vfs)+        Nothing  -> do+          fn <- writeSystemTempFile "VFS.hs" (Rope.toString txt)+          return (fn, Map.insert uri (VirtualFile v txt (Just fn)) vfs)++-- ---------------------------------------------------------------------+ closeVFS :: VFS -> J.DidCloseTextDocumentNotification -> IO VFS closeVFS vfs (J.NotificationMessage _ _ params) = do   let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params@@ -159,5 +182,60 @@   where     (before, after) = Rope.splitAt start str     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  -- ---------------------------------------------------------------------

@@ -59,7 +59,7 @@ instance Arbitrary HoverContents where   arbitrary = oneof [ HoverContentsMS <$> arbitrary                     , HoverContents <$> arbitrary-                    , pure HoverContentsEmpty]+                    ]  -- | make lists of maximum length 3 for test performance smallList :: Gen a -> Gen [a]

@@ -6,6 +6,7 @@ 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 @@ 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 @@           [ "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))