haskell-lsp 0.18.0.0 → 0.19.0.0

raw patch · 6 files changed

+120/−44 lines, 6 filesdep ~haskell-lsp-typesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-lsp-types

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• haskell-lsp.cabal +3/−3
• src/Language/Haskell/LSP/Core.hs +11/−9
• src/Language/Haskell/LSP/VFS.hs +51/−15
• test/URIFilePathSpec.hs +47/−16
• test/VspSpec.hs +1/−1

@@ -1,5 +1,12 @@ # Revision history for haskell-lsp +## 0.19.0.0 -- 2019-12-14++* Fix vfs line endings (@jneira)+* Fix typo in .cabal (@turion)+* Normalize file paths before converting to Uri's (@jneira)+* Fixes to persistVirtualFile (@mpickering)+ ## 0.18.0.0 -- 2019-11-17  * Explain the use of NonEmpty in

@@ -1,5 +1,5 @@ name:                haskell-lsp-version:             0.18.0.0+version:             0.19.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol  description:         An implementation of the types, and basic message server to@@ -7,7 +7,7 @@                      Protocol for their specific language.                      .                      An example of this is for Haskell via the Haskell IDE-                     Engine, at https://github.com//haskell-ide-engine+                     Engine, at https://github.com/haskell/haskell-ide-engine  homepage:            https://github.com/alanz/haskell-lsp license:             MIT@@ -46,7 +46,7 @@                      , filepath                      , hslogger                      , hashable-                     , haskell-lsp-types == 0.18.*+                     , haskell-lsp-types == 0.19.*                      , lens >= 4.15.2                      , mtl                      , network-uri

