lsp-types 1.5.0.0 → 1.6.0.0

raw patch · 20 files changed

+1041/−58 lines, 20 filesdep +QuickCheckdep +exceptionsdep +hspecdep ~aesondep ~basedep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, exceptions, hspec, lsp-types, quickcheck-instances, safe, tuple

Dependency ranges changed: aeson, base, filepath, network-uri

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• lsp-types.cabal +43/−2
• src/Language/LSP/Types.hs +3/−1
• src/Language/LSP/Types/Location.hs +15/−7
• src/Language/LSP/Types/Message.hs +13/−1
• src/Language/LSP/Types/Method.hs +3/−3
• src/Language/LSP/Types/Parsing.hs +7/−1
• src/Language/LSP/Types/Uri.hs +74/−43
• src/Language/LSP/Types/Uri/OsPath.hs +53/−0
• test/CapabilitiesSpec.hs +16/−0
• test/JsonSpec.hs +173/−0
• test/LocationSpec.hs +35/−0
• test/Main.hs +7/−0
• test/MethodSpec.hs +99/−0
• test/SemanticTokensSpec.hs +74/−0
• test/ServerCapabilitiesSpec.hs +40/−0
• test/Spec.hs +9/−0
• test/TypesSpec.hs +30/−0
• test/URIFilePathSpec.hs +311/−0
• test/WorkspaceEditSpec.hs +28/−0

@@ -1,4 +1,12 @@ # Revision history for lsp-types++## 1.6.0.0++* Add `isSubRangeOf` and `positionInRange` helper functions+* Add `ServerCancelled`, `RequestFailed` and `ErrorCodeCustom` server error types+* Fix "workspace/semanticTokens/refresh" to be a server method instead of a client method+* Use a packed representation for `NormalizedFilePath`+* Add converions from `OsPath` to `NormalizedFilePath` in `Language.LSP.Types.Uri.OsPath` when using new enough `filepath`   ## 1.5.0.0 

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                lsp-types-version:             1.5.0.0+version:             1.6.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -16,6 +16,11 @@ build-type:          Simple extra-source-files:  ChangeLog.md, README.md +flag force-ospath+  default: False+  manual: False+  description: Force a version bound on filepath library, to enable 'OsPath'.+ library   exposed-modules:     Language.LSP.Types                      , Language.LSP.Types.Capabilities@@ -68,6 +73,7 @@                      , Language.LSP.Types.WorkspaceEdit                      , Language.LSP.Types.WorkspaceFolders                      , Language.LSP.Types.WorkspaceSymbol+                     , Language.LSP.Types.Uri.OsPath  -- other-extensions:   ghc-options:         -Wall   build-depends:       base >= 4.11 && < 5@@ -78,7 +84,6 @@                      , deepseq                      , Diff >= 0.2                      , dlist-                     , filepath                      , hashable                      , lens >= 4.15.2                      , mtl < 2.4@@ -89,9 +94,45 @@                      , text                      , template-haskell                      , unordered-containers+                     , exceptions+                     , safe+  if flag(force-ospath)+    build-depends: filepath ^>= 1.4.100.0+  else+    build-depends: filepath   hs-source-dirs:      src   default-language:    Haskell2010   default-extensions: StrictData++test-suite lsp-types-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Main.hs+  other-modules:       Spec+                       CapabilitiesSpec+                       JsonSpec+                       MethodSpec+                       ServerCapabilitiesSpec+                       SemanticTokensSpec+                       TypesSpec+                       URIFilePathSpec+                       WorkspaceEditSpec+                       LocationSpec+  build-depends:       base+                     , QuickCheck+                     -- for instance Arbitrary Value+                     , aeson >= 2.0.3.0+                     , filepath+                     , hspec+                     , lsp-types+                     , lens >= 4.15.2+                     , network-uri+                     , quickcheck-instances+                     , text+                     , tuple+  build-tool-depends:  hspec-discover:hspec-discover+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010  source-repository head   type:     git

