lsp 1.5.0.0 → 1.6.0.0
raw patch · 11 files changed
+8/−782 lines, 11 filesdep −QuickCheckdep −network-uridep −quickcheck-instancesdep ~aesondep ~lsp-typesPVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, network-uri, quickcheck-instances, scientific, time
Dependency ranges changed: aeson, lsp-types
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- lsp.cabal +3/−29
- test/CapabilitiesSpec.hs +0/−16
- test/JsonSpec.hs +0/−173
- test/Main.hs +0/−15
- test/MethodSpec.hs +0/−99
- test/SemanticTokensSpec.hs +0/−74
- test/ServerCapabilitiesSpec.hs +0/−40
- test/TypesSpec.hs +0/−30
- test/URIFilePathSpec.hs +0/−278
- test/WorkspaceEditSpec.hs +0/−28
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for lsp +## 1.6.0.0++* Pinned to lsp-types 1.6+* Tests moved to `lsp-types`+ ## 1.5.0.0 * VFS module moved to `lsp` from `lsp-types`.
lsp.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: lsp-version: 1.5.0.0+version: 1.6.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol description: An implementation of the types, and basic message server to@@ -44,19 +44,16 @@ , exceptions , filepath , hashable- , lsp-types == 1.5.*+ , lsp-types == 1.6.* , lens >= 4.15.2 , mtl < 2.4- , network-uri , prettyprinter , sorted-list == 0.2.1.* , stm == 2.5.*- , scientific , temporary , text , text-rope , transformers >= 0.5.6 && < 0.7- , time , unordered-containers , unliftio-core >= 0.2.0.0 -- used for generating random uuids for dynamic registration@@ -101,44 +98,21 @@ default: False -test-suite unit-test+test-suite lsp-test type: exitcode-stdio-1.0- -- hs-source-dirs: test src hs-source-dirs: test main-is: Main.hs other-modules: Spec- CapabilitiesSpec- JsonSpec DiagnosticsSpec- MethodSpec- ServerCapabilitiesSpec- SemanticTokensSpec- TypesSpec- URIFilePathSpec VspSpec- WorkspaceEditSpec build-depends: base- , QuickCheck- -- for instance Arbitrary Value- , aeson >= 2.0.3.0 , containers- , filepath , lsp , hspec- -- , hspec-jenkins- , lens >= 4.15.2- , network-uri- , quickcheck-instances , sorted-list == 0.2.1.* , text , text-rope , unordered-containers- -- For GHCI tests- -- , async- -- , haskell-lsp-types- -- , temporary- -- , time- -- , unordered-containers build-tool-depends: hspec-discover:hspec-discover ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010
− test/CapabilitiesSpec.hs
@@ -1,16 +0,0 @@-module CapabilitiesSpec where--import Language.LSP.Types-import Language.LSP.Types.Capabilities-import Test.Hspec--spec :: Spec-spec = describe "capabilities" $ do- it "gives 3.10 capabilities" $- let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 10)- Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _ ) = _documentSymbol tdcs- in mHierarchical `shouldBe` Just True- it "gives pre 3.10 capabilities" $- let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 9)- Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _) = _documentSymbol tdcs- in mHierarchical `shouldBe` Nothing
− test/JsonSpec.hs
@@ -1,173 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--- For the use of MarkedString-{-# OPTIONS_GHC -fno-warn-deprecations #-}--- | Test for JSON serialization-module JsonSpec where--import Language.LSP.Types--import qualified Data.Aeson as J-import Data.List(isPrefixOf)-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck hiding (Success)-import Test.QuickCheck.Instances ()---- import Debug.Trace--- -----------------------------------------------------------------------{-# ANN module ("HLint: ignore Redundant do" :: String) #-}--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "dispatcher" jsonSpec- describe "ResponseMessage" responseMessageSpec---- -----------------------------------------------------------------------jsonSpec :: Spec-jsonSpec = do- describe "General JSON instances round trip" $ do- -- DataTypesJSON- prop "LanguageString" (propertyJsonRoundtrip :: LanguageString -> Property)- prop "MarkedString" (propertyJsonRoundtrip :: MarkedString -> Property)- prop "MarkupContent" (propertyJsonRoundtrip :: MarkupContent -> Property)- prop "HoverContents" (propertyJsonRoundtrip :: HoverContents -> Property)- prop "ResponseError" (propertyJsonRoundtrip :: ResponseError -> Property)- prop "WatchedFiles" (propertyJsonRoundtrip :: DidChangeWatchedFilesRegistrationOptions -> Property)- prop "ResponseMessage Initialize"- (propertyJsonRoundtrip :: ResponseMessage 'TextDocumentHover -> Property)- -- prop "ResponseMessage JSON value"- -- (propertyJsonRoundtrip :: ResponseMessage J.Value -> Property)- describe "JSON decoding regressions" $- it "CompletionItem" $- (J.decode "{\"jsonrpc\":\"2.0\",\"result\":[{\"label\":\"raisebox\"}],\"id\":1}" :: Maybe (ResponseMessage 'TextDocumentCompletion))- `shouldNotBe` Nothing---responseMessageSpec :: Spec-responseMessageSpec = do- describe "edge cases" $ do- it "decodes result = null" $ do- let input = "{\"jsonrpc\": \"2.0\", \"id\": 123, \"result\": null}"- in J.decode input `shouldBe` Just- ((ResponseMessage "2.0" (Just (IdInt 123)) (Right J.Null)) :: ResponseMessage 'WorkspaceExecuteCommand)- it "handles missing params field" $ do- J.eitherDecode "{ \"jsonrpc\": \"2.0\", \"id\": 15, \"method\": \"shutdown\"}"- `shouldBe` Right (RequestMessage "2.0" (IdInt 15) SShutdown Empty)- describe "invalid JSON" $ do- it "throws if neither result nor error is present" $ do- (J.eitherDecode "{\"jsonrpc\":\"2.0\",\"id\":1}" :: Either String (ResponseMessage 'Initialize))- `shouldBe` Left ("Error in $: both error and result cannot be Nothing")- it "throws if both result and error are present" $ do- (J.eitherDecode- "{\"jsonrpc\":\"2.0\",\"id\": 1,\"result\":{\"capabilities\": {}},\"error\":{\"code\":-32700,\"message\":\"\",\"data\":null}}"- :: Either String (ResponseMessage 'Initialize))- `shouldSatisfy`- (either (\err -> "Error in $: both error and result cannot be present" `isPrefixOf` err) (\_ -> False))---- -----------------------------------------------------------------------propertyJsonRoundtrip :: (Eq a, Show a, J.ToJSON a, J.FromJSON a) => a -> Property-propertyJsonRoundtrip a = J.Success a === J.fromJSON (J.toJSON a)---- -----------------------------------------------------------------------instance Arbitrary LanguageString where- arbitrary = LanguageString <$> arbitrary <*> arbitrary--instance Arbitrary MarkedString where- arbitrary = oneof [PlainString <$> arbitrary, CodeString <$> arbitrary]--instance Arbitrary MarkupContent where- arbitrary = MarkupContent <$> arbitrary <*> arbitrary--instance Arbitrary MarkupKind where- arbitrary = oneof [pure MkPlainText,pure MkMarkdown]--instance Arbitrary HoverContents where- arbitrary = oneof [ HoverContentsMS <$> arbitrary- , HoverContents <$> arbitrary- ]--instance Arbitrary UInt where- arbitrary = fromInteger <$> arbitrary--instance Arbitrary Uri where- arbitrary = Uri <$> arbitrary--instance Arbitrary Position where- arbitrary = Position <$> arbitrary <*> arbitrary--instance Arbitrary Location where- arbitrary = Location <$> arbitrary <*> arbitrary--instance Arbitrary Range where- arbitrary = Range <$> arbitrary <*> arbitrary--instance Arbitrary Hover where- arbitrary = Hover <$> arbitrary <*> arbitrary--instance Arbitrary (ResponseResult m) => Arbitrary (ResponseMessage m) where- arbitrary =- oneof- [ ResponseMessage- <$> arbitrary- <*> arbitrary- <*> (Right <$> arbitrary)- , ResponseMessage- <$> arbitrary- <*> arbitrary- <*> (Left <$> arbitrary)- ]--instance Arbitrary (LspId m) where- arbitrary = oneof [IdInt <$> arbitrary, IdString <$> arbitrary]--instance Arbitrary ResponseError where- arbitrary = ResponseError <$> arbitrary <*> arbitrary <*> pure Nothing--instance Arbitrary ErrorCode where- arbitrary =- elements- [ ParseError- , InvalidRequest- , MethodNotFound- , InvalidParams- , InternalError- , ServerErrorStart- , ServerErrorEnd- , ServerNotInitialized- , UnknownErrorCode- , RequestCancelled- , ContentModified- ]---- | make lists of maximum length 3 for test performance-smallList :: Gen a -> Gen [a]-smallList = resize 3 . listOf--instance (Arbitrary a) => Arbitrary (List a) where- arbitrary = List <$> arbitrary---- -----------------------------------------------------------------------instance Arbitrary DidChangeWatchedFilesRegistrationOptions where- arbitrary = DidChangeWatchedFilesRegistrationOptions <$> arbitrary--instance Arbitrary FileSystemWatcher where- arbitrary = FileSystemWatcher <$> arbitrary <*> arbitrary--instance Arbitrary WatchKind where- arbitrary = WatchKind <$> arbitrary <*> arbitrary <*> arbitrary---- ---------------------------------------------------------------------
test/Main.hs view
@@ -1,22 +1,7 @@ module Main where ---- import Test.Hspec.Formatters.Jenkins import Test.Hspec.Runner import qualified Spec --- ---------------------------------------------------------------------- main :: IO () main = hspec Spec.spec---- main :: IO ()--- main = do--- summary <- withFile "results.xml" WriteMode $ \h -> do--- let c = defaultConfig--- { configFormatter = xmlFormatter--- , configHandle = h--- }--- hspecWith c Spec.spec--- unless (summaryFailures summary == 0) $--- exitFailure
− test/MethodSpec.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE OverloadedStrings, DataKinds #-}-module MethodSpec where---import Control.Monad-import qualified Data.Aeson as J-import qualified Language.LSP.Types as J-import Test.Hspec-import qualified Data.Text as T---- -----------------------------------------------------------------------main :: IO ()-main = hspec spec--spec :: Spec-spec = describe "Method enum aeson instance consistency" diagnosticsSpec---- -----------------------------------------------------------------------clientMethods :: [T.Text]-clientMethods = [- -- General- "initialize"- ,"initialized"- ,"shutdown"- ,"exit"- ,"$/cancelRequest"- -- Workspace- ,"workspace/didChangeConfiguration"- ,"workspace/didChangeWatchedFiles"- ,"workspace/symbol"- ,"workspace/executeCommand"- ,"workspace/semanticTokens/refresh"- -- Document- ,"textDocument/didOpen"- ,"textDocument/didChange"- ,"textDocument/willSave"- ,"textDocument/willSaveWaitUntil"- ,"textDocument/didSave"- ,"textDocument/didClose"- ,"textDocument/completion"- ,"completionItem/resolve"- ,"textDocument/hover"- ,"textDocument/signatureHelp"- ,"textDocument/references"- ,"textDocument/documentHighlight"- ,"textDocument/documentSymbol"- ,"textDocument/formatting"- ,"textDocument/rangeFormatting"- ,"textDocument/onTypeFormatting"- ,"textDocument/definition"- ,"textDocument/codeAction"- ,"textDocument/codeLens"- ,"codeLens/resolve"- ,"textDocument/documentLink"- ,"documentLink/resolve"- ,"textDocument/rename"- ,"textDocument/prepareRename"- ,"textDocument/prepareCallHierarchy"- ,"callHierarchy/incomingCalls"- ,"callHierarchy/outgoingCalls"-- ,"textDocument/semanticTokens"- ,"textDocument/semanticTokens/full"- ,"textDocument/semanticTokens/full/delta"- ,"textDocument/semanticTokens/range"- ]--serverMethods :: [T.Text]-serverMethods = [- -- Window- "window/showMessage"- ,"window/showMessageRequest"- ,"window/logMessage"- ,"telemetry/event"- -- Client- ,"client/registerCapability"- ,"client/unregisterCapability"- -- Workspace- ,"workspace/applyEdit"- -- Document- ,"textDocument/publishDiagnostics"- ]--diagnosticsSpec :: Spec-diagnosticsSpec = do- describe "Client Methods" $ do- it "maintains roundtrip consistency" $ do- forM_ clientMethods $ \m -> do- (J.toJSON <$> (J.fromJSON (J.String m) :: J.Result (J.SomeClientMethod)))- `shouldBe` (J.Success $ J.String m)- describe "Server Methods" $ do- it "maintains roundtrip consistency" $ do- forM_ serverMethods $ \m -> do- (J.toJSON <$> (J.fromJSON (J.String m) :: J.Result (J.SomeServerMethod)))- `shouldBe` (J.Success $ J.String m)-- -- ---------------------------------
− test/SemanticTokensSpec.hs
@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-module SemanticTokensSpec where--import Test.Hspec-import Language.LSP.Types-import Data.List (unfoldr)-import Data.Either (isRight)--spec :: Spec-spec = do- let exampleLegend = SemanticTokensLegend (List [SttProperty, SttType, SttClass]) (List [StmUnknown "private", StmStatic])- exampleTokens1 = [- SemanticTokenAbsolute 2 5 3 SttProperty [StmUnknown "private", StmStatic]- , SemanticTokenAbsolute 2 10 4 SttType []- , SemanticTokenAbsolute 5 2 7 SttClass []- ]- exampleTokens2 = [- SemanticTokenAbsolute 3 5 3 SttProperty [StmUnknown "private", StmStatic]- , SemanticTokenAbsolute 3 10 4 SttType []- , SemanticTokenAbsolute 6 2 7 SttClass []- ]-- bigNumber :: UInt- bigNumber = 100000- bigTokens =- unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenAbsolute i 1 1 SttType [StmUnknown "private", StmStatic], i+1)) 0- -- Relativized version of bigTokens- bigTokensRel =- unfoldr (\i -> if i == bigNumber then Nothing else Just (SemanticTokenRelative (if i == 0 then 0 else 1) 1 1 SttType [StmUnknown "private", StmStatic], i+1)) 0-- -- One more order of magnitude makes diffing more-or-less hang - possibly we need a better diffing algorithm, since this is only ~= 200 tokens at 5 ints per token- -- (I checked and it is the diffing that's slow, not turning it into edits)- smallerBigNumber :: UInt- smallerBigNumber = 1000- bigInts :: [UInt]- bigInts =- unfoldr (\i -> if i == smallerBigNumber then Nothing else Just (1, i+1)) 0- bigInts2 :: [UInt]- bigInts2 =- unfoldr (\i -> if i == smallerBigNumber then Nothing else Just (if even i then 2 else 1, i+1)) 0-- describe "relativize/absolutizeTokens" $ do- it "round-trips" $ do- absolutizeTokens (relativizeTokens exampleTokens1) `shouldBe` exampleTokens1- absolutizeTokens (relativizeTokens exampleTokens2) `shouldBe` exampleTokens2- it "handles big tokens" $ relativizeTokens bigTokens `shouldBe` bigTokensRel-- describe "encodeTokens" $ do- context "when running the LSP examples" $ do- it "encodes example 1 correctly" $- let encoded = encodeTokens exampleLegend (relativizeTokens exampleTokens1)- in encoded `shouldBe` Right [{- token 1 -}2,5,3,0,3,{- token 2 -}0,5,4,1,0,{- token 3 -}3,2,7,2,0]- it "encodes example 2 correctly" $- let encoded = encodeTokens exampleLegend (relativizeTokens exampleTokens2)- in encoded `shouldBe` Right [{- token 1 -}3,5,3,0,3,{- token 2 -}0,5,4,1,0,{- token 3 -}3,2,7,2,0]- it "handles big tokens" $ encodeTokens exampleLegend bigTokensRel `shouldSatisfy` isRight-- describe "computeEdits" $ do- it "handles an edit in the middle" $- computeEdits @Int [1,2,3] [1,4,5,3] `shouldBe` [Edit 1 1 [4,5]]- it "handles an edit at the end" $- computeEdits @Int [1,2,3] [1,2,4,5] `shouldBe` [Edit 2 1 [4,5]]- it "handles an edit at the beginning" $- computeEdits @Int [1,2,3] [4,5,2,3] `shouldBe` [Edit 0 1 [4,5]]- it "handles an ambiguous edit" $- computeEdits @Int [1,2,3] [1,3,4,3] `shouldBe` [Edit 1 1 [], Edit 3 0 [4,3]]- it "handles a long edit" $- computeEdits @Int [1,2,3,4,5] [1,7,7,7,7,7,5] `shouldBe` [Edit 1 3 [7,7,7,7,7]]- it "handles multiple edits" $- computeEdits @Int [1,2,3,4,5] [1,6,3,7,7,5] `shouldBe` [Edit 1 1 [6], Edit 3 1 [7,7]]- it "handles big tokens" $- -- It's a little hard to specify a useful predicate here, the main point is that it should not take too long- computeEdits @UInt bigInts bigInts2 `shouldSatisfy` (not . null)
− test/ServerCapabilitiesSpec.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module ServerCapabilitiesSpec where--import Control.Lens.Operators-import Data.Aeson-import Language.LSP.Types-import Language.LSP.Types.Capabilities-import Language.LSP.Types.Lens-import Test.Hspec--spec :: Spec-spec = describe "server capabilities" $ do- describe "folding range options" $ do- describe "decodes" $ do- it "just id" $- let input = "{\"id\": \"abc123\"}"- in decode input `shouldBe` Just (FoldingRangeRegistrationOptions Nothing Nothing (Just "abc123"))- it "id and document selector" $- let input = "{\"id\": \"foo\", \"documentSelector\": " <> documentFiltersJson <> "}"- in decode input `shouldBe` Just (FoldingRangeRegistrationOptions (Just documentFilters) Nothing (Just "foo"))- it "static boolean" $- let input = "true"- in decode input `shouldBe` Just True- describe "encodes" $- it "just id" $- encode (FoldingRangeRegistrationOptions Nothing Nothing (Just "foo")) `shouldBe` "{\"id\":\"foo\"}"- it "decodes" $- let input = "{\"hoverProvider\": true, \"colorProvider\": {\"id\": \"abc123\", \"documentSelector\": " <> documentFiltersJson <> "}}"- Just caps = decode input :: Maybe ServerCapabilities- in caps ^. colorProvider `shouldBe` Just (InR $ InR $ DocumentColorRegistrationOptions (Just documentFilters) (Just "abc123") Nothing)- describe "client/registerCapability" $- it "allows empty registerOptions" $- let input = "{\"registrations\":[{\"registerOptions\":{},\"method\":\"workspace/didChangeConfiguration\",\"id\":\"4a56f5ca-7188-4f4c-a366-652d6f9d63aa\"}]}"- Just registrationParams = decode input :: Maybe RegistrationParams- in registrationParams ^. registrations `shouldBe`- List [SomeRegistration $ Registration "4a56f5ca-7188-4f4c-a366-652d6f9d63aa"- SWorkspaceDidChangeConfiguration Empty]- where- documentFilters = List [DocumentFilter (Just "haskell") Nothing Nothing]- documentFiltersJson = "[{\"language\": \"haskell\"}]"
− test/TypesSpec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module TypesSpec where--import qualified Language.LSP.Types as J-import Test.Hspec---- -----------------------------------------------------------------------main :: IO ()-main = hspec spec--spec :: Spec-spec = diagnosticsSpec---- -----------------------------------------------------------------------diagnosticsSpec :: Spec-diagnosticsSpec = do- describe "MarkupContent" $ do- it "appends two plainstrings" $ do- J.unmarkedUpContent "string1\n" <> J.unmarkedUpContent "string2\n"- `shouldBe` J.unmarkedUpContent "string1\nstring2\n"- it "appends a marked up and a plain string" $ do- J.markedUpContent "haskell" "foo :: Int" <> J.unmarkedUpContent "string2\nstring3\n"- `shouldBe` J.MarkupContent J.MkMarkdown "\n```haskell\nfoo :: Int\n```\nstring2 \nstring3 \n"- it "appends a plain string and a marked up string" $ do- J.unmarkedUpContent "string2\n" <> J.markedUpContent "haskell" "foo :: Int"- `shouldBe` J.MarkupContent J.MkMarkdown "string2 \n\n```haskell\nfoo :: Int\n```\n"---- ---------------------------------------------------------------------
− test/URIFilePathSpec.hs
@@ -1,278 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module URIFilePathSpec where--import Control.Monad (when)-import Data.List-import Data.Text (Text, pack)-import Language.LSP.Types--import Network.URI-import Test.Hspec-import Test.QuickCheck-import qualified System.FilePath.Windows as FPW-import System.FilePath (normalise)-import qualified System.Info--- -----------------------------------------------------------------------isWindows :: Bool-isWindows = System.Info.os == "mingw32"--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "Platform aware URI file path functions" platformAwareUriFilePathSpec- describe "URI file path functions" uriFilePathSpec- describe "URI normalization functions" uriNormalizeSpec- describe "Normalized file path functions" normalizedFilePathSpec--windowsOS :: String-windowsOS = "mingw32"--testPosixUri :: Uri-testPosixUri = Uri $ pack "file:///home/myself/example.hs"--testPosixFilePath :: FilePath-testPosixFilePath = "/home/myself/example.hs"--relativePosixFilePath :: FilePath-relativePosixFilePath = "myself/example.hs"--testWindowsUri :: Uri-testWindowsUri = Uri $ pack "file:///c:/Users/myself/example.hs"--testWindowsFilePath :: FilePath-testWindowsFilePath = "c:\\Users\\myself\\example.hs"--platformAwareUriFilePathSpec :: Spec-platformAwareUriFilePathSpec = do- it "converts a URI to a POSIX file path" $ do- let theFilePath = platformAwareUriToFilePath "posix" testPosixUri- theFilePath `shouldBe` Just testPosixFilePath-- it "converts a POSIX file path to a URI" $ do- let theUri = platformAwareFilePathToUri "posix" testPosixFilePath- theUri `shouldBe` testPosixUri-- it "converts a URI to a Windows file path" $ do- let theFilePath = platformAwareUriToFilePath windowsOS testWindowsUri- theFilePath `shouldBe` Just testWindowsFilePath-- it "converts a Windows file path to a URI" $ do- let theUri = platformAwareFilePathToUri windowsOS testWindowsFilePath- theUri `shouldBe` testWindowsUri-- it "converts a POSIX file path to a URI" $ do- let theFilePath = platformAwareFilePathToUri "posix" "./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")-- it "converts a Windows file path to a URI" $ do- let theFilePath = platformAwareFilePathToUri windowsOS "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"- (scheme',auth',path',query',frag') `shouldBe`- ("file:"- ,Just (URIAuth {uriUserInfo = "", uriRegName = ".", uriPort = ""}) -- AZ: Seems odd- ,"/Functional.hs"- ,""- ,"")- 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- platformAwareUriToFilePath "posix" uri `shouldBe` Just fp-- it "converts a Windows file path to a URI and back" $ property $ forAll genWindowsFilePath $ \fp -> do- let uri = platformAwareFilePathToUri windowsOS fp- -- We normalise to account for changes in the path separator.- -- But driver letters are *not* normalized so we skip them- when (not $ "c:" `isPrefixOf` fp) $- platformAwareUriToFilePath windowsOS uri `shouldBe` Just (FPW.normalise fp)-- it "converts a relative POSIX file path to a URI and back" $ do- let uri = platformAwareFilePathToUri "posix" relativePosixFilePath- uri `shouldBe` Uri "file://myself/example.hs"- let back = platformAwareUriToFilePath "posix" uri- back `shouldBe` Just relativePosixFilePath---testUri :: Uri-testUri | isWindows = Uri "file:///C:/Users/myself/example.hs"- | otherwise = Uri "file:///home/myself/example.hs"--testFilePath :: FilePath-testFilePath | isWindows = "C:\\Users\\myself\\example.hs"- | otherwise = "/home/myself/example.hs"--withCurrentDirFilePath :: FilePath-withCurrentDirFilePath | isWindows = "C:\\Users\\.\\myself\\.\\.\\example.hs"- | otherwise = "/home/./myself/././example.hs"--fromRelativefilePathUri :: Uri-fromRelativefilePathUri | isWindows = Uri "file:///myself/example.hs"- | otherwise = Uri "file://myself/example.hs"--relativeFilePath :: FilePath-relativeFilePath | isWindows = "myself\\example.hs"- | otherwise = "myself/example.hs"--withLowerCaseDriveLetterFilePath :: FilePath-withLowerCaseDriveLetterFilePath = "c:\\Users\\.\\myself\\.\\.\\example.hs"--withInitialCurrentDirUriStr :: String-withInitialCurrentDirUriStr | isWindows = "file:///Functional.hs"- | otherwise = "file://Functional.hs"--withInitialCurrentDirUriParts :: (String, Maybe URIAuth, String, String, String)-withInitialCurrentDirUriParts- | isWindows =- ("file:"- ,Just (URIAuth {uriUserInfo = "", uriRegName = "", uriPort = ""}) -- JNS: And asymmetrical- ,"/Functional.hs","","")- | otherwise =- ("file:"- ,Just (URIAuth {uriUserInfo = "", uriRegName = "Functional.hs", uriPort = ""}) -- AZ: Seems odd- ,"","","")--withInitialCurrentDirFilePath :: FilePath-withInitialCurrentDirFilePath | isWindows = ".\\Functional.hs"- | otherwise = "./Functional.hs"--noNormalizedUriTxt :: Text-noNormalizedUriTxt | isWindows = "file:///c:/Users/./myself/././example.hs"- | otherwise = "file:///home/./myself/././example.hs"--noNormalizedUri :: Uri-noNormalizedUri = Uri noNormalizedUriTxt--uriFilePathSpec :: Spec-uriFilePathSpec = do- it "converts a URI to a file path" $ do- let theFilePath = uriToFilePath testUri- theFilePath `shouldBe` Just testFilePath-- it "converts a file path to a URI" $ do- let theUri = filePathToUri testFilePath- theUri `shouldBe` testUri-- it "removes unnecessary current directory paths" $ do- let theUri = filePathToUri withCurrentDirFilePath- theUri `shouldBe` testUri-- when isWindows $- it "make the drive letter upper case when converting a Windows file path to a URI" $ do- let theUri = filePathToUri withLowerCaseDriveLetterFilePath- theUri `shouldBe` testUri-- it "converts a file path to a URI and back" $ property $ forAll genFilePath $ \fp -> do- let uri = filePathToUri fp- uriToFilePath uri `shouldBe` Just (normalise fp)-- it "converts a relative file path to a URI and back" $ do- let uri = filePathToUri relativeFilePath- uri `shouldBe` fromRelativefilePathUri- let back = uriToFilePath uri- back `shouldBe` Just relativeFilePath-- it "converts a file path with initial current dir to a URI and back" $ do- let uri = filePathToUri withInitialCurrentDirFilePath- uri `shouldBe` (Uri (pack withInitialCurrentDirUriStr))- let Just (URI scheme' auth' path' query' frag') = parseURI withInitialCurrentDirUriStr- (scheme',auth',path',query',frag') `shouldBe` withInitialCurrentDirUriParts- Just "Functional.hs" `shouldBe` uriToFilePath uri--uriNormalizeSpec :: Spec-uriNormalizeSpec = do-- it "ignores differences in percent-encoding" $ property $ \uri ->- toNormalizedUri (Uri $ pack $ escapeURIString isUnescapedInURI uri) `shouldBe`- toNormalizedUri (Uri $ pack $ escapeURIString (const False) uri)-- it "ignores differences in percent-encoding (examples)" $ do- toNormalizedUri (Uri $ pack "http://server/path%C3%B1?param=%C3%B1") `shouldBe`- toNormalizedUri (Uri $ pack "http://server/path%c3%b1?param=%c3%b1")- toNormalizedUri (Uri $ pack "file:///path%2A") `shouldBe`- toNormalizedUri (Uri $ pack "file:///path%2a")-- it "normalizes uri file path when converting from uri to normalized uri" $ do- let (NormalizedUri _ uri) = toNormalizedUri noNormalizedUri- let (Uri nuri) = testUri- uri `shouldBe` nuri-- it "converts a file path with reserved uri chars to a normalized URI and back" $ do- let start = if isWindows then "C:\\" else "/"- let fp = start ++ "path;part#fragmen?param=val"- let nuri = toNormalizedUri (filePathToUri fp)- uriToFilePath (fromNormalizedUri nuri) `shouldBe` Just fp-- it "converts a file path with substrings that looks like uri escaped chars and back" $ do- let start = if isWindows then "C:\\" else "/"- let fp = start ++ "ca%C3%B1a"- let nuri = toNormalizedUri (filePathToUri fp)- uriToFilePath (fromNormalizedUri nuri) `shouldBe` Just fp-- it "converts a file path to a normalized URI and back" $ property $ forAll genFilePath $ \fp -> do- let nuri = toNormalizedUri (filePathToUri fp)- case uriToFilePath (fromNormalizedUri nuri) of- Just nfp -> nfp `shouldBe` (normalise fp)- Nothing -> return () -- Some unicode paths creates invalid uris, ignoring for now--genFilePath :: Gen FilePath-genFilePath | isWindows = genWindowsFilePath- | otherwise = genPosixFilePath--genWindowsFilePath :: Gen FilePath-genWindowsFilePath = do- segments <- listOf1 pathSegment- pathSep <- elements ['/', '\\']- driveLetter <- elements ["C:", "c:"]- pure (driveLetter <> [pathSep] <> intercalate [pathSep] segments)- where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/', '\\', ':']))--genPosixFilePath :: Gen FilePath-genPosixFilePath = do- segments <- listOf1 pathSegment- pure ("/" <> intercalate "/" segments)- where pathSegment = listOf1 (genValidUnicodeChar `suchThat` (`notElem` ['/']))--genValidUnicodeChar :: Gen Char-genValidUnicodeChar = arbitraryUnicodeChar `suchThat` isCharacter- where isCharacter x = x /= '\65534' && x /= '\65535'--normalizedFilePathSpec :: Spec-normalizedFilePathSpec = do- it "makes file path normalized" $ property $ forAll genFilePath $ \fp -> do- let nfp = toNormalizedFilePath fp- fromNormalizedFilePath nfp `shouldBe` (normalise fp)-- it "converts to a normalized uri and back" $ property $ forAll genFilePath $ \fp -> do- let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)- case uriToNormalizedFilePath nuri of- Just nfp -> fromNormalizedFilePath nfp `shouldBe` (normalise fp)- Nothing -> return () -- Some unicode paths creates invalid uris, ignoring for now-- it "converts a file path with reserved uri chars to a normalized URI and back" $ do- let start = if isWindows then "C:\\" else "/"- let fp = start ++ "path;part#fragmen?param=val"- let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)- fmap fromNormalizedFilePath (uriToNormalizedFilePath nuri) `shouldBe` Just fp-- it "converts a file path with substrings that looks like uri escaped chars and back" $ do- let start = if isWindows then "C:\\" else "/"- let fp = start ++ "ca%C3%B1a"- let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)- fmap fromNormalizedFilePath (uriToNormalizedFilePath nuri) `shouldBe` Just fp-- it "creates the same NormalizedUri than the older implementation" $ property $ forAll genFilePath $ \fp -> do- let nuri = normalizedFilePathToUri (toNormalizedFilePath fp)- let oldNuri = toNormalizedUri (filePathToUri fp)- nuri `shouldBe` oldNuri
− test/WorkspaceEditSpec.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module WorkspaceEditSpec where--import Test.Hspec-import Language.LSP.Types--spec :: Spec-spec = do- describe "applyTextEdit" $ do- it "inserts text" $- let te = TextEdit (Range (Position 1 2) (Position 1 2)) "foo"- in applyTextEdit te "lorem\nipsum\ndolor" `shouldBe` "lorem\nipfoosum\ndolor"- it "deletes text" $- let te = TextEdit (Range (Position 0 2) (Position 1 2)) ""- in applyTextEdit te "lorem\nipsum\ndolor" `shouldBe` "losum\ndolor"- it "edits a multiline text" $- let te = TextEdit (Range (Position 1 0) (Position 2 0)) "slorem"- in applyTextEdit te "lorem\nipsum\ndolor" `shouldBe` "lorem\nsloremdolor"- it "inserts text past the last line" $- let te = TextEdit (Range (Position 3 2) (Position 3 2)) "foo"- in applyTextEdit te "lorem\nipsum\ndolor" `shouldBe` "lorem\nipsum\ndolorfoo"-- describe "editTextEdit" $- it "edits a multiline text edit" $- let orig = TextEdit (Range (Position 1 1) (Position 2 2)) "hello\nworld"- inner = TextEdit (Range (Position 0 3) (Position 1 3)) "ios\ngo"- expected = TextEdit (Range (Position 1 1) (Position 2 2)) "helios\ngold"- in editTextEdit orig inner `shouldBe` expected