haskell-lsp 0.19.0.0 → 0.20.0.0
raw patch · 9 files changed
+65/−33 lines, 9 filesdep ~haskell-lsp-types
Dependency ranges changed: haskell-lsp-types
Files
- ChangeLog.md +9/−1
- haskell-lsp.cabal +3/−2
- src/Language/Haskell/LSP/Core.hs +17/−5
- src/Language/Haskell/LSP/Diagnostics.hs +7/−6
- src/Language/Haskell/LSP/VFS.hs +1/−0
- test/DiagnosticsSpec.hs +20/−19
- test/ServerCapabilitiesSpec.hs +3/−0
- test/TypesSpec.hs +3/−0
- test/URIFilePathSpec.hs +2/−0
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for haskell-lsp +## 0.20.0.0++* Don't log errors for '$/' notifications (@jinwoo)+* Force utf8 encoding when writing vfs temp files (@jneira)+* Store a hash in a NormalizedUri (@mpickering)+* Move "Semigroup WorkspaceEdit" instance (@sheaf)+* Fix vfs line endings (@jneira)+ ## 0.19.0.0 -- 2019-12-14 * Fix vfs line endings (@jneira)@@ -62,7 +70,7 @@ ```haskell , persistVirtualFileFunc :: !(J.Uri -> IO FilePath) , reverseFileMapFunc :: !(IO (FilePath -> FilePath))- ```+``` * Fix exception on empty filepaths
haskell-lsp.cabal view
@@ -1,5 +1,5 @@ name: haskell-lsp-version: 0.19.0.0+version: 0.20.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol description: An implementation of the types, and basic message server to@@ -46,7 +46,7 @@ , filepath , hslogger , hashable- , haskell-lsp-types == 0.19.*+ , haskell-lsp-types == 0.20.* , lens >= 4.15.2 , mtl , network-uri@@ -131,6 +131,7 @@ , sorted-list == 0.2.1.* , stm , text+ , unordered-containers -- For GHCI tests -- , async -- , haskell-lsp-types
src/Language/Haskell/LSP/Core.hs view
@@ -416,16 +416,28 @@ Nothing -> return () ctx <- readTVarIO tvarDat- captureFromClient (wrapper req) (resCaptureFile ctx)+ let req' = wrapper req+ captureFromClient req' (resCaptureFile ctx) case mh of Just h -> h req- Nothing -> do- let msg = T.pack $ unwords ["haskell-lsp:no handler for.", show json]- sendErrorLog tvarDat msg+ Nothing+ -- $/ notifications should/could be ignored by server.+ -- Don't log errors in that case.+ -- See https://microsoft.github.io/language-server-protocol/specifications/specification-current/#-notifications-and-requests.+ | isOptionalNotification req' -> return ()+ | otherwise -> do+ let msg = T.pack $ unwords ["haskell-lsp:no handler for.", show json]+ sendErrorLog tvarDat msg J.Error err -> do let msg = T.pack $ unwords $ ["haskell-lsp:parse error.", show json, show err] ++ _ERR_MSG_URL sendErrorLog tvarDat msg+ where+ isOptionalNotification req' =+ case (req', json) of+ (NotCustomClient _, J.String method)+ | "$/" `T.isPrefixOf` method -> True+ _ -> False handleInitialConfig :: (Show config)@@ -1010,7 +1022,7 @@ let ds = flushBySource (resDiagnostics ctx) msource writeTVar tvarDat $ ctx {resDiagnostics = ds} -- Send the updated diagnostics to the client- return $ forM_ (Map.keys ds) $ \uri -> do+ return $ forM_ (HM.keys ds) $ \uri -> do -- logs $ "haskell-lsp:flushDiagnosticsBySource:uri=" ++ show uri let mdp = getDiagnosticParamsFor maxDiagnosticCount ds uri case mdp of
src/Language/Haskell/LSP/Diagnostics.hs view
@@ -22,6 +22,7 @@ import qualified Data.SortedList as SL import qualified Data.Map as Map+import qualified Data.HashMap.Strict as HM import qualified Language.Haskell.LSP.Types as J -- ---------------------------------------------------------------------@@ -39,7 +40,7 @@ -} -type DiagnosticStore = Map.Map J.NormalizedUri StoreItem+type DiagnosticStore = HM.HashMap J.NormalizedUri StoreItem data StoreItem = StoreItem J.TextDocumentVersion DiagnosticsBySource@@ -56,7 +57,7 @@ flushBySource :: DiagnosticStore -> Maybe J.DiagnosticSource -> DiagnosticStore flushBySource store Nothing = store-flushBySource store (Just source) = Map.map remove store+flushBySource store (Just source) = HM.map remove store where remove (StoreItem mv diags) = StoreItem mv (Map.delete (Just source) diags) @@ -68,16 +69,16 @@ updateDiagnostics store uri mv newDiagsBySource = r where newStore :: DiagnosticStore- newStore = Map.insert uri (StoreItem mv newDiagsBySource) store+ newStore = HM.insert uri (StoreItem mv newDiagsBySource) store - updateDbs dbs = Map.insert uri new store+ updateDbs dbs = HM.insert uri new store where new = StoreItem mv newDbs -- note: Map.union is left-biased, so for identical keys the first -- argument is used newDbs = Map.union newDiagsBySource dbs - r = case Map.lookup uri store of+ r = case HM.lookup uri store of Nothing -> newStore Just (StoreItem mvs dbs) -> if mvs /= mv@@ -88,7 +89,7 @@ getDiagnosticParamsFor :: Int -> DiagnosticStore -> J.NormalizedUri -> Maybe J.PublishDiagnosticsParams getDiagnosticParamsFor maxDiagnostics ds uri =- case Map.lookup uri ds of+ case HM.lookup uri ds of Nothing -> Nothing Just (StoreItem _ diags) -> Just $ J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (J.List (take maxDiagnostics $ SL.fromSortedList $ mconcat $ Map.elems diags))
src/Language/Haskell/LSP/VFS.hs view
@@ -192,6 +192,7 @@ writeRaw h = do -- We honour original file line endings hSetNewlineMode h noNewlineTranslation+ hSetEncoding h utf8 hPutStr h contents logs $ "haskell-lsp:persistFileVFS: Writing virtual file: " ++ "uri = " ++ show uri ++ ", virtual file = " ++ show tfn
test/DiagnosticsSpec.hs view
@@ -3,6 +3,7 @@ import qualified Data.Map as Map+import qualified Data.HashMap.Strict as HM import qualified Data.SortedList as SL import Data.Text (Text) import Language.Haskell.LSP.Diagnostics@@ -55,8 +56,8 @@ , mkDiagnostic (Just "hlint") "b" ] uri = J.toNormalizedUri $ J.Uri "uri"- (updateDiagnostics Map.empty uri Nothing (partitionBySource diags)) `shouldBe`- Map.fromList+ (updateDiagnostics HM.empty uri Nothing (partitionBySource diags)) `shouldBe`+ HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "hlint", SL.toSortedList diags) ] ) ] @@ -69,8 +70,8 @@ , mkDiagnostic (Just "ghcmod") "b" ] uri = J.toNormalizedUri $ J.Uri "uri"- (updateDiagnostics Map.empty uri Nothing (partitionBySource diags)) `shouldBe`- Map.fromList+ (updateDiagnostics HM.empty uri Nothing (partitionBySource diags)) `shouldBe`+ HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "hlint", SL.singleton (mkDiagnostic (Just "hlint") "a")) ,(Just "ghcmod", SL.singleton (mkDiagnostic (Just "ghcmod") "b"))@@ -86,8 +87,8 @@ , mkDiagnostic (Just "ghcmod") "b" ] uri = J.toNormalizedUri $ J.Uri "uri"- (updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags)) `shouldBe`- Map.fromList+ (updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags)) `shouldBe`+ HM.fromList [ (uri,StoreItem (Just 1) $ Map.fromList [(Just "hlint", SL.singleton (mkDiagnostic (Just "hlint") "a")) ,(Just "ghcmod", SL.singleton (mkDiagnostic (Just "ghcmod") "b"))@@ -107,9 +108,9 @@ [ mkDiagnostic (Just "hlint") "a2" ] uri = J.toNormalizedUri $ J.Uri "uri"- let origStore = updateDiagnostics Map.empty uri Nothing (partitionBySource diags1)+ let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (partitionBySource diags2)) `shouldBe`- Map.fromList+ HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "hlint", SL.toSortedList diags2) ] ) ] @@ -125,9 +126,9 @@ [ mkDiagnostic (Just "hlint") "a2" ] uri = J.toNormalizedUri $ J.Uri "uri"- let origStore = updateDiagnostics Map.empty uri Nothing (partitionBySource diags1)+ let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (partitionBySource diags2)) `shouldBe`- Map.fromList+ HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "hlint", SL.singleton (mkDiagnostic (Just "hlint") "a2")) ,(Just "ghcmod", SL.singleton (mkDiagnostic (Just "ghcmod") "b1"))@@ -143,9 +144,9 @@ , mkDiagnostic (Just "ghcmod") "b1" ] uri = J.toNormalizedUri $ J.Uri "uri"- let origStore = updateDiagnostics Map.empty uri Nothing (partitionBySource diags1)+ let origStore = updateDiagnostics HM.empty uri Nothing (partitionBySource diags1) (updateDiagnostics origStore uri Nothing (Map.fromList [(Just "ghcmod",SL.toSortedList [])])) `shouldBe`- Map.fromList+ HM.fromList [ (uri,StoreItem Nothing $ Map.fromList [(Just "ghcmod", SL.toSortedList []) ,(Just "hlint", SL.singleton (mkDiagnostic (Just "hlint") "a1"))@@ -166,9 +167,9 @@ [ mkDiagnostic (Just "hlint") "a2" ] uri = J.toNormalizedUri $ J.Uri "uri"- let origStore = updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags1)+ let origStore = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags1) (updateDiagnostics origStore uri (Just 2) (partitionBySource diags2)) `shouldBe`- Map.fromList+ HM.fromList [ (uri,StoreItem (Just 2) $ Map.fromList [(Just "hlint", SL.toSortedList diags2) ] ) ] @@ -184,9 +185,9 @@ [ mkDiagnostic (Just "hlint") "a2" ] uri = J.toNormalizedUri $ J.Uri "uri"- let origStore = updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags1)+ let origStore = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags1) (updateDiagnostics origStore uri (Just 2) (partitionBySource diags2)) `shouldBe`- Map.fromList+ HM.fromList [ (uri,StoreItem (Just 2) $ Map.fromList [(Just "hlint", SL.singleton (mkDiagnostic (Just "hlint") "a2")) ] )@@ -203,7 +204,7 @@ , mkDiagnostic (Just "ghcmod") "b" ] uri = J.toNormalizedUri $ J.Uri "uri"- let ds = updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags)+ let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) (getDiagnosticParamsFor 10 ds uri) `shouldBe` Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (J.List $ reverse diags)) @@ -220,7 +221,7 @@ , mkDiagnostic (Just "ghcmod") "d" ] uri = J.toNormalizedUri $ J.Uri "uri"- let ds = updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags)+ let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) (getDiagnosticParamsFor 2 ds uri) `shouldBe` Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (J.List [@@ -247,7 +248,7 @@ , mkDiagnostic (Just "ghcmod") "d" ] uri = J.toNormalizedUri $ J.Uri "uri"- let ds = updateDiagnostics Map.empty uri (Just 1) (partitionBySource diags)+ let ds = updateDiagnostics HM.empty uri (Just 1) (partitionBySource diags) (getDiagnosticParamsFor 100 ds uri) `shouldBe` Just (J.PublishDiagnosticsParams (J.fromNormalizedUri uri) (J.List [
test/ServerCapabilitiesSpec.hs view
@@ -1,9 +1,12 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module ServerCapabilitiesSpec where import Control.Lens.Operators import Data.Aeson+#if __GLASGOW_HASKELL__ < 808 import Data.Monoid ((<>))+#endif import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens import Test.Hspec
test/TypesSpec.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module TypesSpec where +#if __GLASGOW_HASKELL__ < 808 import Data.Monoid ((<>))+#endif import qualified Language.Haskell.LSP.Types as J import Test.Hspec
test/URIFilePathSpec.hs view
@@ -3,7 +3,9 @@ module URIFilePathSpec where import Data.List+#if __GLASGOW_HASKELL__ < 808 import Data.Monoid ((<>))+#endif import Data.Text (pack) import Language.Haskell.LSP.Types