@@ -37,6 +37,7 @@   , module Language.LSP.Types.TextDocument   , module Language.LSP.Types.TypeDefinition   , module Language.LSP.Types.Uri+  , module Language.LSP.Types.Uri.OsPath   , module Language.LSP.Types.WatchedFiles   , module Language.LSP.Types.Window   , module Language.LSP.Types.WorkspaceEdit@@ -69,8 +70,8 @@ import           Language.LSP.Types.Location import           Language.LSP.Types.LspId import           Language.LSP.Types.MarkupContent-import           Language.LSP.Types.Method import           Language.LSP.Types.Message+import           Language.LSP.Types.Method import           Language.LSP.Types.Parsing import           Language.LSP.Types.Progress import           Language.LSP.Types.References@@ -83,6 +84,7 @@ import           Language.LSP.Types.TextDocument import           Language.LSP.Types.TypeDefinition import           Language.LSP.Types.Uri+import           Language.LSP.Types.Uri.OsPath import           Language.LSP.Types.WatchedFiles import           Language.LSP.Types.Window import           Language.LSP.Types.WorkspaceEdit

@@ -1,11 +1,11 @@-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE TemplateHaskell #-} module Language.LSP.Types.Location where  import           Control.DeepSeq import           Data.Aeson.TH import           Data.Hashable-import           GHC.Generics hiding (UInt)+import           GHC.Generics              hiding (UInt) import           Language.LSP.Types.Common import           Language.LSP.Types.Uri import           Language.LSP.Types.Utils@@ -33,8 +33,8 @@  data Range =   Range-    { _start :: Position -- ^ The range's start position.-    , _end   :: Position -- ^ The range's end position.+    { _start :: Position -- ^ The range's start position. (inclusive)+    , _end   :: Position -- ^ The range's end position. (exclusive, see: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#range )     } deriving (Show, Read, Eq, Ord, Generic)  instance NFData Range@@ -65,12 +65,12 @@     -- range at the mouse position.     _originSelectionRange :: Maybe Range     -- | The target resource identifier of this link.-  , _targetUri :: Uri+  , _targetUri            :: Uri     -- | The full target range of this link. If the target for example is a     -- symbol then target range is the range enclosing this symbol not including     -- leading/trailing whitespace but everything else like comments. This     -- information is typically used to highlight the range in the editor.-  , _targetRange :: Range+  , _targetRange          :: Range     -- | The range that should be selected and revealed when this link is being     -- followed, e.g the name of a function. Must be contained by the the     -- 'targetRange'. See also @DocumentSymbol._range@@@ -84,3 +84,11 @@ -- prop> mkRange l c l' c' = Range (Position l c) (Position l' c') mkRange :: UInt -> UInt -> UInt -> UInt -> Range mkRange l c l' c' = Range (Position l c) (Position l' c')++-- | 'isSubrangeOf' returns true if for every 'Position' in the first 'Range', it's also in the second 'Range'.+isSubrangeOf :: Range -> Range -> Bool+isSubrangeOf smallRange range = _start smallRange >= _start range && _end smallRange <= _end range++-- | 'positionInRange' returns true if the given 'Position' is in the 'Range'.+positionInRange :: Position -> Range -> Bool+positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is exclusive.

@@ -60,6 +60,7 @@ import Data.Aeson import Data.Aeson.TH import Data.Text (Text)+import Data.Scientific import Data.String import GHC.Generics @@ -318,6 +319,9 @@                | UnknownErrorCode                | RequestCancelled                | ContentModified+               | ServerCancelled+               | RequestFailed+               | ErrorCodeCustom Int32                -- ^ Note: server error codes are reserved from -32099 to -32000                deriving (Read,Show,Eq) @@ -333,6 +337,9 @@   toJSON UnknownErrorCode     = Number (-32001)   toJSON RequestCancelled     = Number (-32800)   toJSON ContentModified      = Number (-32801)+  toJSON ServerCancelled      = Number (-32802)+  toJSON RequestFailed        = Number (-32803)+  toJSON (ErrorCodeCustom n)  = Number (fromIntegral n)  instance FromJSON ErrorCode where   parseJSON (Number (-32700)) = pure ParseError@@ -346,7 +353,12 @@   parseJSON (Number (-32001)) = pure UnknownErrorCode   parseJSON (Number (-32800)) = pure RequestCancelled   parseJSON (Number (-32801)) = pure ContentModified-  parseJSON _                 = fail "ErrorCode"+  parseJSON (Number (-32802)) = pure ServerCancelled+  parseJSON (Number (-32803)) = pure RequestFailed+  parseJSON (Number n       ) = case toBoundedInteger n of+    Just i -> pure (ErrorCodeCustom i)+    Nothing -> fail "Couldn't convert ErrorCode to bounded integer."+  parseJSON _                 = fail "Couldn't parse ErrorCode"  -- ------------------------------------- 

