Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use Empty instead of () as progress create response #295

Merged
merged 3 commits into from
Mar 2, 2021
Merged

Use Empty instead of () as progress create response #295

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
0fcc944
Use Empty instead of () as progress create response
wz1000 Mar 2, 2021
261c49b
Add null field to notifications before parsing also
wz1000 Mar 2, 2021
d8f1ab4
fix compile
wz1000 Mar 2, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions lsp-test/src/Language/LSP/Test/Session.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ where
import Control.Applicative
import Control.Concurrent hiding (yield)
import Control.Exception
import Control.Lens hiding (List)
import Control.Lens hiding (List, Empty)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Except
Expand Down Expand Up @@ -304,7 +304,7 @@ updateStateC = awaitForever $ \msg -> do
where
respond :: (MonadIO m, HasReader SessionContext m) => FromServerMessage -> m ()
respond (FromServerMess SWindowWorkDoneProgressCreate req) =
sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right ())
sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Empty)
respond (FromServerMess SWorkspaceApplyEdit r) = do
sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing)
respond _ = pure ()
Expand Down
4 changes: 2 additions & 2 deletions lsp-types/src/Language/LSP/Types/Message.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -197,7 +197,7 @@ type family ResponseResult (m :: Method f Request) :: Type where
-- Server
-- Window
ResponseResult WindowShowMessageRequest = Maybe MessageActionItem
ResponseResult WindowWorkDoneProgressCreate = ()
ResponseResult WindowWorkDoneProgressCreate = Empty
-- Capability
ResponseResult ClientRegisterCapability = Empty
ResponseResult ClientUnregisterCapability = Empty
Expand Down Expand Up @@ -233,7 +233,7 @@ deriving instance Eq (MessageParams m) => Eq (NotificationMessage m)
deriving instance Show (MessageParams m) => Show (NotificationMessage m)

instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (NotificationMessage m) where
parseJSON = genericParseJSON lspOptions
parseJSON = genericParseJSON lspOptions . addNullField "params"
instance (ToJSON (MessageParams m)) => ToJSON (NotificationMessage m) where
toJSON = genericToJSON lspOptions
toEncoding = genericToEncoding lspOptions
Expand Down
2 changes: 1 addition & 1 deletion src/Language/LSP/Server/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -620,7 +620,7 @@ withProgressBase indefinite title cancellable f = do
-- An error ocurred when the client was setting it up
-- No need to do anything then, as per the spec
Left _err -> pure ()
Right () -> pure ()
Right Empty -> pure ()

-- Send the begin and done notifications via 'bracket_' so that they are always fired
res <- withRunInIO $ \runInBase ->
Expand Down