@@ -177,7 +177,7 @@     , getVirtualFileFunc           :: !(J.NormalizedUri -> IO (Maybe VirtualFile))       -- ^ Function to return the 'VirtualFile' associated with a       -- given 'NormalizedUri', if there is one.-    , persistVirtualFileFunc       :: !(J.NormalizedUri -> IO FilePath)+    , persistVirtualFileFunc       :: !(J.NormalizedUri -> IO (Maybe FilePath))     , reverseFileMapFunc           :: !(IO (FilePath -> FilePath))     , publishDiagnosticsFunc       :: !PublishDiagnosticsFunc     , flushDiagnosticsBySourceFunc :: !FlushDiagnosticsBySourceFunc@@ -524,23 +524,25 @@  -- | Dump the current text for a given VFS file to a temporary file, -- and return the path to the file.-persistVirtualFile :: TVar (LanguageContextData config) -> J.NormalizedUri -> IO FilePath+persistVirtualFile :: TVar (LanguageContextData config) -> J.NormalizedUri -> IO (Maybe FilePath) persistVirtualFile tvarDat uri = join $ atomically $ do   st <- readTVar tvarDat   let vfs_data = resVFS st       cur_vfs = vfsData vfs_data       revMap = reverseMap vfs_data -  let (fn, write) = persistFileVFS cur_vfs uri-  let revMap' =+  case persistFileVFS cur_vfs uri of+    Nothing -> return (return Nothing)+    Just (fn, write) -> do+      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 (J.fromNormalizedUri uri) of-          Just uri_fp -> Map.insert fn uri_fp revMap-          Nothing -> revMap+            case J.uriToFilePath (J.fromNormalizedUri uri) of+              Just uri_fp -> Map.insert fn uri_fp revMap+              Nothing -> revMap -  modifyVFSData tvarDat (\d -> (d { reverseMap = revMap' }, ()))-  return (fn <$ write)+      modifyVFSData tvarDat (\d -> (d { reverseMap = revMap' }, ()))+      return ((Just fn) <$ write)  -- TODO: should this function return a URI? -- | If the contents of a VFS has been dumped to a temporary file, map

@@ -17,6 +17,9 @@   (     VFS(..)   , VirtualFile(..)+  , virtualFileText+  , virtualFileVersion+  -- * Managing the VFS   , initVFS   , openVFS   , changeFromClientVFS@@ -54,6 +57,7 @@ import           System.FilePath import           Data.Hashable import           System.Directory+import           System.IO  import           System.IO.Temp  -- ---------------------------------------------------------------------@@ -63,10 +67,13 @@  data VirtualFile =   VirtualFile {-      _version :: Int-    , _text    :: Rope+      _lsp_version :: !Int  -- ^ The LSP version of the document+    , _file_version :: !Int -- ^ This number is only incremented whilst the file+                           -- remains in the map.+    , _text    :: Rope  -- ^ The full contents of the document     } deriving (Show) + type VFSMap = Map.Map J.NormalizedUri VirtualFile  data VFS = VFS { vfsMap :: Map.Map J.NormalizedUri VirtualFile@@ -75,21 +82,31 @@  --- +virtualFileText :: VirtualFile -> Text+virtualFileText vf = Rope.toText (_text  vf)++virtualFileVersion :: VirtualFile -> Int+virtualFileVersion vf = _lsp_version vf++---+ initVFS :: (VFS -> IO r) -> IO r initVFS k = withSystemTempDirectory "haskell-lsp" $ \temp_dir -> k (VFS mempty temp_dir)  -- --------------------------------------------------------------------- +-- ^ Applies the changes from a 'DidOpenTextDocumentNotification' to the 'VFS' openVFS :: VFS -> J.DidOpenTextDocumentNotification -> (VFS, [String]) openVFS vfs (J.NotificationMessage _ _ params) =   let J.DidOpenTextDocumentParams          (J.TextDocumentItem uri _ version text) = params-  in (updateVFS (Map.insert (J.toNormalizedUri uri) (VirtualFile version (Rope.fromText text))) vfs+  in (updateVFS (Map.insert (J.toNormalizedUri uri) (VirtualFile version 0 (Rope.fromText text))) vfs      , [])   -- --------------------------------------------------------------------- +-- ^ Applies a 'DidChangeTextDocumentNotification' to the 'VFS' changeFromClientVFS :: VFS -> J.DidChangeTextDocumentNotification -> (VFS,[String]) changeFromClientVFS vfs (J.NotificationMessage _ _ params) =   let@@ -97,10 +114,10 @@     J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid   in     case Map.lookup uri (vfsMap vfs) of-      Just (VirtualFile _ str) ->+      Just (VirtualFile _ file_ver str) ->         let str' = applyChanges str changes         -- the client shouldn't be sending over a null version, only the server.-        in (updateVFS (Map.insert uri (VirtualFile (fromMaybe 0 version) str')) vfs, [])+        in (updateVFS (Map.insert uri (VirtualFile (fromMaybe 0 version) (file_ver + 1) str')) vfs, [])       Nothing ->         -- logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri         -- return vfs@@ -111,6 +128,7 @@  -- --------------------------------------------------------------------- +-- ^ Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS' changeFromServerVFS :: VFS -> J.ApplyWorkspaceEditRequest -> IO VFS changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do   let J.ApplyWorkspaceEditParams edit = params@@ -148,26 +166,44 @@  -- --------------------------------------------------------------------- virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath-virtualFileName prefix uri (VirtualFile ver _) =-  prefix </> show (hash (J.fromNormalizedUri uri)) ++ "-" ++ show ver ++ ".hs"+virtualFileName prefix uri (VirtualFile _ file_ver _) =+  let uri_raw = J.fromNormalizedUri uri+      basename = maybe "" takeFileName (J.uriToFilePath uri_raw)+      -- Given a length and a version number, pad the version number to+      -- the given n. Does nothing if the version number string is longer+      -- than the given length.+      padLeft :: Int -> Int -> String+      padLeft n num =+        let numString = show num+        in replicate (n - length numString) '0' ++ numString+  in prefix </> basename ++ "-" ++ padLeft 5 file_ver ++ "-" ++ show (hash uri_raw) ++ ".hs" -persistFileVFS :: VFS -> J.NormalizedUri -> (FilePath, IO ())+-- | Write a virtual file to a temporary file if it exists in the VFS.+persistFileVFS :: VFS -> J.NormalizedUri -> Maybe (FilePath, IO ()) persistFileVFS vfs uri =   case Map.lookup uri (vfsMap vfs) of-    Nothing -> error ("File not found in VFS: " ++ show uri ++ show vfs)-    Just vf@(VirtualFile _v txt) ->+    Nothing -> Nothing+    Just vf ->       let tfn = virtualFileName (vfsTempDir vfs) uri vf           action = do             exists <- doesFileExist tfn-            unless exists (writeFile tfn (Rope.toString txt))-      in (tfn, action)+            unless exists $ do+               let contents = Rope.toString (_text vf)+                   writeRaw h = do+                    -- We honour original file line endings+                    hSetNewlineMode h noNewlineTranslation+                    hPutStr h contents+               logs  $ "haskell-lsp:persistFileVFS: Writing virtual file: " +                    ++ "uri = " ++ show uri ++ ", virtual file = " ++ show tfn+               withFile tfn WriteMode writeRaw+      in Just (tfn, action)  -- ---------------------------------------------------------------------  closeVFS :: VFS -> J.DidCloseTextDocumentNotification -> (VFS, [String]) closeVFS vfs (J.NotificationMessage _ _ params) =   let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params-  in (updateVFS (Map.delete (J.toNormalizedUri uri)) vfs,[])+  in (updateVFS (Map.delete (J.toNormalizedUri uri)) vfs,["Closed: " ++ show uri])  -- --------------------------------------------------------------------- {-@@ -234,7 +270,7 @@   } deriving (Show,Eq)  getCompletionPrefix :: (Monad m) => J.Position -> VirtualFile -> m (Maybe PosPrefixInfo)-getCompletionPrefix pos@(J.Position l c) (VirtualFile _ ropetext) =+getCompletionPrefix pos@(J.Position l c) (VirtualFile _ _ ropetext) =       return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad         let headMaybe [] = Nothing             headMaybe (x:_) = Just x@@ -261,7 +297,7 @@ -- ---------------------------------------------------------------------  rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text-rangeLinesFromVfs (VirtualFile _ ropetext) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r+rangeLinesFromVfs (VirtualFile _ _ ropetext) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r   where     (_ ,s1) = Rope.splitAtLine lf ropetext     (s2, _) = Rope.splitAtLine (lt - lf) s1

@@ -11,7 +11,9 @@ import qualified System.FilePath.Windows as FPW import Test.Hspec import Test.QuickCheck-+#if !MIN_VERSION_QuickCheck(2,10,0)+import Data.Char                              (GeneralCategory(..), generalCategory)+#endif  -- --------------------------------------------------------------------- @@ -33,12 +35,21 @@ relativePosixFilePath :: FilePath relativePosixFilePath = "myself/example.hs" +withCurrentDirPosixFilePath :: FilePath+withCurrentDirPosixFilePath = "/home/./myself/././example.hs"+ testWindowsUri :: Uri-testWindowsUri = Uri $ pack "file:///c:/Users/myself/example.hs"+testWindowsUri = Uri $ pack "file:///C:/Users/myself/example.hs"  testWindowsFilePath :: FilePath-testWindowsFilePath = "c:\\Users\\myself\\example.hs"+testWindowsFilePath = "C:\\Users\\myself\\example.hs" +testWindowsFilePathDriveLowerCase :: FilePath+testWindowsFilePathDriveLowerCase = "c:\\Users\\myself\\example.hs"++withCurrentDirWindowsFilePath :: FilePath+withCurrentDirWindowsFilePath = "C:\\Users\\.\\myself\\.\\.\\example.hs"+ uriFilePathSpec :: Spec uriFilePathSpec = do   it "converts a URI to a POSIX file path" $ do@@ -57,31 +68,43 @@     let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePath     theUri `shouldBe` testWindowsUri +  it "removes unnecesary current directory paths" $ do+    let theUri = platformAwareFilePathToUri "posix" withCurrentDirPosixFilePath+    theUri `shouldBe` testPosixUri++  it "removes unnecesary current directory paths in windows" $ do+    let theUri = platformAwareFilePathToUri windowsOS withCurrentDirWindowsFilePath+    theUri `shouldBe` testWindowsUri++  it "make the drive letter upper case when converting a Windows file path to a URI" $ do+    let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePathDriveLowerCase+    theUri `shouldBe` testWindowsUri+ filePathUriSpec :: Spec filePathUriSpec = do   it "converts a POSIX file path to a URI" $ do     let theFilePath = platformAwareFilePathToUri "posix" "./Functional.hs"-    theFilePath `shouldBe` (Uri "file://./Functional.hs")+    theFilePath `shouldBe` (Uri "file://Functional.hs")    it "converts a Windows file path to a URI" $ do     let theFilePath = platformAwareFilePathToUri windowsOS "./Functional.hs"-    theFilePath `shouldBe` (Uri "file:///./Functional.hs")+    theFilePath `shouldBe` (Uri "file:///Functional.hs")    it "converts a Windows file path to a URI" $ do     let theFilePath = platformAwareFilePathToUri windowsOS "c:/Functional.hs"-    theFilePath `shouldBe` (Uri "file:///c:/Functional.hs")+    theFilePath `shouldBe` (Uri "file:///C:/Functional.hs")    it "converts a POSIX file path to a URI and back" $ do     let theFilePath = platformAwareFilePathToUri "posix" "./Functional.hs"-    theFilePath `shouldBe` (Uri "file://./Functional.hs")-    let Just (URI scheme' auth' path' query' frag') =  parseURI "file://./Functional.hs"+    theFilePath `shouldBe` (Uri "file://Functional.hs")+    let Just (URI scheme' auth' path' query' frag') =  parseURI "file://Functional.hs"     (scheme',auth',path',query',frag') `shouldBe`       ("file:"-      ,Just (URIAuth {uriUserInfo = "", uriRegName = ".", uriPort = ""}) -- AZ: Seems odd-      ,"/Functional.hs"+      ,Just (URIAuth {uriUserInfo = "", uriRegName = "Functional.hs", uriPort = ""}) -- AZ: Seems odd       ,""+      ,""       ,"")-    Just "./Functional.hs" `shouldBe` platformAwareUriToFilePath "posix" theFilePath+    Just "Functional.hs" `shouldBe` platformAwareUriToFilePath "posix" theFilePath    it "converts a Posix file path to a URI and back" $ property $ forAll genPosixFilePath $ \fp -> do       let uri = platformAwareFilePathToUri "posix" fp@@ -108,16 +131,24 @@ genWindowsFilePath = do     segments <- listOf pathSegment     pathSep <- elements ['/', '\\']-    pure ("C:" <> [pathSep] <> intercalate [pathSep] segments)-  where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '\\', '.', ':']))+    driveLetter <- elements ["C:", "c:"]+    pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments)+  where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/', '\\', ':']))  genPosixFilePath :: Gen FilePath genPosixFilePath = do     segments <- listOf pathSegment     pure ("/" <> intercalate "/" segments)-  where pathSegment = listOf1 (arbitraryASCIIChar `suchThat` (`notElem` ['/', '.']))+  where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/'])) +genValidUnicodeChar :: Gen Char+genValidUnicodeChar = arbitraryUnicodeChar `suchThat` isCharacter+  where isCharacter x = x /= '\65534' && x /= '\65535'+ #if !MIN_VERSION_QuickCheck(2,10,0)-arbitraryASCIIChar :: Gen Char-arbitraryASCIIChar = arbitrary+arbitraryUnicodeChar :: Gen Char+arbitraryUnicodeChar =+  arbitraryBoundedEnum `suchThat` (not . isSurrogate)+  where+    isSurrogate c = generalCategory c == Surrogate #endif

@@ -31,7 +31,7 @@ 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)+vfsFromText text = VirtualFile 0 0 (Rope.fromText text)  -- ---------------------------------------------------------------------