@@ -87,7 +87,6 @@   TextDocumentSemanticTokensFull     :: Method FromClient Request   TextDocumentSemanticTokensFullDelta :: Method FromClient Request   TextDocumentSemanticTokensRange    :: Method FromClient Request-  WorkspaceSemanticTokensRefresh     :: Method FromClient Request  -- ServerMethods   -- Window@@ -108,6 +107,7 @@   WorkspaceWorkspaceFolders          :: Method FromServer Request   WorkspaceConfiguration             :: Method FromServer Request   WorkspaceApplyEdit                 :: Method FromServer Request+  WorkspaceSemanticTokensRefresh     :: Method FromServer Request   -- Document   TextDocumentPublishDiagnostics     :: Method FromServer Notification @@ -287,7 +287,6 @@   parseJSON (A.String "workspace/didChangeWatchedFiles")     = pure $ SomeClientMethod SWorkspaceDidChangeWatchedFiles   parseJSON (A.String "workspace/symbol")                    = pure $ SomeClientMethod SWorkspaceSymbol   parseJSON (A.String "workspace/executeCommand")            = pure $ SomeClientMethod SWorkspaceExecuteCommand-  parseJSON (A.String "workspace/semanticTokens/refresh")    = pure $ SomeClientMethod SWorkspaceSemanticTokensRefresh  -- Document   parseJSON (A.String "textDocument/didOpen")                = pure $ SomeClientMethod STextDocumentDidOpen   parseJSON (A.String "textDocument/didChange")              = pure $ SomeClientMethod STextDocumentDidChange@@ -351,6 +350,7 @@   parseJSON (A.String "workspace/workspaceFolders")          = pure $ SomeServerMethod SWorkspaceWorkspaceFolders   parseJSON (A.String "workspace/configuration")             = pure $ SomeServerMethod SWorkspaceConfiguration   parseJSON (A.String "workspace/applyEdit")                 = pure $ SomeServerMethod SWorkspaceApplyEdit+  parseJSON (A.String "workspace/semanticTokens/refresh")    = pure $ SomeServerMethod SWorkspaceSemanticTokensRefresh   -- Document   parseJSON (A.String "textDocument/publishDiagnostics")     = pure $ SomeServerMethod STextDocumentPublishDiagnostics @@ -388,7 +388,6 @@   toJSON SWorkspaceDidChangeWatchedFiles     = A.String "workspace/didChangeWatchedFiles"   toJSON SWorkspaceSymbol                    = A.String "workspace/symbol"   toJSON SWorkspaceExecuteCommand            = A.String "workspace/executeCommand"-  toJSON SWorkspaceSemanticTokensRefresh     = A.String "workspace/semanticTokens/refresh"   -- Document   toJSON STextDocumentDidOpen                = A.String "textDocument/didOpen"   toJSON STextDocumentDidChange              = A.String "textDocument/didChange"@@ -445,6 +444,7 @@   toJSON SWorkspaceWorkspaceFolders          = A.String "workspace/workspaceFolders"   toJSON SWorkspaceConfiguration             = A.String "workspace/configuration"   toJSON SWorkspaceApplyEdit                 = A.String "workspace/applyEdit"+  toJSON SWorkspaceSemanticTokensRefresh     = A.String "workspace/semanticTokens/refresh"   -- Document   toJSON STextDocumentPublishDiagnostics     = A.String "textDocument/publishDiagnostics"   -- Cancelling

