projects
/
lsp-test.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
8b2c929
)
update and fill in `message`
author
Zubin Duggal
<zubin@cmi.ac.in>
Mon, 24 Aug 2020 16:27:47 +0000
(21:57 +0530)
committer
Luke Lau
<luke_lau@icloud.com>
Fri, 9 Oct 2020 12:56:16 +0000
(13:56 +0100)
lsp-test.cabal
patch
|
blob
|
history
src/Language/Haskell/LSP/Test.hs
patch
|
blob
|
history
src/Language/Haskell/LSP/Test/Decoding.hs
patch
|
blob
|
history
src/Language/Haskell/LSP/Test/Files.hs
patch
|
blob
|
history
src/Language/Haskell/LSP/Test/Parsing.hs
patch
|
blob
|
history
src/Language/Haskell/LSP/Test/Session.hs
patch
|
blob
|
history
diff --git
a/lsp-test.cabal
b/lsp-test.cabal
index 68b560bd1d65e770421f928d513e0014d55202ad..0bf9dc9c797e9f50cb2a967ccb044ee7d90efd9c 100644
(file)
--- a/
lsp-test.cabal
+++ b/
lsp-test.cabal
@@
-64,6
+64,7
@@
library
, text
, transformers
, unordered-containers
, text
, transformers
, unordered-containers
+ , some
if os(windows)
build-depends: Win32
else
if os(windows)
build-depends: Win32
else
diff --git
a/src/Language/Haskell/LSP/Test.hs
b/src/Language/Haskell/LSP/Test.hs
index 845ff2593464b482f3b1d447ef113a2983d5d2d2..c14eb44fd140a5f94b5307e72b03fa90dc6b77a2 100644
(file)
--- a/
src/Language/Haskell/LSP/Test.hs
+++ b/
src/Language/Haskell/LSP/Test.hs
@@
-1,4
+1,5
@@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
@@
-96,7
+97,7
@@
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
-import Control.Lens hiding ((.=), List)
+import Control.Lens hiding ((.=), List
, Empty
)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
@@
-191,7
+192,7
@@
runSessionWithConfig config' serverExe caps rootDir session = do
where
-- | Asks the server to shutdown and exit politely
exitServer :: Session ()
where
-- | Asks the server to shutdown and exit politely
exitServer :: Session ()
- exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit (Just E
xitParams
)
+ exitServer = request_ SShutdown (Nothing :: Maybe Value) >> sendNotification SExit (Just E
mpty
)
-- | Listens to the server output until the shutdown ack,
-- makes sure it matches the record and signals any semaphores
-- | Listens to the server output until the shutdown ack,
-- makes sure it matches the record and signals any semaphores
@@
-370,7
+371,7
@@
createDoc file languageId contents = do
createHits (WatchKind create _ _) = create
createHits (WatchKind create _ _) = create
- regHits :: Registration -> Bool
+ regHits ::
Some
Registration -> Bool
regHits reg = isJust $ do
opts <- reg ^. registerOptions
fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
regHits reg = isJust $ do
opts <- reg ^. registerOptions
fileWatchOpts <- case fromJSON opts :: Result DidChangeWatchedFilesRegistrationOptions of
@@
-463,12
+464,12
@@
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol]
getDocumentSymbols doc = do
ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
case res of
getDocumentSymbols doc = do
ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse
case res of
- Right (
DSDocumentSymbols
(List xs)) -> return (Left xs)
- Right (
DSSymbolInformation
(List xs)) -> return (Right xs)
+ Right (
L
(List xs)) -> return (Left xs)
+ Right (
R
(List xs)) -> return (Right xs)
Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
-- | Returns the code actions in the specified range.
Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err)
-- | Returns the code actions in the specified range.
-getCodeActions :: TextDocumentIdentifier -> Range -> Session [C
AResult
]
+getCodeActions :: TextDocumentIdentifier -> Range -> Session [C
ommand |? CodeAction
]
getCodeActions doc range = do
ctx <- getCodeActionContext doc
rsp <- request STextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
getCodeActions doc range = do
ctx <- getCodeActionContext doc
rsp <- request STextDocumentCodeAction (CodeActionParams doc range ctx Nothing)
@@
-480,14
+481,14
@@
getCodeActions doc range = do
-- | Returns all the code actions in a document by
-- querying the code actions at each of the current
-- diagnostics' positions.
-- | Returns all the code actions in a document by
-- querying the code actions at each of the current
-- diagnostics' positions.
-getAllCodeActions :: TextDocumentIdentifier -> Session [C
AResult
]
+getAllCodeActions :: TextDocumentIdentifier -> Session [C
ommand |? CodeAction
]
getAllCodeActions doc = do
ctx <- getCodeActionContext doc
foldM (go ctx) [] =<< getCurrentDiagnostics doc
where
getAllCodeActions doc = do
ctx <- getCodeActionContext doc
foldM (go ctx) [] =<< getCurrentDiagnostics doc
where
- go :: CodeActionContext -> [C
AResult] -> Diagnostic -> Session [CAResult
]
+ go :: CodeActionContext -> [C
ommand |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction
]
go ctx acc diag = do
ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
go ctx acc diag = do
ResponseMessage _ rspLid res <- request STextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing)
@@
-546,7
+547,7
@@
applyEdit doc edit = do
caps <- asks sessionCapabilities
let supportsDocChanges = fromMaybe False $ do
caps <- asks sessionCapabilities
let supportsDocChanges = fromMaybe False $ do
- let mWorkspace =
C._workspace caps
+ let mWorkspace =
caps ^. LSP.workspace
C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
mDocChanges
C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
mDocChanges
@@
-571,8
+572,8
@@
getCompletions doc pos = do
rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing)
case getResponseResult rsp of
rsp <- request STextDocumentCompletion (CompletionParams doc pos Nothing Nothing)
case getResponseResult rsp of
-
Completions
(List items) -> return items
-
CompletionList (CompletionListType
_ (List items)) -> return items
+
L
(List items) -> return items
+
R (CompletionList
_ (List items)) -> return items
-- | Returns the references for the position in the document.
getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
-- | Returns the references for the position in the document.
getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
@@
-592,19
+593,19
@@
getDefinitions doc pos = do
let params = TextDocumentPositionParams doc pos Nothing
rsp <- request STextDocumentDefinition params :: Session DefinitionResponse
case getResponseResult rsp of
let params = TextDocumentPositionParams doc pos Nothing
rsp <- request STextDocumentDefinition params :: Session DefinitionResponse
case getResponseResult rsp of
-
SingleLoc
loc -> pure [loc]
-
MultiLoc
locs -> pure locs
+
L
loc -> pure [loc]
+
R
locs -> pure locs
-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
-> Position -- ^ The position the term is at.
-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
-> Position -- ^ The position the term is at.
-
-> Session [Location]
-- ^ The location(s) of the definitions
-getTypeDefinitions doc pos =
do
+
-> Session (Location |? List Location |? List LocationLink)
-- ^ The location(s) of the definitions
+getTypeDefinitions doc pos =
let params = TextDocumentPositionParams doc pos Nothing
rsp <- request STextDocumentTypeDefinition params :: Session TypeDefinitionResponse
case getResponseResult rsp of
let params = TextDocumentPositionParams doc pos Nothing
rsp <- request STextDocumentTypeDefinition params :: Session TypeDefinitionResponse
case getResponseResult rsp of
-
SingleLoc
loc -> pure [loc]
-
MultiLoc
locs -> pure locs
+
L
loc -> pure [loc]
+
R
locs -> pure locs
-- | Renames the term at the specified position.
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
-- | Renames the term at the specified position.
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
@@
-667,5
+668,5
@@
getCodeLenses tId = do
-- register during the 'Session'.
--
-- @since 0.11.0.0
-- register during the 'Session'.
--
-- @since 0.11.0.0
-getRegisteredCapabilities :: Session [Registration]
+getRegisteredCapabilities :: Session [
Some
Registration]
getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get
getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get
diff --git
a/src/Language/Haskell/LSP/Test/Decoding.hs
b/src/Language/Haskell/LSP/Test/Decoding.hs
index 9051821735385b19cd83ed098bb16e8c5b5e1b50..d99163e6f54e882afe10b56958cbf39495776c6f 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/
src/Language/Haskell/LSP/Test/Decoding.hs
@@
-10,6
+10,8
@@
import Prelude hiding ( id )
import Data.Aeson
import Data.Aeson.Types
import Data.Foldable
import Data.Aeson
import Data.Aeson.Types
import Data.Foldable
+import Data.Functor.Product
+import Data.Functor.Const
import Control.Exception
import Control.Lens
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Exception
import Control.Lens
import qualified Data.ByteString.Lazy.Char8 as B
@@
-78,12
+80,21
@@
getRequestMap = foldl' helper emptyIxMap
FromClientMess m mess -> case splitClientMethod m of
IsClientNot -> acc
IsClientReq -> fromJust $ updateRequestMap acc (mess ^. id) m
FromClientMess m mess -> case splitClientMethod m of
IsClientNot -> acc
IsClientReq -> fromJust $ updateRequestMap acc (mess ^. id) m
+ IsClientEither -> case mess of
+ NotMess _ -> acc
+ ReqMess msg -> fromJust $ updateRequestMap acc (msg ^. id) m
_ -> acc
_ -> acc
-decodeFromServerMsg :: RequestMap -> B.ByteString ->
FromServerMessage
-decodeFromServerMsg reqMap bytes =
fst
$ fromJust $ parseMaybe p obj
+decodeFromServerMsg :: RequestMap -> B.ByteString ->
(FromServerMessage, RequestMap)
+decodeFromServerMsg reqMap bytes =
unP
$ fromJust $ parseMaybe p obj
where obj = fromJust $ decode bytes :: Value
where obj = fromJust $ decode bytes :: Value
- p = parseServerMessage (\i -> (,()) <$> lookupIxMap i reqMap)
+ p = parseServerMessage $ \lid ->
+ let (mm, newMap) = pickFromIxMap lid reqMap
+ in case mm of
+ Nothing -> Nothing
+ Just m -> Just $ (m, Pair m (Const newMap))
+ unP (FromServerMess m msg) = (FromServerMess m msg, reqMap)
+ unP (FromServerRsp (Pair m (Const newMap)) msg) = (FromServerRsp m msg, newMap)
{-
WorkspaceWorkspaceFolders -> error "ReqWorkspaceFolders not supported yet"
WorkspaceConfiguration -> error "ReqWorkspaceConfiguration not supported yet"
{-
WorkspaceWorkspaceFolders -> error "ReqWorkspaceFolders not supported yet"
WorkspaceConfiguration -> error "ReqWorkspaceConfiguration not supported yet"
diff --git
a/src/Language/Haskell/LSP/Test/Files.hs
b/src/Language/Haskell/LSP/Test/Files.hs
index a9e6af624544c9c7cdac377c788a81cb8dcdc5c3..9a54da1f88f0152e5d06ad887635f92e8514ed88 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Files.hs
+++ b/
src/Language/Haskell/LSP/Test/Files.hs
@@
-1,4
+1,6
@@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
@@
-64,8
+66,9
@@
mapUris f event =
fromServerMsg (FromServerMess m@SWorkspaceApplyEdit r) = FromServerMess m $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r
fromServerMsg (FromServerMess m@STextDocumentPublishDiagnostics n) = FromServerMess m $ swapUri params n
fromServerMsg (FromServerRsp m@STextDocumentDocumentSymbol r) =
fromServerMsg (FromServerMess m@SWorkspaceApplyEdit r) = FromServerMess m $ params . edit .~ swapWorkspaceEdit (r ^. params . edit) $ r
fromServerMsg (FromServerMess m@STextDocumentPublishDiagnostics n) = FromServerMess m $ swapUri params n
fromServerMsg (FromServerRsp m@STextDocumentDocumentSymbol r) =
- let swapUri' (DSSymbolInformation si) = DSSymbolInformation (swapUri location <$> si)
- swapUri' (DSDocumentSymbols dss) = DSDocumentSymbols dss -- no file locations here
+ let swapUri' :: (List DocumentSymbol |? List SymbolInformation) -> List DocumentSymbol |? List SymbolInformation
+ swapUri' (R si) = R (swapUri location <$> si)
+ swapUri' (L dss) = L dss -- no file locations here
in FromServerRsp m $ r & result %~ (fmap swapUri')
fromServerMsg (FromServerRsp m@STextDocumentRename r) = FromServerRsp m $ r & result %~ (fmap swapWorkspaceEdit)
fromServerMsg x = x
in FromServerRsp m $ r & result %~ (fmap swapUri')
fromServerMsg (FromServerRsp m@STextDocumentRename r) = FromServerRsp m $ r & result %~ (fmap swapWorkspaceEdit)
fromServerMsg x = x
diff --git
a/src/Language/Haskell/LSP/Test/Parsing.hs
b/src/Language/Haskell/LSP/Test/Parsing.hs
index 6c3c64afe8f9ff85a8fa0b6a3e2e0b9b501f4df1..20a40d31386a284cf65d263981d0799f49b35ac0 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/
src/Language/Haskell/LSP/Test/Parsing.hs
@@
-1,4
+1,5
@@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
@@
-36,6
+37,8
@@
import Data.Typeable
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types.Lens as LSP
import Language.Haskell.LSP.Test.Session
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types.Lens as LSP
import Language.Haskell.LSP.Test.Session
+import Data.GADT.Compare
+import Data.Type.Equality
-- $receiving
-- To receive a message, just specify the type that expect:
-- $receiving
-- To receive a message, just specify the type that expect:
@@
-101,8
+104,22
@@
satisfyMaybe pred = do
named :: T.Text -> Session a -> Session a
named s (Session x) = Session (Data.Conduit.Parser.named s x)
named :: T.Text -> Session a -> Session a
named s (Session x) = Session (Data.Conduit.Parser.named s x)
+mEq :: SServerMethod m1 -> SServerMethod m2 -> Maybe (m1 :~~: m2)
+mEq m1 m2 = case (splitServerMethod m1, splitServerMethod m2) of
+ (IsServerNot, IsServerNot) -> do
+ Refl <- geq m1 m2
+ pure HRefl
+ (IsServerReq, IsServerReq) -> do
+ Refl <- geq m1 m2
+ pure HRefl
+ _ -> Nothing
+
message :: SServerMethod m -> Session (ServerMessage m)
message :: SServerMethod m -> Session (ServerMessage m)
-message = undefined -- TODO
+message m1 = named (T.pack $ show m1) $ satisfyMaybe $ \case
+ FromServerMess m2 msg -> do
+ HRefl <- mEq m1 m2
+ pure msg
+ _ -> Nothing
-- | Matches if the message is a notification.
anyNotification :: Session FromServerMessage
-- | Matches if the message is a notification.
anyNotification :: Session FromServerMessage
diff --git
a/src/Language/Haskell/LSP/Test/Session.hs
b/src/Language/Haskell/LSP/Test/Session.hs
index d43d11a1f79b5c2df46285f54e42ea22bc2bf399..3e9e688bc221f563b8220b63e925cb71176a8668 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Session.hs
+++ b/
src/Language/Haskell/LSP/Test/Session.hs
@@
-167,7
+167,7
@@
data SessionState = SessionState
-- ^ The last received message from the server.
-- Used for providing exception information
, lastReceivedMessage :: Maybe FromServerMessage
-- ^ The last received message from the server.
-- Used for providing exception information
, lastReceivedMessage :: Maybe FromServerMessage
- , curDynCaps :: Map.Map T.Text Registration
+ , curDynCaps :: Map.Map T.Text
Some
Registration
-- ^ The capabilities that the server has dynamically registered with us so
-- far
}
-- ^ The capabilities that the server has dynamically registered with us so
-- far
}
@@
-295,7
+295,7
@@
updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
-- Keep track of dynamic capability registration
updateState (FromServerMess SClientRegisterCapability req) = do
-- Keep track of dynamic capability registration
updateState (FromServerMess SClientRegisterCapability req) = do
- let List newRegs = (\
r -> (r ^. LSP.id,
r)) <$> req ^. params . registrations
+ let List newRegs = (\
sr@(SomeRegistration r) -> (r ^. LSP.id, s
r)) <$> req ^. params . registrations
modify $ \s ->
s { curDynCaps = Map.union (Map.fromList newRegs) (curDynCaps s) }
modify $ \s ->
s { curDynCaps = Map.union (Map.fromList newRegs) (curDynCaps s) }