{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
module Language.LSP.Types.Cancellation where
import Data.Aeson.TH
import Language.LSP.Types.LspId
import Language.LSP.Types.Utils
data CancelParams = forall m.
CancelParams
{
()
_id :: LspId m
}
deriving instance Read CancelParams
deriving instance Show CancelParams
instance Eq CancelParams where
(CancelParams LspId m
a) == :: CancelParams -> CancelParams -> Bool
== CancelParams LspId m
b =
case (LspId m
a,LspId m
b) of
(IdInt Int32
x, IdInt Int32
y) -> Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
y
(IdString Text
x, IdString Text
y) -> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
(LspId m, LspId m)
_ -> Bool
False
deriveJSON lspOptions ''CancelParams