@@ -259,12 +259,12 @@ splitClientMethod STextDocumentSemanticTokensFull = IsClientReq splitClientMethod STextDocumentSemanticTokensFullDelta = IsClientReq splitClientMethod STextDocumentSemanticTokensRange = IsClientReq-splitClientMethod SWorkspaceSemanticTokensRefresh  = IsClientReq splitClientMethod SCancelRequest = IsClientNot splitClientMethod SCustomMethod{} = IsClientEither  {-# INLINE splitServerMethod #-} splitServerMethod :: SServerMethod m -> ServerNotOrReq m+-- Window splitServerMethod SWindowShowMessage = IsServerNot splitServerMethod SWindowShowMessageRequest = IsServerReq splitServerMethod SWindowShowDocument = IsServerReq@@ -272,13 +272,19 @@ splitServerMethod SWindowWorkDoneProgressCreate = IsServerReq splitServerMethod SProgress = IsServerNot splitServerMethod STelemetryEvent = IsServerNot+-- Client splitServerMethod SClientRegisterCapability = IsServerReq splitServerMethod SClientUnregisterCapability = IsServerReq+-- Workspace splitServerMethod SWorkspaceWorkspaceFolders = IsServerReq splitServerMethod SWorkspaceConfiguration = IsServerReq splitServerMethod SWorkspaceApplyEdit = IsServerReq+splitServerMethod SWorkspaceSemanticTokensRefresh = IsServerReq+-- Document splitServerMethod STextDocumentPublishDiagnostics = IsServerNot+-- Cancelling splitServerMethod SCancelRequest = IsServerNot+-- Custom splitServerMethod SCustomMethod{} = IsServerEither  -- | Given a witness that two custom methods are of the same type, produce a witness that the methods are the same

@@ -1,7 +1,11 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE TypeSynonymInstances       #-}+ module Language.LSP.Types.Uri   ( Uri(..)   , uriToFilePath@@ -10,11 +14,11 @@   , toNormalizedUri   , fromNormalizedUri   , NormalizedFilePath-  , normalizedFilePath   , toNormalizedFilePath   , fromNormalizedFilePath   , normalizedFilePathToUri   , uriToNormalizedFilePath+  , emptyNormalizedFilePath   -- Private functions   , platformAwareUriToFilePath   , platformAwareFilePathToUri@@ -22,18 +26,19 @@   where  import           Control.DeepSeq-import qualified Data.Aeson                                 as A-import           Data.Binary                                (Binary, Get, put, get)+import qualified Data.Aeson              as A+import           Data.Binary             (Binary, Get, get, put) import           Data.Hashable-import           Data.List                                  (stripPrefix)-import           Data.String                                (IsString, fromString)-import           Data.Text                                  (Text)-import qualified Data.Text                                  as T+import           Data.List               (stripPrefix)+import           Data.String             (IsString (fromString))+import           Data.Text               (Text)+import qualified Data.Text               as T import           GHC.Generics-import           Network.URI hiding (authority)-import qualified System.FilePath                            as FP-import qualified System.FilePath.Posix                      as FPP-import qualified System.FilePath.Windows                    as FPW+import           Network.URI             hiding (authority)+import           Safe                    (tailMay)+import qualified System.FilePath         as FP+import qualified System.FilePath.Posix   as FPP+import qualified System.FilePath.Windows as FPW import qualified System.Info  newtype Uri = Uri { getUri :: Text }@@ -67,7 +72,7 @@ normalizeUriEscaping :: String -> String normalizeUriEscaping uri =   case stripPrefix (fileScheme ++ "//") uri of-    Just p -> fileScheme ++ "//" ++ (escapeURIPath $ unEscapeString p)+    Just p  -> fileScheme ++ "//" ++ escapeURIPath (unEscapeString p)     Nothing -> escapeURIString isUnescapedInURI $ unEscapeString uri   where escapeURIPath = escapeURIString (isUnescapedInUriPath System.Info.os) @@ -107,17 +112,19 @@                           -> String -- ^ path                           -> FilePath platformAdjustFromUriPath systemOS authority srcPath =-  (maybe id (++) authority) $-  if systemOS /= windowsOS || null srcPath then srcPath-    else let-      firstSegment:rest = (FPP.splitDirectories . tail) srcPath  -- Drop leading '/' for absolute Windows paths-      drive = if FPW.isDrive firstSegment-              then FPW.addTrailingPathSeparator firstSegment-              else firstSegment-      in FPW.joinDrive drive $ FPW.joinPath rest+  maybe id (++) authority $+  if systemOS /= windowsOS+  then srcPath+  else case FPP.splitDirectories <$> tailMay srcPath of+      Just (firstSegment:rest) -> -- Drop leading '/' for absolute Windows paths+        let drive = if FPW.isDrive firstSegment+                    then FPW.addTrailingPathSeparator firstSegment+                    else firstSegment+         in FPW.joinDrive drive $ FPW.joinPath rest+      _ -> srcPath  filePathToUri :: FilePath -> Uri-filePathToUri = (platformAwareFilePathToUri System.Info.os) . FP.normalise+filePathToUri = platformAwareFilePathToUri System.Info.os . FP.normalise  {-# WARNING platformAwareFilePathToUri "This function is considered private. Use normalizedUriToFilePath instead." #-} platformAwareFilePathToUri :: SystemOS -> FilePath -> Uri@@ -151,13 +158,30 @@           FPP.addTrailingPathSeparator (init drv)       | otherwise = drv --- | Newtype wrapper around FilePath that always has normalized slashes.--- The NormalizedUri and hash of the FilePath are cached to avoided--- repeated normalisation when we need to compute them (which is a lot).------ This is one of the most performance critical parts of ghcide, do not--- modify it without profiling.-data NormalizedFilePath = NormalizedFilePath NormalizedUri !FilePath+{-| A file path that is already normalized.++The 'NormalizedUri' is cached to avoided+repeated normalisation when we need to compute them (which is a lot).++This is one of the most performance critical parts of HLS, do not+modify it without profiling.++== Adoption Plan of OsPath++Currently we store 'Text'. We may change it to OsPath in the future if+the following steps are executed.++1. In the client codebase, use 'osPathToNormalizedFilePath' and 'normalizedFilePathToOsPath' instead of 'fromNormalizedFilePath'+  and 'toNormalizedFilePath'. For HLS, we could wait until GHC 9.6 becomes the oldest+  GHC we support, then change 'FilePath' to OsPath everywhere in the codebase.+2. Deprecate and remove 'fromNormalizedFilePath' and 'toNormalizedFilePath'.+3. Change 'Text' to OsPath and benchmark it to make sure performance doesn't go down. Don't forget to check Windows,+  as OsPath on Windows uses UTF-16, which may consume more memory.++See [#453](https://github.com/haskell/lsp/pull/453) and [#446](https://github.com/haskell/lsp/pull/446)+for more discussions on this topic.+-}+data NormalizedFilePath = NormalizedFilePath !NormalizedUri {-# UNPACK #-} !Text     deriving (Generic, Eq, Ord)  instance NFData NormalizedFilePath@@ -165,13 +189,8 @@ instance Binary NormalizedFilePath where   put (NormalizedFilePath _ fp) = put fp   get = do-    v <- Data.Binary.get :: Get FilePath-    let nuri = internalNormalizedFilePathToUri v-    return (normalizedFilePath nuri v)---- | A smart constructor that performs UTF-8 encoding and hash consing-normalizedFilePath :: NormalizedUri -> FilePath -> NormalizedFilePath-normalizedFilePath nuri nfp = NormalizedFilePath nuri nfp+    v <- Data.Binary.get :: Get Text+    return (NormalizedFilePath (internalNormalizedFilePathToUri (T.unpack v)) v)  -- | Internal helper that takes a file path that is assumed to -- already be normalized to a URI. It is up to the caller@@ -191,20 +210,32 @@   hashWithSalt salt (NormalizedFilePath uri _) = hashWithSalt salt uri  instance IsString NormalizedFilePath where+    fromString :: String -> NormalizedFilePath     fromString = toNormalizedFilePath  toNormalizedFilePath :: FilePath -> NormalizedFilePath-toNormalizedFilePath fp = normalizedFilePath nuri nfp+toNormalizedFilePath fp = NormalizedFilePath nuri . T.pack $ nfp   where-      nfp = FP.normalise fp-      nuri = internalNormalizedFilePathToUri nfp+    nfp = FP.normalise fp+    nuri = internalNormalizedFilePathToUri nfp +-- | Extracts 'FilePath' from 'NormalizedFilePath'. fromNormalizedFilePath :: NormalizedFilePath -> FilePath-fromNormalizedFilePath (NormalizedFilePath _ fp) = fp+fromNormalizedFilePath (NormalizedFilePath _ fp) = T.unpack fp  normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri normalizedFilePathToUri (NormalizedFilePath uri _) = uri  uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath-uriToNormalizedFilePath nuri = fmap (normalizedFilePath nuri) mbFilePath+uriToNormalizedFilePath nuri = fmap (NormalizedFilePath nuri . T.pack) mbFilePath   where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri)++emptyNormalizedUri :: NormalizedUri+emptyNormalizedUri =+    let s = "file://"+    in NormalizedUri (hash s) s++-- | 'NormalizedFilePath' that contains an empty file path+emptyNormalizedFilePath :: NormalizedFilePath+emptyNormalizedFilePath = NormalizedFilePath emptyNormalizedUri ""+

@@ -0,0 +1,53 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE ScopedTypeVariables #-}++#if MIN_VERSION_filepath(1,4,100)+#define OS_PATH 1+#endif++module Language.LSP.Types.Uri.OsPath+  (+#ifdef OS_PATH+    osPathToNormalizedFilePath+  , normalizedFilePathToOsPath+  , EncodingException+#endif+  ) where++#ifdef OS_PATH++import           Control.Exception      hiding (try)+import           Control.Monad.Catch+import           GHC.IO.Encoding        (getFileSystemEncoding)+import           Language.LSP.Types.Uri+import           System.IO+import           System.IO.Unsafe       (unsafePerformIO)+import           System.OsPath+import           System.OsPath.Encoding (EncodingException)++{-|+Constructs 'NormalizedFilePath' from 'OsPath'. Throws 'EncodingException' if the conversion fails.++We store a 'Text' in 'NormalizedFilePath', which is UTF-16 or UTF-8 depending on the verion of text library.+'OsPath' may have a different encoding than 'Text', so this function may fail.+But DO NOTE THAT encoding mismatch doesn't always mean an exception will be thrown.+[Possibly your encoding simply won't throw exception on failure](https://hackage.haskell.org/package/base-4.17.0.0/docs/src/GHC.IO.Encoding.html#initFileSystemEncoding).+Possibly the conversion function can't find any invalid byte sequence, giving a sucessful but wrong result.+-}+osPathToNormalizedFilePath :: MonadThrow m => OsPath -> m NormalizedFilePath+osPathToNormalizedFilePath = fmap toNormalizedFilePath . liftException . decodeWith systemEnc utf16le++{-|+Extracts 'OsPath' from 'NormalizedFilePath'. Throws 'EncodingException' if the conversion fails.+-}+normalizedFilePathToOsPath :: MonadThrow m => NormalizedFilePath -> m OsPath+normalizedFilePathToOsPath = liftException . encodeWith systemEnc utf16le . fromNormalizedFilePath++liftException :: (MonadThrow m, Exception e) => Either e a -> m a+liftException (Right x)  = pure x+liftException (Left err) = throwM err++systemEnc :: TextEncoding+systemEnc = unsafePerformIO getFileSystemEncoding++#endif

@@ -0,0 +1,16 @@+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

@@ -0,0 +1,173 @@+{-# 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++-- ---------------------------------------------------------------------

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module LocationSpec where++import           Language.LSP.Types+import           Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "isSubrangeOf" $ do+    it "is true if the first range is totally inside the second range" $+      isSubrangeOf (mkRange 1 2 1 5) (mkRange 1 1 1 6) `shouldBe` True+    it "is true if two ranges equal" $+      isSubrangeOf (mkRange 1 2 1 5) (mkRange 1 2 1 5) `shouldBe` True+    it "is false if the first range is outside of the second" $+      isSubrangeOf (mkRange 1 1 1 5) (mkRange 1 2 1 5) `shouldBe` False++  describe "positionInRange" $ do+    it "is false if position is after the end of a single line range" $+      positionInRange (Position 1 10) (Range (Position 1 1) (Position 1 3)) `shouldBe` False+    it "is false if position is before the begining of a single line range" $+      positionInRange (Position 1 0) (Range (Position 1 1) (Position 1 6)) `shouldBe` False+    it "is true if position is in a single line range" $+      positionInRange (Position 1 5) (Range (Position 1 1) (Position 1 6)) `shouldBe` True+    it "is false if position is right at the end of the range" $+      positionInRange (Position 1 5) (Range (Position 1 1) (Position 1 5)) `shouldBe` False+    it "is true if position is in the middle of a multiline range" $+      positionInRange (Position 3 5) (Range (Position 1 1) (Position 5 6)) `shouldBe` True+    it "is false if position is before the beginning of a multiline range" $+      positionInRange (Position 3 5) (Range (Position 3 6) (Position 4 10)) `shouldBe` False+    it "is false if position is right at the end of a multiline range" $+      positionInRange (Position 4 10) (Range (Position 3 6) (Position 4 10)) `shouldBe` False

@@ -0,0 +1,7 @@+module Main where++import Test.Hspec.Runner+import qualified Spec++main :: IO ()+main = hspec Spec.spec

@@ -0,0 +1,99 @@+{-# 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)++    -- ---------------------------------

@@ -0,0 +1,74 @@+{-# 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)

@@ -0,0 +1,40 @@+{-# 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\"}]"

@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}+{-++See https://github.com/hspec/hspec/tree/master/hspec-discover#readme+to understand this module++Or http://hspec.github.io/hspec-discover.html++-}

@@ -0,0 +1,30 @@+{-# 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"++-- ---------------------------------------------------------------------

@@ -0,0 +1,311 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++#if MIN_VERSION_filepath(1,4,100)+#define OS_PATH+#endif++module URIFilePathSpec where++#ifdef OS_PATH+import qualified System.OsPath           as OsPath+#endif++import           Control.Monad           (when)+import           Data.List+import           Data.Text               (Text, pack)+import           Language.LSP.Types++import           Control.Exception       (IOException, throwIO)+import           Data.Maybe              (fromJust)+import           GHC.IO.Encoding         (setFileSystemEncoding)+import           Network.URI+import           System.FilePath         (normalise)+import qualified System.FilePath.Windows as FPW+import qualified System.Info+import           System.IO+import           Test.Hspec+import           Test.QuickCheck++-- ---------------------------------------------------------------------++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 = beforeAll (setFileSystemEncoding utf8) $ 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++#ifdef OS_PATH+  it "converts to NormalizedFilePath and back sucessfully" $ property $ forAll genFilePath $ \fp -> do+    let osPath = fromJust (OsPath.encodeUtf fp)+    osPath' <- osPathToNormalizedFilePath osPath >>= normalizedFilePathToOsPath+    osPath' `shouldBe` OsPath.normalise osPath++  it "can not convert OsPath in non-standard encoding to NormalizedFilePath" $+    -- Windows always use UTF16LE, the following test case doesn't apply+    when (not isWindows) $+      -- \184921 is an example that the raw bytes of UTF16 is not valid UTF8.+      -- Case like this is not very common. I found it with the help of QuickCheck.+      case OsPath.encodeWith utf16be utf16be "\184921" of+        Left err -> throwIO err+        Right osPath  -> do+          osPathToNormalizedFilePath osPath `shouldThrow` \(_ :: EncodingException) -> True+#endif

@@ -0,0 +1,28 @@+{-# 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