{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Language.LSP.Types.WatchedFiles where
  
import Data.Aeson
import Data.Aeson.TH
import Data.Bits
import Data.Scientific
import Language.LSP.Types.Common
import Language.LSP.Types.Uri
import Language.LSP.Types.Utils
import Data.Text (Text)

-- -------------------------------------

data DidChangeWatchedFilesClientCapabilities = DidChangeWatchedFilesClientCapabilities
  { -- | Did change watched files notification supports dynamic
    -- registration.
    DidChangeWatchedFilesClientCapabilities -> Maybe Bool
_dynamicRegistration :: Maybe Bool
  }
  deriving (Int -> DidChangeWatchedFilesClientCapabilities -> ShowS
[DidChangeWatchedFilesClientCapabilities] -> ShowS
DidChangeWatchedFilesClientCapabilities -> String
(Int -> DidChangeWatchedFilesClientCapabilities -> ShowS)
-> (DidChangeWatchedFilesClientCapabilities -> String)
-> ([DidChangeWatchedFilesClientCapabilities] -> ShowS)
-> Show DidChangeWatchedFilesClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWatchedFilesClientCapabilities] -> ShowS
$cshowList :: [DidChangeWatchedFilesClientCapabilities] -> ShowS
show :: DidChangeWatchedFilesClientCapabilities -> String
$cshow :: DidChangeWatchedFilesClientCapabilities -> String
showsPrec :: Int -> DidChangeWatchedFilesClientCapabilities -> ShowS
$cshowsPrec :: Int -> DidChangeWatchedFilesClientCapabilities -> ShowS
Show, ReadPrec [DidChangeWatchedFilesClientCapabilities]
ReadPrec DidChangeWatchedFilesClientCapabilities
Int -> ReadS DidChangeWatchedFilesClientCapabilities
ReadS [DidChangeWatchedFilesClientCapabilities]
(Int -> ReadS DidChangeWatchedFilesClientCapabilities)
-> ReadS [DidChangeWatchedFilesClientCapabilities]
-> ReadPrec DidChangeWatchedFilesClientCapabilities
-> ReadPrec [DidChangeWatchedFilesClientCapabilities]
-> Read DidChangeWatchedFilesClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWatchedFilesClientCapabilities]
$creadListPrec :: ReadPrec [DidChangeWatchedFilesClientCapabilities]
readPrec :: ReadPrec DidChangeWatchedFilesClientCapabilities
$creadPrec :: ReadPrec DidChangeWatchedFilesClientCapabilities
readList :: ReadS [DidChangeWatchedFilesClientCapabilities]
$creadList :: ReadS [DidChangeWatchedFilesClientCapabilities]
readsPrec :: Int -> ReadS DidChangeWatchedFilesClientCapabilities
$creadsPrec :: Int -> ReadS DidChangeWatchedFilesClientCapabilities
Read, DidChangeWatchedFilesClientCapabilities
-> DidChangeWatchedFilesClientCapabilities -> Bool
(DidChangeWatchedFilesClientCapabilities
 -> DidChangeWatchedFilesClientCapabilities -> Bool)
-> (DidChangeWatchedFilesClientCapabilities
    -> DidChangeWatchedFilesClientCapabilities -> Bool)
-> Eq DidChangeWatchedFilesClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWatchedFilesClientCapabilities
-> DidChangeWatchedFilesClientCapabilities -> Bool
$c/= :: DidChangeWatchedFilesClientCapabilities
-> DidChangeWatchedFilesClientCapabilities -> Bool
== :: DidChangeWatchedFilesClientCapabilities
-> DidChangeWatchedFilesClientCapabilities -> Bool
$c== :: DidChangeWatchedFilesClientCapabilities
-> DidChangeWatchedFilesClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''DidChangeWatchedFilesClientCapabilities

