packages feed

lsp-types 1.4.0.1 → 1.5.0.0

raw patch · 13 files changed

+46/−393 lines, 13 filesdep −bytestringdep −directorydep −hsloggerdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies removed: bytestring, directory, hslogger, rope-utf16-splay, temporary

Dependency ranges changed: mtl

API changes (from Hackage documentation)

- Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasWorkspaceSymbolProvider Language.LSP.Types.ServerCapabilities.ServerCapabilities (GHC.Maybe.Maybe GHC.Types.Bool)
- Language.LSP.VFS: PosPrefixInfo :: !Text -> !Text -> !Text -> !Position -> PosPrefixInfo
- Language.LSP.VFS: VFS :: !Map NormalizedUri VirtualFile -> !FilePath -> VFS
- Language.LSP.VFS: VirtualFile :: !Int32 -> !Int -> !Rope -> VirtualFile
- Language.LSP.VFS: [$sel:_file_version:VirtualFile] :: VirtualFile -> !Int
- Language.LSP.VFS: [$sel:_lsp_version:VirtualFile] :: VirtualFile -> !Int32
- Language.LSP.VFS: [$sel:_text:VirtualFile] :: VirtualFile -> !Rope
- Language.LSP.VFS: [$sel:cursorPos:PosPrefixInfo] :: PosPrefixInfo -> !Position
- Language.LSP.VFS: [$sel:fullLine:PosPrefixInfo] :: PosPrefixInfo -> !Text
- Language.LSP.VFS: [$sel:prefixModule:PosPrefixInfo] :: PosPrefixInfo -> !Text
- Language.LSP.VFS: [$sel:prefixText:PosPrefixInfo] :: PosPrefixInfo -> !Text
- Language.LSP.VFS: [$sel:vfsMap:VFS] :: VFS -> !Map NormalizedUri VirtualFile
- Language.LSP.VFS: [$sel:vfsTempDir:VFS] :: VFS -> !FilePath
- Language.LSP.VFS: applyChange :: Rope -> TextDocumentContentChangeEvent -> Rope
- Language.LSP.VFS: applyChanges :: Rope -> [TextDocumentContentChangeEvent] -> Rope
- Language.LSP.VFS: changeChars :: Rope -> Int -> Int -> Text -> Rope
- Language.LSP.VFS: changeFromClientVFS :: VFS -> Message 'TextDocumentDidChange -> (VFS, [String])
- Language.LSP.VFS: changeFromServerVFS :: VFS -> Message 'WorkspaceApplyEdit -> IO VFS
- Language.LSP.VFS: closeVFS :: VFS -> Message 'TextDocumentDidClose -> (VFS, [String])
- Language.LSP.VFS: data PosPrefixInfo
- Language.LSP.VFS: data VFS
- Language.LSP.VFS: data VirtualFile
- Language.LSP.VFS: getCompletionPrefix :: Monad m => Position -> VirtualFile -> m (Maybe PosPrefixInfo)
- Language.LSP.VFS: initVFS :: (VFS -> IO r) -> IO r
- Language.LSP.VFS: instance GHC.Classes.Eq Language.LSP.VFS.PosPrefixInfo
- Language.LSP.VFS: instance GHC.Show.Show Language.LSP.VFS.PosPrefixInfo
- Language.LSP.VFS: instance GHC.Show.Show Language.LSP.VFS.VFS
- Language.LSP.VFS: instance GHC.Show.Show Language.LSP.VFS.VirtualFile
- Language.LSP.VFS: openVFS :: VFS -> Message 'TextDocumentDidOpen -> (VFS, [String])
- Language.LSP.VFS: persistFileVFS :: VFS -> NormalizedUri -> Maybe (FilePath, IO ())
- Language.LSP.VFS: rangeLinesFromVfs :: VirtualFile -> Range -> Text
- Language.LSP.VFS: updateVFS :: (VFSMap -> VFSMap) -> VFS -> VFS
- Language.LSP.VFS: virtualFileText :: VirtualFile -> Text
- Language.LSP.VFS: virtualFileVersion :: VirtualFile -> Int32
+ Language.LSP.Types: SttNamespace :: SemanticTokenTypes
+ Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasContext Language.LSP.Types.SignatureHelp.SignatureHelpParams (GHC.Maybe.Maybe Language.LSP.Types.SignatureHelp.SignatureHelpContext)
+ Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasPosition Language.LSP.Types.SignatureHelp.SignatureHelpParams Language.LSP.Types.Location.Position
+ Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasTextDocument Language.LSP.Types.SignatureHelp.SignatureHelpParams Language.LSP.Types.TextDocument.TextDocumentIdentifier
+ Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasWorkDoneToken Language.LSP.Types.SignatureHelp.SignatureHelpParams (GHC.Maybe.Maybe Language.LSP.Types.Progress.ProgressToken)
+ Language.LSP.Types.Lens: instance Language.LSP.Types.Lens.HasWorkspaceSymbolProvider Language.LSP.Types.ServerCapabilities.ServerCapabilities (GHC.Maybe.Maybe (GHC.Types.Bool Language.LSP.Types.Common.|? Language.LSP.Types.WorkspaceSymbol.WorkspaceSymbolOptions))
- Language.LSP.Types: regHelper :: forall m_a63Iw x_a63Ix. SMethod m_a63Iw -> (Show (RegistrationOptions m_a63Iw) => ToJSON (RegistrationOptions m_a63Iw) => FromJSON (RegistrationOptions m_a63Iw) => x_a63Ix) -> x_a63Ix
+ Language.LSP.Types: regHelper :: forall m_a648B x_a648C. SMethod m_a648B -> (Show (RegistrationOptions m_a648B) => ToJSON (RegistrationOptions m_a648B) => FromJSON (RegistrationOptions m_a648B) => x_a648C) -> x_a648C
- Language.LSP.Types.Capabilities: ServerCapabilities :: Maybe (TextDocumentSyncOptions |? TextDocumentSyncKind) -> Maybe (Bool |? HoverOptions) -> Maybe CompletionOptions -> Maybe SignatureHelpOptions -> Maybe (Bool |? (DeclarationOptions |? DeclarationRegistrationOptions)) -> Maybe (Bool |? DefinitionOptions) -> Maybe (Bool |? (TypeDefinitionOptions |? TypeDefinitionRegistrationOptions)) -> Maybe (Bool |? (ImplementationOptions |? ImplementationRegistrationOptions)) -> Maybe (Bool |? ReferenceOptions) -> Maybe (Bool |? DocumentHighlightOptions) -> Maybe (Bool |? DocumentSymbolOptions) -> Maybe (Bool |? CodeActionOptions) -> Maybe CodeLensOptions -> Maybe DocumentLinkOptions -> Maybe (Bool |? (DocumentColorOptions |? DocumentColorRegistrationOptions)) -> Maybe (Bool |? DocumentFormattingOptions) -> Maybe (Bool |? DocumentRangeFormattingOptions) -> Maybe DocumentOnTypeFormattingOptions -> Maybe (Bool |? RenameOptions) -> Maybe (Bool |? (FoldingRangeOptions |? FoldingRangeRegistrationOptions)) -> Maybe ExecuteCommandOptions -> Maybe (Bool |? (SelectionRangeOptions |? SelectionRangeRegistrationOptions)) -> Maybe (Bool |? (CallHierarchyOptions |? CallHierarchyRegistrationOptions)) -> Maybe (SemanticTokensOptions |? SemanticTokensRegistrationOptions) -> Maybe Bool -> Maybe WorkspaceServerCapabilities -> Maybe Value -> ServerCapabilities
+ Language.LSP.Types.Capabilities: ServerCapabilities :: Maybe (TextDocumentSyncOptions |? TextDocumentSyncKind) -> Maybe (Bool |? HoverOptions) -> Maybe CompletionOptions -> Maybe SignatureHelpOptions -> Maybe (Bool |? (DeclarationOptions |? DeclarationRegistrationOptions)) -> Maybe (Bool |? DefinitionOptions) -> Maybe (Bool |? (TypeDefinitionOptions |? TypeDefinitionRegistrationOptions)) -> Maybe (Bool |? (ImplementationOptions |? ImplementationRegistrationOptions)) -> Maybe (Bool |? ReferenceOptions) -> Maybe (Bool |? DocumentHighlightOptions) -> Maybe (Bool |? DocumentSymbolOptions) -> Maybe (Bool |? CodeActionOptions) -> Maybe CodeLensOptions -> Maybe DocumentLinkOptions -> Maybe (Bool |? (DocumentColorOptions |? DocumentColorRegistrationOptions)) -> Maybe (Bool |? DocumentFormattingOptions) -> Maybe (Bool |? DocumentRangeFormattingOptions) -> Maybe DocumentOnTypeFormattingOptions -> Maybe (Bool |? RenameOptions) -> Maybe (Bool |? (FoldingRangeOptions |? FoldingRangeRegistrationOptions)) -> Maybe ExecuteCommandOptions -> Maybe (Bool |? (SelectionRangeOptions |? SelectionRangeRegistrationOptions)) -> Maybe (Bool |? (CallHierarchyOptions |? CallHierarchyRegistrationOptions)) -> Maybe (SemanticTokensOptions |? SemanticTokensRegistrationOptions) -> Maybe (Bool |? WorkspaceSymbolOptions) -> Maybe WorkspaceServerCapabilities -> Maybe Value -> ServerCapabilities
- Language.LSP.Types.Capabilities: [$sel:_workspaceSymbolProvider:ServerCapabilities] :: ServerCapabilities -> Maybe Bool
+ Language.LSP.Types.Capabilities: [$sel:_workspaceSymbolProvider:ServerCapabilities] :: ServerCapabilities -> Maybe (Bool |? WorkspaceSymbolOptions)
- Language.LSP.Types.Lens: _InL :: forall a_a6WPX b_ac6Y a_ac6X. Prism ((|?) a_a6WPX b_ac6Y) ((|?) a_ac6X b_ac6Y) a_a6WPX a_ac6X
+ Language.LSP.Types.Lens: _InL :: forall a_a6XhT b_aarW a_aarV. Prism ((|?) a_a6XhT b_aarW) ((|?) a_aarV b_aarW) a_a6XhT a_aarV
- Language.LSP.Types.Lens: _InR :: forall a_ac6X b_a6WQ2 b_ac6Y. Prism ((|?) a_ac6X b_a6WQ2) ((|?) a_ac6X b_ac6Y) b_a6WQ2 b_ac6Y
+ Language.LSP.Types.Lens: _InR :: forall a_aarV b_a6XhY b_aarW. Prism ((|?) a_aarV b_a6XhY) ((|?) a_aarV b_aarW) b_a6XhY b_aarW

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for lsp-types  +## 1.5.0.0++* VFS module moved from `lsp-types` to `lsp`, as it relates to the actual implementation of a LSP server.+ ## 1.4.0.1  * Fix result type of selection range requests.
lsp-types.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                lsp-types-version:             1.4.0.1+version:             1.5.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -21,7 +21,6 @@                      , Language.LSP.Types.Capabilities                      , Language.LSP.Types.Lens                      , Language.LSP.Types.SMethodMap-                     , Language.LSP.VFS                      , Data.IxMap   other-modules:       Language.LSP.Types.CallHierarchy                      , Language.LSP.Types.Cancellation@@ -74,26 +73,21 @@   build-depends:       base >= 4.11 && < 5                      , aeson >=1.2.2.0                      , binary-                     , bytestring                      , containers                      , data-default                      , deepseq-                     , Diff-                     , directory+                     , Diff >= 0.2                      , dlist                      , filepath                      , hashable-                     , hslogger                      , lens >= 4.15.2-                     , mtl-                     , network-uri+                     , mtl < 2.4+                     , network-uri >= 2.6                      , mod-                     , rope-utf16-splay >= 0.3.1.0                      , scientific                      , some                      , text                      , template-haskell-                     , temporary                      , unordered-containers   hs-source-dirs:      src   default-language:    Haskell2010
src/Language/LSP/Types/Common.hs view
@@ -18,6 +18,7 @@ import Control.Applicative import Control.DeepSeq import Data.Aeson+import Data.Hashable import Data.Int (Int32) import Data.Mod.Word import Text.Read (Read(readPrec))@@ -32,6 +33,8 @@   deriving newtype (Num, Bounded, Enum, Eq, Ord)   deriving stock (Generic)   deriving anyclass (NFData)++instance Hashable UInt where hashWithSalt s (UInt n) = hashWithSalt s (unMod n)  instance Show UInt where   show (UInt u) = show $ unMod u
src/Language/LSP/Types/Lens.hs view
@@ -56,7 +56,7 @@ import           Language.LSP.Types.SemanticTokens import           Control.Lens.TH --- TODO: This is out of date and very unmantainable, use TH to call all these!!+-- TODO: This is out of date and very unmaintainable, use TH to call all these!!  -- client capabilities makeFieldsNoPrefix ''MessageActionItemClientCapabilities@@ -360,6 +360,7 @@ -- Signature Help makeFieldsNoPrefix ''SignatureHelpSignatureInformation makeFieldsNoPrefix ''SignatureHelpParameterInformation+makeFieldsNoPrefix ''SignatureHelpParams makeFieldsNoPrefix ''SignatureHelpClientCapabilities makeFieldsNoPrefix ''SignatureHelpOptions makeFieldsNoPrefix ''SignatureHelpRegistrationOptions
src/Language/LSP/Types/Location.hs view
@@ -4,6 +4,7 @@  import           Control.DeepSeq import           Data.Aeson.TH+import           Data.Hashable import           GHC.Generics hiding (UInt) import           Language.LSP.Types.Common import           Language.LSP.Types.Uri@@ -11,6 +12,8 @@  -- --------------------------------------------------------------------- +-- | A position in a document. Note that the character offsets in a line+-- are given in UTF-16 code units, *not* Unicode code points. data Position =   Position     { -- | Line position in a document (zero-based).@@ -24,6 +27,8 @@ instance NFData Position deriveJSON lspOptions ''Position +instance Hashable Position+ -- ---------------------------------------------------------------------  data Range =@@ -35,6 +40,8 @@ instance NFData Range deriveJSON lspOptions ''Range +instance Hashable Range+ -- ---------------------------------------------------------------------  data Location =@@ -45,6 +52,8 @@  instance NFData Location deriveJSON lspOptions ''Location++instance Hashable Location  -- --------------------------------------------------------------------- 
src/Language/LSP/Types/LspId.hs view
@@ -7,9 +7,10 @@ module Language.LSP.Types.LspId where  import qualified Data.Aeson                                 as A-import           Data.Text                                  (Text)+import           Data.Hashable import           Data.Int (Int32) import           Data.IxMap+import           Data.Text                                  (Text)  import           Language.LSP.Types.Method @@ -30,6 +31,10 @@   type Base LspId = SomeLspId   toBase = SomeLspId +instance Hashable (LspId m) where+  hashWithSalt n (IdInt i) = hashWithSalt n i+  hashWithSalt n (IdString t) = hashWithSalt n t+ data SomeLspId where   SomeLspId :: !(LspId m) -> SomeLspId @@ -45,3 +50,6 @@       go (IdString a) (IdString b) = a `compare` b       go (IdInt    _) (IdString _) = LT       go (IdString _) (IdInt    _) = GT++instance Hashable SomeLspId where+  hashWithSalt n (SomeLspId lspId) = hashWithSalt n lspId
src/Language/LSP/Types/Message.hs view
@@ -372,7 +372,7 @@ deriving instance Show (ResponseResult m) => Show (ResponseMessage m)  instance (ToJSON (ResponseResult m)) => ToJSON (ResponseMessage m) where-  toJSON (ResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result })+  toJSON ResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result }     = object       [ "jsonrpc" .= jsonrpc       , "id" .= lspid@@ -389,11 +389,11 @@     _result  <- o .:! "result"     _error   <- o .:? "error"     result   <- case (_error, _result) of-      ((Just err), Nothing   ) -> pure $ Left err-      (Nothing   , (Just res)) -> pure $ Right res-      ((Just _err), (Just _res)) -> fail $ "both error and result cannot be present: " ++ show o+      (Just err, Nothing) -> pure $ Left err+      (Nothing, Just res) -> pure $ Right res+      (Just _err, Just _res) -> fail $ "both error and result cannot be present: " ++ show o       (Nothing, Nothing) -> fail "both error and result cannot be Nothing"-    return $ ResponseMessage _jsonrpc _id $ result+    return $ ResponseMessage _jsonrpc _id result  -- --------------------------------------------------------------------- -- Helper Type Families
src/Language/LSP/Types/Method.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE DataKinds                  #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE MagicHash                  #-} {-# LANGUAGE TypeFamilies               #-}
src/Language/LSP/Types/Parsing.hs view
@@ -29,7 +29,7 @@ import Data.Function (on)  -- ------------------------------------------------------------------------ Working with arbritary messages+-- Working with arbitrary messages -- ---------------------------------------------------------------------  data FromServerMessage' a where
src/Language/LSP/Types/SMethodMap.hs view
@@ -28,7 +28,7 @@  -- This type exists to avoid a dependency on 'dependent-map'. It is less -- safe (since we use 'unsafeCoerce') but much simpler and hence easier to include.--- | A specialized altenative to a full dependent map for use with 'SMethod'.+-- | A specialized alternative to a full dependent map for use with 'SMethod'. data SMethodMap (v :: Method f t -> Type) =   -- This works by using an 'IntMap' indexed by constructor tag for the majority   -- of 'SMethod's, which have no parameters, and hence can only appear once as keys
src/Language/LSP/Types/SemanticTokens.hs view
@@ -29,7 +29,8 @@ import           Data.String  data SemanticTokenTypes =-  SttType+  SttNamespace+  | SttType   | SttClass   | SttEnum   | SttInterface@@ -54,6 +55,7 @@   deriving (Show, Read, Eq, Ord)  instance A.ToJSON SemanticTokenTypes where+  toJSON SttNamespace     = A.String "namespace"   toJSON SttType          = A.String "type"   toJSON SttClass         = A.String "class"   toJSON SttEnum          = A.String "enum"@@ -78,6 +80,7 @@   toJSON (SttUnknown t)   = A.String t  instance A.FromJSON SemanticTokenTypes where+  parseJSON (A.String "namespace")     = pure SttNamespace   parseJSON (A.String "type")          = pure SttType   parseJSON (A.String "class")         = pure SttClass   parseJSON (A.String "enum")          = pure SttEnum@@ -105,7 +108,8 @@ -- | The set of semantic token types which are "known" (i.e. listed in the LSP spec). knownSemanticTokenTypes :: [SemanticTokenTypes] knownSemanticTokenTypes = [-  SttType+  SttNamespace+  , SttType   , SttClass   , SttEnum   , SttInterface
src/Language/LSP/Types/ServerCapabilities.hs view
@@ -31,6 +31,7 @@ import Language.LSP.Types.TextDocument import Language.LSP.Types.TypeDefinition import Language.LSP.Types.Utils+import Language.LSP.Types.WorkspaceSymbol  -- --------------------------------------------------------------------- @@ -126,7 +127,7 @@       -- @since 3.16.0     , _semanticTokensProvider           :: Maybe (SemanticTokensOptions |? SemanticTokensRegistrationOptions)       -- | The server provides workspace symbol support.-    , _workspaceSymbolProvider          :: Maybe Bool+    , _workspaceSymbolProvider          :: Maybe (Bool |? WorkspaceSymbolOptions)       -- | Workspace specific server capabilities     , _workspace                        :: Maybe WorkspaceServerCapabilities       -- | Experimental server capabilities.
− src/Language/LSP/VFS.hs
@@ -1,370 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE TypeOperators #-}--{-|-Handles the "Language.LSP.Types.TextDocumentDidChange" \/-"Language.LSP.Types.TextDocumentDidOpen" \/-"Language.LSP.Types.TextDocumentDidClose" messages to keep an in-memory-`filesystem` of the current client workspace.  The server can access and edit-files in the client workspace by operating on the "VFS" in "LspFuncs".--}-module Language.LSP.VFS-  (-    VFS(..)-  , VirtualFile(..)-  , virtualFileText-  , virtualFileVersion-  -- * Managing the VFS-  , initVFS-  , openVFS-  , changeFromClientVFS-  , changeFromServerVFS-  , persistFileVFS-  , closeVFS-  , updateVFS--  -- * manipulating the file contents-  , rangeLinesFromVfs-  , PosPrefixInfo(..)-  , getCompletionPrefix--  -- * for tests-  , applyChanges-  , applyChange-  , changeChars-  ) where--import           Control.Lens hiding ( (<.>), parts )-import           Control.Monad-import           Data.Char (isUpper, isAlphaNum)-import           Data.Text ( Text )-import qualified Data.Text as T-import           Data.Int (Int32)-import           Data.List-import           Data.Ord-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Map.Strict as Map-import           Data.Maybe-import           Data.Rope.UTF16 ( Rope )-import qualified Data.Rope.UTF16 as Rope-import qualified Language.LSP.Types           as J-import qualified Language.LSP.Types.Lens      as J-import           System.FilePath-import           Data.Hashable-import           System.Directory-import           System.IO -import           System.IO.Temp-import           System.Log.Logger---- ----------------------------------------------------------------------{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}-{-# ANN module ("hlint: ignore Redundant do" :: String) #-}--- -----------------------------------------------------------------------data VirtualFile =-  VirtualFile {-      _lsp_version :: !Int32  -- ^ The LSP version of the document-    , _file_version :: !Int -- ^ This number is only incremented whilst the file-                           -- remains in the map.-    , _text    :: !Rope  -- ^ The full contents of the document-    } deriving (Show)---type VFSMap = Map.Map J.NormalizedUri VirtualFile--data VFS = VFS { vfsMap :: !(Map.Map J.NormalizedUri VirtualFile)-               , vfsTempDir :: !FilePath -- ^ This is where all the temporary files will be written to-               } deriving Show-------virtualFileText :: VirtualFile -> Text-virtualFileText vf = Rope.toText (_text  vf)--virtualFileVersion :: VirtualFile -> Int32-virtualFileVersion vf = _lsp_version vf-------initVFS :: (VFS -> IO r) -> IO r-initVFS k = withSystemTempDirectory "haskell-lsp" $ \temp_dir -> k (VFS mempty temp_dir)---- ------------------------------------------------------------------------- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS'-openVFS :: VFS -> J.Message 'J.TextDocumentDidOpen -> (VFS, [String])-openVFS vfs (J.NotificationMessage _ _ params) =-  let J.DidOpenTextDocumentParams-         (J.TextDocumentItem uri _ version text) = params-  in (updateVFS (Map.insert (J.toNormalizedUri uri) (VirtualFile version 0 (Rope.fromText text))) vfs-     , [])----- ------------------------------------------------------------------------- ^ Applies a 'DidChangeTextDocumentNotification' to the 'VFS'-changeFromClientVFS :: VFS -> J.Message 'J.TextDocumentDidChange -> (VFS,[String])-changeFromClientVFS vfs (J.NotificationMessage _ _ params) =-  let-    J.DidChangeTextDocumentParams vid (J.List changes) = params-    J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid-  in-    case Map.lookup uri (vfsMap vfs) of-      Just (VirtualFile _ file_ver str) ->-        let str' = applyChanges str changes-        -- the client shouldn't be sending over a null version, only the server.-        in (updateVFS (Map.insert uri (VirtualFile (fromMaybe 0 version) (file_ver + 1) str')) vfs, [])-      Nothing ->-        -- logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri-        -- return vfs-        (vfs, ["haskell-lsp:changeVfs:can't find uri:" ++ show uri])--updateVFS :: (VFSMap -> VFSMap) -> VFS -> VFS-updateVFS f vfs@VFS{vfsMap} = vfs { vfsMap = f vfsMap }---- -----------------------------------------------------------------------applyCreateFile :: J.CreateFile -> VFS -> VFS-applyCreateFile (J.CreateFile uri options _ann) = -  updateVFS $ Map.insertWith -                (\ new old -> if shouldOverwrite then new else old)-                (J.toNormalizedUri uri)-                (VirtualFile 0 0 (Rope.fromText ""))-  where -    shouldOverwrite :: Bool -    shouldOverwrite = case options of -        Nothing                                               -> False  -- default-        Just (J.CreateFileOptions Nothing       Nothing     ) -> False  -- default-        Just (J.CreateFileOptions Nothing       (Just True) ) -> False  -- `ignoreIfExists` is True -        Just (J.CreateFileOptions Nothing       (Just False)) -> True   -- `ignoreIfExists` is False -        Just (J.CreateFileOptions (Just True)   Nothing     ) -> True   -- `overwrite` is True-        Just (J.CreateFileOptions (Just True)   (Just True) ) -> True   -- `overwrite` wins over `ignoreIfExists`-        Just (J.CreateFileOptions (Just True)   (Just False)) -> True   -- `overwrite` is True-        Just (J.CreateFileOptions (Just False)  Nothing     ) -> False  -- `overwrite` is False-        Just (J.CreateFileOptions (Just False)  (Just True) ) -> False  -- `overwrite` is False-        Just (J.CreateFileOptions (Just False)  (Just False)) -> False  -- `overwrite` wins over `ignoreIfExists`--applyRenameFile :: J.RenameFile -> VFS -> VFS-applyRenameFile (J.RenameFile oldUri' newUri' options _ann) vfs = -  let oldUri = J.toNormalizedUri oldUri'-      newUri = J.toNormalizedUri newUri'-  in  case Map.lookup oldUri (vfsMap vfs) of -        -- nothing to rename -        Nothing -> vfs -        Just file -> case Map.lookup newUri (vfsMap vfs) of -          -- the target does not exist, just move over -          Nothing -> updateVFS (Map.insert newUri file . Map.delete oldUri) vfs-          Just _  -> if shouldOverwrite -                      then updateVFS (Map.insert newUri file . Map.delete oldUri) vfs-                      else vfs -  where -    shouldOverwrite :: Bool -    shouldOverwrite = case options of -        Nothing                                               -> False  -- default-        Just (J.RenameFileOptions Nothing       Nothing     ) -> False  -- default-        Just (J.RenameFileOptions Nothing       (Just True) ) -> False  -- `ignoreIfExists` is True -        Just (J.RenameFileOptions Nothing       (Just False)) -> True   -- `ignoreIfExists` is False -        Just (J.RenameFileOptions (Just True)   Nothing     ) -> True   -- `overwrite` is True-        Just (J.RenameFileOptions (Just True)   (Just True) ) -> True   -- `overwrite` wins over `ignoreIfExists`-        Just (J.RenameFileOptions (Just True)   (Just False)) -> True   -- `overwrite` is True-        Just (J.RenameFileOptions (Just False)  Nothing     ) -> False  -- `overwrite` is False-        Just (J.RenameFileOptions (Just False)  (Just True) ) -> False  -- `overwrite` is False-        Just (J.RenameFileOptions (Just False)  (Just False)) -> False  -- `overwrite` wins over `ignoreIfExists`---- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory-applyDeleteFile :: J.DeleteFile -> VFS -> VFS-applyDeleteFile (J.DeleteFile uri _options _ann) = -  updateVFS $ Map.delete (J.toNormalizedUri uri)---applyTextDocumentEdit :: J.TextDocumentEdit -> VFS -> IO VFS-applyTextDocumentEdit (J.TextDocumentEdit vid (J.List edits)) vfs = do-  -- all edits are supposed to be applied at once-  -- so apply from bottom up so they don't affect others-  let sortedEdits = sortOn (Down . editRange) edits-      changeEvents = map editToChangeEvent sortedEdits-      ps = J.DidChangeTextDocumentParams vid (J.List changeEvents)-      notif = J.NotificationMessage "" J.STextDocumentDidChange ps-  let (vfs',ls) = changeFromClientVFS vfs notif-  mapM_ (debugM "haskell-lsp.applyTextDocumentEdit") ls-  return vfs'--  where-    editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range-    editRange (J.InR e) = e ^. J.range-    editRange (J.InL e) = e ^. J.range--    editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent-    editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText)-    editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText)--applyDocumentChange :: J.DocumentChange -> VFS -> IO VFS -applyDocumentChange (J.InL               change)   = applyTextDocumentEdit change-applyDocumentChange (J.InR (J.InL        change))  = return . applyCreateFile change-applyDocumentChange (J.InR (J.InR (J.InL change))) = return . applyRenameFile change-applyDocumentChange (J.InR (J.InR (J.InR change))) = return . applyDeleteFile change---- ^ Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS'-changeFromServerVFS :: VFS -> J.Message 'J.WorkspaceApplyEdit -> IO VFS-changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do-  let J.ApplyWorkspaceEditParams _label edit = params-      J.WorkspaceEdit mChanges mDocChanges _anns = edit-  case mDocChanges of-    Just (J.List docChanges) -> applyDocumentChanges docChanges-    Nothing -> case mChanges of-      Just cs -> applyDocumentChanges $ map J.InL $ HashMap.foldlWithKey' changeToTextDocumentEdit [] cs-      Nothing -> do-        debugM "haskell-lsp.changeVfs" "No changes"-        return initVfs--  where-    changeToTextDocumentEdit acc uri edits =-      acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) (fmap J.InL edits)]--    applyDocumentChanges :: [J.DocumentChange] -> IO VFS -    applyDocumentChanges = foldM (flip applyDocumentChange) initVfs . sortOn project-        -    -- for sorting [DocumentChange]-    project :: J.DocumentChange -> J.TextDocumentVersion -- type TextDocumentVersion = Maybe Int-    project (J.InL textDocumentEdit) = textDocumentEdit ^. J.textDocument . J.version-    project _ = Nothing---- ----------------------------------------------------------------------virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath-virtualFileName prefix uri (VirtualFile _ file_ver _) =-  let uri_raw = J.fromNormalizedUri uri-      basename = maybe "" takeFileName (J.uriToFilePath uri_raw)-      -- Given a length and a version number, pad the version number to-      -- the given n. Does nothing if the version number string is longer-      -- than the given length.-      padLeft :: Int -> Int -> String-      padLeft n num =-        let numString = show num-        in replicate (n - length numString) '0' ++ numString-  in prefix </> basename ++ "-" ++ padLeft 5 file_ver ++ "-" ++ show (hash uri_raw) <.> takeExtensions basename---- | Write a virtual file to a temporary file if it exists in the VFS.-persistFileVFS :: VFS -> J.NormalizedUri -> Maybe (FilePath, IO ())-persistFileVFS vfs uri =-  case Map.lookup uri (vfsMap vfs) of-    Nothing -> Nothing-    Just vf ->-      let tfn = virtualFileName (vfsTempDir vfs) uri vf-          action = do-            exists <- doesFileExist tfn-            unless exists $ do-               let contents = Rope.toString (_text vf)-                   writeRaw h = do-                    -- We honour original file line endings-                    hSetNewlineMode h noNewlineTranslation-                    hSetEncoding h utf8-                    hPutStr h contents-               debugM "haskell-lsp.persistFileVFS" $ "Writing virtual file: " -                    ++ "uri = " ++ show uri ++ ", virtual file = " ++ show tfn-               withFile tfn WriteMode writeRaw-      in Just (tfn, action)---- -----------------------------------------------------------------------closeVFS :: VFS -> J.Message 'J.TextDocumentDidClose -> (VFS, [String])-closeVFS vfs (J.NotificationMessage _ _ params) =-  let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params-  in (updateVFS (Map.delete (J.toNormalizedUri uri)) vfs,["Closed: " ++ show uri])---- ------------------------------------------------------------------------- | Apply the list of changes.--- Changes should be applied in the order that they are--- received from the client.-applyChanges :: Rope -> [J.TextDocumentContentChangeEvent] -> Rope-applyChanges = foldl' applyChange---- -----------------------------------------------------------------------applyChange :: Rope -> J.TextDocumentContentChangeEvent -> Rope-applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str)-  = Rope.fromText str-applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) _to)) (Just len) txt)-  = changeChars str start (fromIntegral len) txt-  where-    start = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral sl) (fromIntegral sc)) str-applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt)-  = changeChars str start len txt-  where-    start = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral sl) (fromIntegral sc)) str-    end = Rope.rowColumnCodeUnits (Rope.RowColumn (fromIntegral el) (fromIntegral ec)) str-    len = end - start-applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt)-  = str---- -----------------------------------------------------------------------changeChars :: Rope -> Int -> Int -> Text -> Rope-changeChars str start len new = mconcat [before, Rope.fromText new, after']-  where-    (before, after) = Rope.splitAt start str-    after' = Rope.drop len after---- ------------------------------------------------------------------------- TODO:AZ:move this to somewhere sane--- | Describes the line at the current cursor position-data PosPrefixInfo = PosPrefixInfo-  { fullLine :: !T.Text-    -- ^ The full contents of the line the cursor is at--  , prefixModule :: !T.Text-    -- ^ If any, the module name that was typed right before the cursor position.-    --  For example, if the user has typed "Data.Maybe.from", then this property-    --  will be "Data.Maybe"--  , prefixText :: !T.Text-    -- ^ The word right before the cursor position, after removing the module part.-    -- For example if the user has typed "Data.Maybe.from",-    -- then this property will be "from"-  , cursorPos :: !J.Position-    -- ^ The cursor position-  } deriving (Show,Eq)--getCompletionPrefix :: (Monad m) => J.Position -> VirtualFile -> m (Maybe PosPrefixInfo)-getCompletionPrefix pos@(J.Position l c) (VirtualFile _ _ ropetext) =-      return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad-        let headMaybe [] = Nothing-            headMaybe (x:_) = Just x-            lastMaybe [] = Nothing-            lastMaybe xs = Just $ last xs--        curLine <- headMaybe $ T.lines $ Rope.toText-                             $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext-        let beforePos = T.take (fromIntegral c) curLine-        curWord <--            if | T.null beforePos -> Just ""-               | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc '-               | otherwise -> lastMaybe (T.words beforePos)--        let parts = T.split (=='.')-                      $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord-        case reverse parts of-          [] -> Nothing-          (x:xs) -> do-            let modParts = dropWhile (not . isUpper . T.head)-                                $ reverse $ filter (not .T.null) xs-                modName = T.intercalate "." modParts-            return $ PosPrefixInfo curLine modName x pos---- -----------------------------------------------------------------------rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text-rangeLinesFromVfs (VirtualFile _ _ ropetext) (J.Range (J.Position lf _cf) (J.Position lt _ct)) = r-  where-    (_ ,s1) = Rope.splitAtLine (fromIntegral lf) ropetext-    (s2, _) = Rope.splitAtLine (fromIntegral (lt - lf)) s1-    r = Rope.toText s2--- ---------------------------------------------------------------------