diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal --- a/haskell-lsp.cabal +++ b/haskell-lsp.cabal @@ -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 diff --git a/src/Language/Haskell/LSP/Core.hs b/src/Language/Haskell/LSP/Core.hs --- a/src/Language/Haskell/LSP/Core.hs +++ b/src/Language/Haskell/LSP/Core.hs @@ -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 diff --git a/src/Language/Haskell/LSP/Diagnostics.hs b/src/Language/Haskell/LSP/Diagnostics.hs --- a/src/Language/Haskell/LSP/Diagnostics.hs +++ b/src/Language/Haskell/LSP/Diagnostics.hs @@ -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)) diff --git a/src/Language/Haskell/LSP/VFS.hs b/src/Language/Haskell/LSP/VFS.hs --- a/src/Language/Haskell/LSP/VFS.hs +++ b/src/Language/Haskell/LSP/VFS.hs @@ -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 diff --git a/test/DiagnosticsSpec.hs b/test/DiagnosticsSpec.hs --- a/test/DiagnosticsSpec.hs +++ b/test/DiagnosticsSpec.hs @@ -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 [ diff --git a/test/ServerCapabilitiesSpec.hs b/test/ServerCapabilitiesSpec.hs --- a/test/ServerCapabilitiesSpec.hs +++ b/test/ServerCapabilitiesSpec.hs @@ -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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -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 diff --git a/test/URIFilePathSpec.hs b/test/URIFilePathSpec.hs --- a/test/URIFilePathSpec.hs +++ b/test/URIFilePathSpec.hs @@ -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