-- | Describe options to be used when registering for file system change events.
data DidChangeWatchedFilesRegistrationOptions =
  DidChangeWatchedFilesRegistrationOptions
  { -- | The watchers to register.
    DidChangeWatchedFilesRegistrationOptions -> List FileSystemWatcher
_watchers :: List FileSystemWatcher
  } deriving (Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
[DidChangeWatchedFilesRegistrationOptions] -> ShowS
DidChangeWatchedFilesRegistrationOptions -> String
(Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS)
-> (DidChangeWatchedFilesRegistrationOptions -> String)
-> ([DidChangeWatchedFilesRegistrationOptions] -> ShowS)
-> Show DidChangeWatchedFilesRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWatchedFilesRegistrationOptions] -> ShowS
$cshowList :: [DidChangeWatchedFilesRegistrationOptions] -> ShowS
show :: DidChangeWatchedFilesRegistrationOptions -> String
$cshow :: DidChangeWatchedFilesRegistrationOptions -> String
showsPrec :: Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
$cshowsPrec :: Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
Show, ReadPrec [DidChangeWatchedFilesRegistrationOptions]
ReadPrec DidChangeWatchedFilesRegistrationOptions
Int -> ReadS DidChangeWatchedFilesRegistrationOptions
ReadS [DidChangeWatchedFilesRegistrationOptions]
(Int -> ReadS DidChangeWatchedFilesRegistrationOptions)
-> ReadS [DidChangeWatchedFilesRegistrationOptions]
-> ReadPrec DidChangeWatchedFilesRegistrationOptions
-> ReadPrec [DidChangeWatchedFilesRegistrationOptions]
-> Read DidChangeWatchedFilesRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWatchedFilesRegistrationOptions]
$creadListPrec :: ReadPrec [DidChangeWatchedFilesRegistrationOptions]
readPrec :: ReadPrec DidChangeWatchedFilesRegistrationOptions
$creadPrec :: ReadPrec DidChangeWatchedFilesRegistrationOptions
readList :: ReadS [DidChangeWatchedFilesRegistrationOptions]
$creadList :: ReadS [DidChangeWatchedFilesRegistrationOptions]
readsPrec :: Int -> ReadS DidChangeWatchedFilesRegistrationOptions
$creadsPrec :: Int -> ReadS DidChangeWatchedFilesRegistrationOptions
Read, DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
(DidChangeWatchedFilesRegistrationOptions
 -> DidChangeWatchedFilesRegistrationOptions -> Bool)
-> (DidChangeWatchedFilesRegistrationOptions
    -> DidChangeWatchedFilesRegistrationOptions -> Bool)
-> Eq DidChangeWatchedFilesRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
$c/= :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
== :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
$c== :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
Eq)

data FileSystemWatcher =
  FileSystemWatcher
  { -- | The glob pattern to watch.
    -- Glob patterns can have the following syntax:
    -- - @*@ to match one or more characters in a path segment
    -- - @?@ to match on one character in a path segment
    -- - @**@ to match any number of path segments, including none
    -- - @{}@ to group conditions (e.g. @**​/*.{ts,js}@ matches all TypeScript and JavaScript files)
    -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …)
    -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@)
    FileSystemWatcher -> Text
_globPattern :: Text,
    -- | The kind of events of interest. If omitted it defaults
    -- to WatchKind.Create | WatchKind.Change | WatchKind.Delete
    -- which is 7.
    FileSystemWatcher -> Maybe WatchKind
_kind :: Maybe WatchKind
  } deriving (Int -> FileSystemWatcher -> ShowS
[FileSystemWatcher] -> ShowS
FileSystemWatcher -> String
(Int -> FileSystemWatcher -> ShowS)
-> (FileSystemWatcher -> String)
-> ([FileSystemWatcher] -> ShowS)
-> Show FileSystemWatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSystemWatcher] -> ShowS
$cshowList :: [FileSystemWatcher] -> ShowS
show :: FileSystemWatcher -> String
$cshow :: FileSystemWatcher -> String
showsPrec :: Int -> FileSystemWatcher -> ShowS
$cshowsPrec :: Int -> FileSystemWatcher -> ShowS
Show, ReadPrec [FileSystemWatcher]
ReadPrec FileSystemWatcher
Int -> ReadS FileSystemWatcher
ReadS [FileSystemWatcher]
(Int -> ReadS FileSystemWatcher)
-> ReadS [FileSystemWatcher]
-> ReadPrec FileSystemWatcher
-> ReadPrec [FileSystemWatcher]
-> Read FileSystemWatcher
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileSystemWatcher]
$creadListPrec :: ReadPrec [FileSystemWatcher]
readPrec :: ReadPrec FileSystemWatcher
$creadPrec :: ReadPrec FileSystemWatcher
readList :: ReadS [FileSystemWatcher]
$creadList :: ReadS [FileSystemWatcher]
readsPrec :: Int -> ReadS FileSystemWatcher
$creadsPrec :: Int -> ReadS FileSystemWatcher
Read, FileSystemWatcher -> FileSystemWatcher -> Bool
(FileSystemWatcher -> FileSystemWatcher -> Bool)
-> (FileSystemWatcher -> FileSystemWatcher -> Bool)
-> Eq FileSystemWatcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSystemWatcher -> FileSystemWatcher -> Bool
$c/= :: FileSystemWatcher -> FileSystemWatcher -> Bool
== :: FileSystemWatcher -> FileSystemWatcher -> Bool
$c== :: FileSystemWatcher -> FileSystemWatcher -> Bool
Eq)

data WatchKind =
  WatchKind {
    -- | Watch for create events
    WatchKind -> Bool
_watchCreate :: Bool,
    -- | Watch for change events
    WatchKind -> Bool
_watchChange :: Bool,
    -- | Watch for delete events
    WatchKind -> Bool
_watchDelete :: Bool
  } deriving (Int -> WatchKind -> ShowS
[WatchKind] -> ShowS
WatchKind -> String
(Int -> WatchKind -> ShowS)
-> (WatchKind -> String)
-> ([WatchKind] -> ShowS)
-> Show WatchKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchKind] -> ShowS
$cshowList :: [WatchKind] -> ShowS
show :: WatchKind -> String
$cshow :: WatchKind -> String
showsPrec :: Int -> WatchKind -> ShowS
$cshowsPrec :: Int -> WatchKind -> ShowS
Show, ReadPrec [WatchKind]
ReadPrec WatchKind
Int -> ReadS WatchKind
ReadS [WatchKind]
(Int -> ReadS WatchKind)
-> ReadS [WatchKind]
-> ReadPrec WatchKind
-> ReadPrec [WatchKind]
-> Read WatchKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WatchKind]
$creadListPrec :: ReadPrec [WatchKind]
readPrec :: ReadPrec WatchKind
$creadPrec :: ReadPrec WatchKind
readList :: ReadS [WatchKind]
$creadList :: ReadS [WatchKind]
readsPrec :: Int -> ReadS WatchKind
$creadsPrec :: Int -> ReadS WatchKind
Read, WatchKind -> WatchKind -> Bool
(WatchKind -> WatchKind -> Bool)
-> (WatchKind -> WatchKind -> Bool) -> Eq WatchKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchKind -> WatchKind -> Bool
$c/= :: WatchKind -> WatchKind -> Bool
== :: WatchKind -> WatchKind -> Bool
$c== :: WatchKind -> WatchKind -> Bool
Eq)

instance ToJSON WatchKind where
  toJSON :: WatchKind -> Value
toJSON WatchKind
wk = Scientific -> Value
Number (Scientific
createNum Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
changeNum Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
deleteNum)
    where
      createNum :: Scientific
createNum = if WatchKind -> Bool
_watchCreate WatchKind
wk then Scientific
0x1 else Scientific
0x0
      changeNum :: Scientific
changeNum = if WatchKind -> Bool
_watchChange WatchKind
wk then Scientific
0x2 else Scientific
0x0
      deleteNum :: Scientific
deleteNum = if WatchKind -> Bool
_watchDelete WatchKind
wk then Scientific
0x4 else Scientific
0x0

instance FromJSON WatchKind where
  parseJSON :: Value -> Parser WatchKind
parseJSON (Number Scientific
n)
    | Right Int
i <- Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Int
    , Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 =
        WatchKind -> Parser WatchKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WatchKind -> Parser WatchKind) -> WatchKind -> Parser WatchKind
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> WatchKind
WatchKind (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x0) (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x1) (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x2)
    | Bool
otherwise = Parser WatchKind
forall a. Monoid a => a
mempty
  parseJSON Value
_            = Parser WatchKind
forall a. Monoid a => a
mempty

deriveJSON lspOptions ''DidChangeWatchedFilesRegistrationOptions
deriveJSON lspOptions ''FileSystemWatcher

-- | The file event type.
data FileChangeType = FcCreated -- ^ The file got created.
                    | FcChanged -- ^ The file got changed.
                    | FcDeleted -- ^ The file got deleted.
       deriving (ReadPrec [FileChangeType]
ReadPrec FileChangeType
Int -> ReadS FileChangeType
ReadS [FileChangeType]
(Int -> ReadS FileChangeType)
-> ReadS [FileChangeType]
-> ReadPrec FileChangeType
-> ReadPrec [FileChangeType]
-> Read FileChangeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileChangeType]
$creadListPrec :: ReadPrec [FileChangeType]
readPrec :: ReadPrec FileChangeType
$creadPrec :: ReadPrec FileChangeType
readList :: ReadS [FileChangeType]
$creadList :: ReadS [FileChangeType]
readsPrec :: Int -> ReadS FileChangeType
$creadsPrec :: Int -> ReadS FileChangeType
Read,Int -> FileChangeType -> ShowS
[FileChangeType] -> ShowS
FileChangeType -> String
(Int -> FileChangeType -> ShowS)
-> (FileChangeType -> String)
-> ([FileChangeType] -> ShowS)
-> Show FileChangeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileChangeType] -> ShowS
$cshowList :: [FileChangeType] -> ShowS
show :: FileChangeType -> String
$cshow :: FileChangeType -> String
showsPrec :: Int -> FileChangeType -> ShowS
$cshowsPrec :: Int -> FileChangeType -> ShowS
Show,FileChangeType -> FileChangeType -> Bool
(FileChangeType -> FileChangeType -> Bool)
-> (FileChangeType -> FileChangeType -> Bool) -> Eq FileChangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileChangeType -> FileChangeType -> Bool
$c/= :: FileChangeType -> FileChangeType -> Bool
== :: FileChangeType -> FileChangeType -> Bool
$c== :: FileChangeType -> FileChangeType -> Bool
Eq)

instance ToJSON FileChangeType where
  toJSON :: FileChangeType -> Value
toJSON FileChangeType
FcCreated = Scientific -> Value
Number Scientific
1
  toJSON FileChangeType
FcChanged = Scientific -> Value
Number Scientific
2
  toJSON FileChangeType
FcDeleted = Scientific -> Value
Number Scientific
3

instance FromJSON FileChangeType where
  parseJSON :: Value -> Parser FileChangeType
parseJSON (Number Scientific
1) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcCreated
  parseJSON (Number Scientific
2) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcChanged
  parseJSON (Number Scientific
3) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcDeleted
  parseJSON Value
_            = Parser FileChangeType
forall a. Monoid a => a
mempty


-- -------------------------------------

-- | An event describing a file change.
data FileEvent =
  FileEvent
  { -- | The file's URI.
    FileEvent -> Uri
_uri   :: Uri
    -- | The change type.
  , FileEvent -> FileChangeType
_xtype :: FileChangeType
  } deriving (ReadPrec [FileEvent]
ReadPrec FileEvent
Int -> ReadS FileEvent
ReadS [FileEvent]
(Int -> ReadS FileEvent)
-> ReadS [FileEvent]
-> ReadPrec FileEvent
-> ReadPrec [FileEvent]
-> Read FileEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileEvent]
$creadListPrec :: ReadPrec [FileEvent]
readPrec :: ReadPrec FileEvent
$creadPrec :: ReadPrec FileEvent
readList :: ReadS [FileEvent]
$creadList :: ReadS [FileEvent]
readsPrec :: Int -> ReadS FileEvent
$creadsPrec :: Int -> ReadS FileEvent
Read,Int -> FileEvent -> ShowS
[FileEvent] -> ShowS
FileEvent -> String
(Int -> FileEvent -> ShowS)
-> (FileEvent -> String)
-> ([FileEvent] -> ShowS)
-> Show FileEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileEvent] -> ShowS
$cshowList :: [FileEvent] -> ShowS
show :: FileEvent -> String
$cshow :: FileEvent -> String
showsPrec :: Int -> FileEvent -> ShowS
$cshowsPrec :: Int -> FileEvent -> ShowS
Show,FileEvent -> FileEvent -> Bool
(FileEvent -> FileEvent -> Bool)
-> (FileEvent -> FileEvent -> Bool) -> Eq FileEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileEvent -> FileEvent -> Bool
$c/= :: FileEvent -> FileEvent -> Bool
== :: FileEvent -> FileEvent -> Bool
$c== :: FileEvent -> FileEvent -> Bool
Eq)

deriveJSON lspOptions ''FileEvent

data DidChangeWatchedFilesParams =
  DidChangeWatchedFilesParams
  { -- | The actual file events.
    DidChangeWatchedFilesParams -> List FileEvent
_changes :: List FileEvent
  } deriving (ReadPrec [DidChangeWatchedFilesParams]
ReadPrec DidChangeWatchedFilesParams
Int -> ReadS DidChangeWatchedFilesParams
ReadS [DidChangeWatchedFilesParams]
(Int -> ReadS DidChangeWatchedFilesParams)
-> ReadS [DidChangeWatchedFilesParams]
-> ReadPrec DidChangeWatchedFilesParams
-> ReadPrec [DidChangeWatchedFilesParams]
-> Read DidChangeWatchedFilesParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWatchedFilesParams]
$creadListPrec :: ReadPrec [DidChangeWatchedFilesParams]
readPrec :: ReadPrec DidChangeWatchedFilesParams
$creadPrec :: ReadPrec DidChangeWatchedFilesParams
readList :: ReadS [DidChangeWatchedFilesParams]
$creadList :: ReadS [DidChangeWatchedFilesParams]
readsPrec :: Int -> ReadS DidChangeWatchedFilesParams
$creadsPrec :: Int -> ReadS DidChangeWatchedFilesParams
Read,Int -> DidChangeWatchedFilesParams -> ShowS
[DidChangeWatchedFilesParams] -> ShowS
DidChangeWatchedFilesParams -> String
(Int -> DidChangeWatchedFilesParams -> ShowS)
-> (DidChangeWatchedFilesParams -> String)
-> ([DidChangeWatchedFilesParams] -> ShowS)
-> Show DidChangeWatchedFilesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWatchedFilesParams] -> ShowS
$cshowList :: [DidChangeWatchedFilesParams] -> ShowS
show :: DidChangeWatchedFilesParams -> String
$cshow :: DidChangeWatchedFilesParams -> String
showsPrec :: Int -> DidChangeWatchedFilesParams -> ShowS
$cshowsPrec :: Int -> DidChangeWatchedFilesParams -> ShowS
Show,DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
(DidChangeWatchedFilesParams
 -> DidChangeWatchedFilesParams -> Bool)
-> (DidChangeWatchedFilesParams
    -> DidChangeWatchedFilesParams -> Bool)
-> Eq DidChangeWatchedFilesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
$c/= :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
== :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
$c== :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
Eq)

deriveJSON lspOptions ''DidChangeWatchedFilesParams