{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.LSP.Types.WorkspaceEdit where

import           Control.Monad                              (unless)
import           Data.Aeson
import           Data.Aeson.TH
import qualified Data.HashMap.Strict                        as H
import           Data.Maybe                                 (catMaybes)
import           Data.Text                                  (Text)
import qualified Data.Text                                  as T
import           Data.Hashable

import           Language.LSP.Types.Common
import           Language.LSP.Types.Location
import           Language.LSP.Types.TextDocument
import           Language.LSP.Types.Uri
import           Language.LSP.Types.Utils

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

data TextEdit =
  TextEdit
    { TextEdit -> Range
_range   :: Range
    , TextEdit -> Text
_newText :: Text
    } deriving (Int -> TextEdit -> ShowS
[TextEdit] -> ShowS
TextEdit -> String
(Int -> TextEdit -> ShowS)
-> (TextEdit -> String) -> ([TextEdit] -> ShowS) -> Show TextEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextEdit] -> ShowS
$cshowList :: [TextEdit] -> ShowS
show :: TextEdit -> String
$cshow :: TextEdit -> String
showsPrec :: Int -> TextEdit -> ShowS
$cshowsPrec :: Int -> TextEdit -> ShowS
Show,ReadPrec [TextEdit]
ReadPrec TextEdit
Int -> ReadS TextEdit
ReadS [TextEdit]
(Int -> ReadS TextEdit)
-> ReadS [TextEdit]
-> ReadPrec TextEdit
-> ReadPrec [TextEdit]
-> Read TextEdit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextEdit]
$creadListPrec :: ReadPrec [TextEdit]
readPrec :: ReadPrec TextEdit
$creadPrec :: ReadPrec TextEdit
readList :: ReadS [TextEdit]
$creadList :: ReadS [TextEdit]
readsPrec :: Int -> ReadS TextEdit
$creadsPrec :: Int -> ReadS TextEdit
Read,TextEdit -> TextEdit -> Bool
(TextEdit -> TextEdit -> Bool)
-> (TextEdit -> TextEdit -> Bool) -> Eq TextEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextEdit -> TextEdit -> Bool
$c/= :: TextEdit -> TextEdit -> Bool
== :: TextEdit -> TextEdit -> Bool
$c== :: TextEdit -> TextEdit -> Bool
Eq)

deriveJSON lspOptions ''TextEdit

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

{-|
Additional information that describes document changes.

@since 3.16.0
-}
data ChangeAnnotation =
  ChangeAnnotation
    { -- | A human-readable string describing the actual change. The string
      -- is rendered prominent in the user interface.
      ChangeAnnotation -> Text
_label             :: Text
      -- | A flag which indicates that user confirmation is needed
      -- before applying the change.
    , ChangeAnnotation -> Maybe Bool
_needsConfirmation :: Maybe Bool
      -- | A human-readable string which is rendered less prominent in
      -- the user interface.
    , ChangeAnnotation -> Maybe Text
_description       :: Maybe Text
    } deriving (Int -> ChangeAnnotation -> ShowS
[ChangeAnnotation] -> ShowS
ChangeAnnotation -> String
(Int -> ChangeAnnotation -> ShowS)
-> (ChangeAnnotation -> String)
-> ([ChangeAnnotation] -> ShowS)
-> Show ChangeAnnotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeAnnotation] -> ShowS
$cshowList :: [ChangeAnnotation] -> ShowS
show :: ChangeAnnotation -> String
$cshow :: ChangeAnnotation -> String
showsPrec :: Int -> ChangeAnnotation -> ShowS
$cshowsPrec :: Int -> ChangeAnnotation -> ShowS
Show, ReadPrec [ChangeAnnotation]
ReadPrec ChangeAnnotation
Int -> ReadS ChangeAnnotation
ReadS [ChangeAnnotation]
(Int -> ReadS ChangeAnnotation)
-> ReadS [ChangeAnnotation]
-> ReadPrec ChangeAnnotation
-> ReadPrec [ChangeAnnotation]
-> Read ChangeAnnotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeAnnotation]
$creadListPrec :: ReadPrec [ChangeAnnotation]
readPrec :: ReadPrec ChangeAnnotation
$creadPrec :: ReadPrec ChangeAnnotation
readList :: ReadS [ChangeAnnotation]
$creadList :: ReadS [ChangeAnnotation]
readsPrec :: Int -> ReadS ChangeAnnotation
$creadsPrec :: Int -> ReadS ChangeAnnotation
Read, ChangeAnnotation -> ChangeAnnotation -> Bool
(ChangeAnnotation -> ChangeAnnotation -> Bool)
-> (ChangeAnnotation -> ChangeAnnotation -> Bool)
-> Eq ChangeAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeAnnotation -> ChangeAnnotation -> Bool
$c/= :: ChangeAnnotation -> ChangeAnnotation -> Bool
== :: ChangeAnnotation -> ChangeAnnotation -> Bool
$c== :: ChangeAnnotation -> ChangeAnnotation -> Bool
Eq)

deriveJSON lspOptions ''ChangeAnnotation

{-|
An identifier referring to a change annotation managed by a workspace
edit.

@since 3.16.0
-}
newtype ChangeAnnotationIdentifier = ChangeAnnotationIdentifierId Text
  deriving (Int -> ChangeAnnotationIdentifier -> ShowS
[ChangeAnnotationIdentifier] -> ShowS
ChangeAnnotationIdentifier -> String
(Int -> ChangeAnnotationIdentifier -> ShowS)
-> (ChangeAnnotationIdentifier -> String)
-> ([ChangeAnnotationIdentifier] -> ShowS)
-> Show ChangeAnnotationIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeAnnotationIdentifier] -> ShowS
$cshowList :: [ChangeAnnotationIdentifier] -> ShowS
show :: ChangeAnnotationIdentifier -> String
$cshow :: ChangeAnnotationIdentifier -> String
showsPrec :: Int -> ChangeAnnotationIdentifier -> ShowS
$cshowsPrec :: Int -> ChangeAnnotationIdentifier -> ShowS
Show, ReadPrec [ChangeAnnotationIdentifier]
ReadPrec ChangeAnnotationIdentifier
Int -> ReadS ChangeAnnotationIdentifier
ReadS [ChangeAnnotationIdentifier]
(Int -> ReadS ChangeAnnotationIdentifier)
-> ReadS [ChangeAnnotationIdentifier]
-> ReadPrec ChangeAnnotationIdentifier
-> ReadPrec [ChangeAnnotationIdentifier]
-> Read ChangeAnnotationIdentifier
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeAnnotationIdentifier]
$creadListPrec :: ReadPrec [ChangeAnnotationIdentifier]
readPrec :: ReadPrec ChangeAnnotationIdentifier
$creadPrec :: ReadPrec ChangeAnnotationIdentifier
readList :: ReadS [ChangeAnnotationIdentifier]
$creadList :: ReadS [ChangeAnnotationIdentifier]
readsPrec :: Int -> ReadS ChangeAnnotationIdentifier
$creadsPrec :: Int -> ReadS ChangeAnnotationIdentifier
Read, ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool
(ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool)
-> (ChangeAnnotationIdentifier
    -> ChangeAnnotationIdentifier -> Bool)
-> Eq ChangeAnnotationIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool
$c/= :: ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool
== :: ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool
$c== :: ChangeAnnotationIdentifier -> ChangeAnnotationIdentifier -> Bool
Eq, Value -> Parser [ChangeAnnotationIdentifier]
Value -> Parser ChangeAnnotationIdentifier
(Value -> Parser ChangeAnnotationIdentifier)
-> (Value -> Parser [ChangeAnnotationIdentifier])
-> FromJSON ChangeAnnotationIdentifier
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChangeAnnotationIdentifier]
$cparseJSONList :: Value -> Parser [ChangeAnnotationIdentifier]
parseJSON :: Value -> Parser ChangeAnnotationIdentifier
$cparseJSON :: Value -> Parser ChangeAnnotationIdentifier
FromJSON, [ChangeAnnotationIdentifier] -> Encoding
[ChangeAnnotationIdentifier] -> Value
ChangeAnnotationIdentifier -> Encoding
ChangeAnnotationIdentifier -> Value
(ChangeAnnotationIdentifier -> Value)
-> (ChangeAnnotationIdentifier -> Encoding)
-> ([ChangeAnnotationIdentifier] -> Value)
-> ([ChangeAnnotationIdentifier] -> Encoding)
-> ToJSON ChangeAnnotationIdentifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChangeAnnotationIdentifier] -> Encoding
$ctoEncodingList :: [ChangeAnnotationIdentifier] -> Encoding
toJSONList :: [ChangeAnnotationIdentifier] -> Value
$ctoJSONList :: [ChangeAnnotationIdentifier] -> Value
toEncoding :: ChangeAnnotationIdentifier -> Encoding
$ctoEncoding :: ChangeAnnotationIdentifier -> Encoding
toJSON :: ChangeAnnotationIdentifier -> Value
$ctoJSON :: ChangeAnnotationIdentifier -> Value
ToJSON, ToJSONKeyFunction [ChangeAnnotationIdentifier]
ToJSONKeyFunction ChangeAnnotationIdentifier
ToJSONKeyFunction ChangeAnnotationIdentifier
-> ToJSONKeyFunction [ChangeAnnotationIdentifier]
-> ToJSONKey ChangeAnnotationIdentifier
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ChangeAnnotationIdentifier]
$ctoJSONKeyList :: ToJSONKeyFunction [ChangeAnnotationIdentifier]
toJSONKey :: ToJSONKeyFunction ChangeAnnotationIdentifier
$ctoJSONKey :: ToJSONKeyFunction ChangeAnnotationIdentifier
ToJSONKey, FromJSONKeyFunction [ChangeAnnotationIdentifier]
FromJSONKeyFunction ChangeAnnotationIdentifier
FromJSONKeyFunction ChangeAnnotationIdentifier
-> FromJSONKeyFunction [ChangeAnnotationIdentifier]
-> FromJSONKey ChangeAnnotationIdentifier
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ChangeAnnotationIdentifier]
$cfromJSONKeyList :: FromJSONKeyFunction [ChangeAnnotationIdentifier]
fromJSONKey :: FromJSONKeyFunction ChangeAnnotationIdentifier
$cfromJSONKey :: FromJSONKeyFunction ChangeAnnotationIdentifier
FromJSONKey, Int -> ChangeAnnotationIdentifier -> Int
ChangeAnnotationIdentifier -> Int
(Int -> ChangeAnnotationIdentifier -> Int)
-> (ChangeAnnotationIdentifier -> Int)
-> Hashable ChangeAnnotationIdentifier
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ChangeAnnotationIdentifier -> Int
$chash :: ChangeAnnotationIdentifier -> Int
hashWithSalt :: Int -> ChangeAnnotationIdentifier -> Int
$chashWithSalt :: Int -> ChangeAnnotationIdentifier -> Int
Hashable)

makeExtendingDatatype "AnnotatedTextEdit" [''TextEdit]
  [("_annotationId", [t| ChangeAnnotationIdentifier |]) ]
deriveJSON lspOptions ''AnnotatedTextEdit

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

data TextDocumentEdit =
  TextDocumentEdit
    { TextDocumentEdit -> VersionedTextDocumentIdentifier
_textDocument :: VersionedTextDocumentIdentifier
    , TextDocumentEdit -> List (TextEdit |? AnnotatedTextEdit)
_edits        :: List (TextEdit |? AnnotatedTextEdit)
    } deriving (Int -> TextDocumentEdit -> ShowS
[TextDocumentEdit] -> ShowS
TextDocumentEdit -> String
(Int -> TextDocumentEdit -> ShowS)
-> (TextDocumentEdit -> String)
-> ([TextDocumentEdit] -> ShowS)
-> Show TextDocumentEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentEdit] -> ShowS
$cshowList :: [TextDocumentEdit] -> ShowS
show :: TextDocumentEdit -> String
$cshow :: TextDocumentEdit -> String
showsPrec :: Int -> TextDocumentEdit -> ShowS
$cshowsPrec :: Int -> TextDocumentEdit -> ShowS
Show, ReadPrec [TextDocumentEdit]
ReadPrec TextDocumentEdit
Int -> ReadS TextDocumentEdit
ReadS [TextDocumentEdit]
(Int -> ReadS TextDocumentEdit)
-> ReadS [TextDocumentEdit]
-> ReadPrec TextDocumentEdit
-> ReadPrec [TextDocumentEdit]
-> Read TextDocumentEdit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentEdit]
$creadListPrec :: ReadPrec [TextDocumentEdit]
readPrec :: ReadPrec TextDocumentEdit
$creadPrec :: ReadPrec TextDocumentEdit
readList :: ReadS [TextDocumentEdit]
$creadList :: ReadS [TextDocumentEdit]
readsPrec :: Int -> ReadS TextDocumentEdit
$creadsPrec :: Int -> ReadS TextDocumentEdit
Read, TextDocumentEdit -> TextDocumentEdit -> Bool
(TextDocumentEdit -> TextDocumentEdit -> Bool)
-> (TextDocumentEdit -> TextDocumentEdit -> Bool)
-> Eq TextDocumentEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentEdit -> TextDocumentEdit -> Bool
$c/= :: TextDocumentEdit -> TextDocumentEdit -> Bool
== :: TextDocumentEdit -> TextDocumentEdit -> Bool
$c== :: TextDocumentEdit -> TextDocumentEdit -> Bool
Eq)

deriveJSON lspOptions ''TextDocumentEdit

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

-- | Options to create a file.
data CreateFileOptions =
  CreateFileOptions
    { -- | Overwrite existing file. Overwrite wins over `ignoreIfExists`
      CreateFileOptions -> Maybe Bool
_overwrite      :: Maybe Bool
      -- | Ignore if exists.
    , CreateFileOptions -> Maybe Bool
_ignoreIfExists :: Maybe Bool
    } deriving (Int -> CreateFileOptions -> ShowS
[CreateFileOptions] -> ShowS
CreateFileOptions -> String
(Int -> CreateFileOptions -> ShowS)
-> (CreateFileOptions -> String)
-> ([CreateFileOptions] -> ShowS)
-> Show CreateFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFileOptions] -> ShowS
$cshowList :: [CreateFileOptions] -> ShowS
show :: CreateFileOptions -> String
$cshow :: CreateFileOptions -> String
showsPrec :: Int -> CreateFileOptions -> ShowS
$cshowsPrec :: Int -> CreateFileOptions -> ShowS
Show, ReadPrec [CreateFileOptions]
ReadPrec CreateFileOptions
Int -> ReadS CreateFileOptions
ReadS [CreateFileOptions]
(Int -> ReadS CreateFileOptions)
-> ReadS [CreateFileOptions]
-> ReadPrec CreateFileOptions
-> ReadPrec [CreateFileOptions]
-> Read CreateFileOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFileOptions]
$creadListPrec :: ReadPrec [CreateFileOptions]
readPrec :: ReadPrec CreateFileOptions
$creadPrec :: ReadPrec CreateFileOptions
readList :: ReadS [CreateFileOptions]
$creadList :: ReadS [CreateFileOptions]
readsPrec :: Int -> ReadS CreateFileOptions
$creadsPrec :: Int -> ReadS CreateFileOptions
Read, CreateFileOptions -> CreateFileOptions -> Bool
(CreateFileOptions -> CreateFileOptions -> Bool)
-> (CreateFileOptions -> CreateFileOptions -> Bool)
-> Eq CreateFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFileOptions -> CreateFileOptions -> Bool
$c/= :: CreateFileOptions -> CreateFileOptions -> Bool
== :: CreateFileOptions -> CreateFileOptions -> Bool
$c== :: CreateFileOptions -> CreateFileOptions -> Bool
Eq)

deriveJSON lspOptions ''CreateFileOptions

-- | Create file operation
data CreateFile =
  CreateFile
    { -- | The resource to create.
      CreateFile -> Uri
_uri      :: Uri
      -- | Additional options
    , CreateFile -> Maybe CreateFileOptions
_options  :: Maybe CreateFileOptions
      -- | An optional annotation identifer describing the operation.
      --
      -- @since 3.16.0
    , CreateFile -> Maybe ChangeAnnotationIdentifier
_annotationId  :: Maybe ChangeAnnotationIdentifier
    } deriving (Int -> CreateFile -> ShowS
[CreateFile] -> ShowS
CreateFile -> String
(Int -> CreateFile -> ShowS)
-> (CreateFile -> String)
-> ([CreateFile] -> ShowS)
-> Show CreateFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFile] -> ShowS
$cshowList :: [CreateFile] -> ShowS
show :: CreateFile -> String
$cshow :: CreateFile -> String
showsPrec :: Int -> CreateFile -> ShowS
$cshowsPrec :: Int -> CreateFile -> ShowS
Show, ReadPrec [CreateFile]
ReadPrec CreateFile
Int -> ReadS CreateFile
ReadS [CreateFile]
(Int -> ReadS CreateFile)
-> ReadS [CreateFile]
-> ReadPrec CreateFile
-> ReadPrec [CreateFile]
-> Read CreateFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFile]
$creadListPrec :: ReadPrec [CreateFile]
readPrec :: ReadPrec CreateFile
$creadPrec :: ReadPrec CreateFile
readList :: ReadS [CreateFile]
$creadList :: ReadS [CreateFile]
readsPrec :: Int -> ReadS CreateFile
$creadsPrec :: Int -> ReadS CreateFile
Read, CreateFile -> CreateFile -> Bool
(CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> Bool) -> Eq CreateFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFile -> CreateFile -> Bool
$c/= :: CreateFile -> CreateFile -> Bool
== :: CreateFile -> CreateFile -> Bool
$c== :: CreateFile -> CreateFile -> Bool
Eq)

instance ToJSON CreateFile where
    toJSON :: CreateFile -> Value
toJSON CreateFile{Maybe ChangeAnnotationIdentifier
Maybe CreateFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe CreateFileOptions
_uri :: Uri
$sel:_annotationId:CreateFile :: CreateFile -> Maybe ChangeAnnotationIdentifier
$sel:_options:CreateFile :: CreateFile -> Maybe CreateFileOptions
$sel:_uri:CreateFile :: CreateFile -> Uri
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"kind" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"create" :: Text)
        , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"uri" Text -> Uri -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Uri
_uri
        , (Text
"options" Text -> CreateFileOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (CreateFileOptions -> Pair)
-> Maybe CreateFileOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CreateFileOptions
_options
        , (Text
"annotationId" Text -> ChangeAnnotationIdentifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (ChangeAnnotationIdentifier -> Pair)
-> Maybe ChangeAnnotationIdentifier -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON CreateFile where
    parseJSON :: Value -> Parser CreateFile
parseJSON = String
-> (Object -> Parser CreateFile) -> Value -> Parser CreateFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateFile" ((Object -> Parser CreateFile) -> Value -> Parser CreateFile)
-> (Object -> Parser CreateFile) -> Value -> Parser CreateFile
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"kind"
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"create" :: Text)) 
          (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"create\" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kind
        Uri
_uri <- Object
o Object -> Text -> Parser Uri
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uri"
        Maybe CreateFileOptions
_options <- Object
o Object -> Text -> Parser (Maybe CreateFileOptions)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o Object -> Text -> Parser (Maybe ChangeAnnotationIdentifier)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"annotationId"
        CreateFile -> Parser CreateFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateFile :: Uri
-> Maybe CreateFileOptions
-> Maybe ChangeAnnotationIdentifier
-> CreateFile
CreateFile{Maybe ChangeAnnotationIdentifier
Maybe CreateFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe CreateFileOptions
_uri :: Uri
$sel:_annotationId:CreateFile :: Maybe ChangeAnnotationIdentifier
$sel:_options:CreateFile :: Maybe CreateFileOptions
$sel:_uri:CreateFile :: Uri
..}

-- Rename file options
data RenameFileOptions =
  RenameFileOptions
    { -- | Overwrite target if existing. Overwrite wins over `ignoreIfExists`
      RenameFileOptions -> Maybe Bool
_overwrite      :: Maybe Bool
      -- | Ignores if target exists.
    , RenameFileOptions -> Maybe Bool
_ignoreIfExists :: Maybe Bool
    } deriving (Int -> RenameFileOptions -> ShowS
[RenameFileOptions] -> ShowS
RenameFileOptions -> String
(Int -> RenameFileOptions -> ShowS)
-> (RenameFileOptions -> String)
-> ([RenameFileOptions] -> ShowS)
-> Show RenameFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameFileOptions] -> ShowS
$cshowList :: [RenameFileOptions] -> ShowS
show :: RenameFileOptions -> String
$cshow :: RenameFileOptions -> String
showsPrec :: Int -> RenameFileOptions -> ShowS
$cshowsPrec :: Int -> RenameFileOptions -> ShowS
Show, ReadPrec [RenameFileOptions]
ReadPrec RenameFileOptions
Int -> ReadS RenameFileOptions
ReadS [RenameFileOptions]
(Int -> ReadS RenameFileOptions)
-> ReadS [RenameFileOptions]
-> ReadPrec RenameFileOptions
-> ReadPrec [RenameFileOptions]
-> Read RenameFileOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RenameFileOptions]
$creadListPrec :: ReadPrec [RenameFileOptions]
readPrec :: ReadPrec RenameFileOptions
$creadPrec :: ReadPrec RenameFileOptions
readList :: ReadS [RenameFileOptions]
$creadList :: ReadS [RenameFileOptions]
readsPrec :: Int -> ReadS RenameFileOptions
$creadsPrec :: Int -> ReadS RenameFileOptions
Read, RenameFileOptions -> RenameFileOptions -> Bool
(RenameFileOptions -> RenameFileOptions -> Bool)
-> (RenameFileOptions -> RenameFileOptions -> Bool)
-> Eq RenameFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameFileOptions -> RenameFileOptions -> Bool
$c/= :: RenameFileOptions -> RenameFileOptions -> Bool
== :: RenameFileOptions -> RenameFileOptions -> Bool
$c== :: RenameFileOptions -> RenameFileOptions -> Bool
Eq)

deriveJSON lspOptions ''RenameFileOptions

-- | Rename file operation
data RenameFile =
  RenameFile
    { -- | The old (existing) location.
      RenameFile -> Uri
_oldUri   :: Uri
      -- | The new location.
    , RenameFile -> Uri
_newUri   :: Uri
      -- | Rename options.
    , RenameFile -> Maybe RenameFileOptions
_options  :: Maybe RenameFileOptions
      -- | An optional annotation identifer describing the operation.
      --
      -- @since 3.16.0
    , RenameFile -> Maybe ChangeAnnotationIdentifier
_annotationId  :: Maybe ChangeAnnotationIdentifier
    } deriving (Int -> RenameFile -> ShowS
[RenameFile] -> ShowS
RenameFile -> String
(Int -> RenameFile -> ShowS)
-> (RenameFile -> String)
-> ([RenameFile] -> ShowS)
-> Show RenameFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameFile] -> ShowS
$cshowList :: [RenameFile] -> ShowS
show :: RenameFile -> String
$cshow :: RenameFile -> String
showsPrec :: Int -> RenameFile -> ShowS
$cshowsPrec :: Int -> RenameFile -> ShowS
Show, ReadPrec [RenameFile]
ReadPrec RenameFile
Int -> ReadS RenameFile
ReadS [RenameFile]
(Int -> ReadS RenameFile)
-> ReadS [RenameFile]
-> ReadPrec RenameFile
-> ReadPrec [RenameFile]
-> Read RenameFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RenameFile]
$creadListPrec :: ReadPrec [RenameFile]
readPrec :: ReadPrec RenameFile
$creadPrec :: ReadPrec RenameFile
readList :: ReadS [RenameFile]
$creadList :: ReadS [RenameFile]
readsPrec :: Int -> ReadS RenameFile
$creadsPrec :: Int -> ReadS RenameFile
Read, RenameFile -> RenameFile -> Bool
(RenameFile -> RenameFile -> Bool)
-> (RenameFile -> RenameFile -> Bool) -> Eq RenameFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameFile -> RenameFile -> Bool
$c/= :: RenameFile -> RenameFile -> Bool
== :: RenameFile -> RenameFile -> Bool
$c== :: RenameFile -> RenameFile -> Bool
Eq)

instance ToJSON RenameFile where
    toJSON :: RenameFile -> Value
toJSON RenameFile{Maybe ChangeAnnotationIdentifier
Maybe RenameFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe RenameFileOptions
_newUri :: Uri
_oldUri :: Uri
$sel:_annotationId:RenameFile :: RenameFile -> Maybe ChangeAnnotationIdentifier
$sel:_options:RenameFile :: RenameFile -> Maybe RenameFileOptions
$sel:_newUri:RenameFile :: RenameFile -> Uri
$sel:_oldUri:RenameFile :: RenameFile -> Uri
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"kind" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"rename" :: Text)
        , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"oldUri" Text -> Uri -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Uri
_oldUri
        , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"newUri" Text -> Uri -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Uri
_newUri
        , (Text
"options" Text -> RenameFileOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (RenameFileOptions -> Pair)
-> Maybe RenameFileOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RenameFileOptions
_options
        , (Text
"annotationId" Text -> ChangeAnnotationIdentifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (ChangeAnnotationIdentifier -> Pair)
-> Maybe ChangeAnnotationIdentifier -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON RenameFile where
    parseJSON :: Value -> Parser RenameFile
parseJSON = String
-> (Object -> Parser RenameFile) -> Value -> Parser RenameFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RenameFile" ((Object -> Parser RenameFile) -> Value -> Parser RenameFile)
-> (Object -> Parser RenameFile) -> Value -> Parser RenameFile
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"kind"
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"rename" :: Text)) 
          (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"rename\" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kind
        Uri
_oldUri <- Object
o Object -> Text -> Parser Uri
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"oldUri"
        Uri
_newUri <- Object
o Object -> Text -> Parser Uri
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"newUri"
        Maybe RenameFileOptions
_options <- Object
o Object -> Text -> Parser (Maybe RenameFileOptions)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o Object -> Text -> Parser (Maybe ChangeAnnotationIdentifier)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"annotationId"
        RenameFile -> Parser RenameFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure RenameFile :: Uri
-> Uri
-> Maybe RenameFileOptions
-> Maybe ChangeAnnotationIdentifier
-> RenameFile
RenameFile{Maybe ChangeAnnotationIdentifier
Maybe RenameFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe RenameFileOptions
_newUri :: Uri
_oldUri :: Uri
$sel:_annotationId:RenameFile :: Maybe ChangeAnnotationIdentifier
$sel:_options:RenameFile :: Maybe RenameFileOptions
$sel:_newUri:RenameFile :: Uri
$sel:_oldUri:RenameFile :: Uri
..}

-- Delete file options
data DeleteFileOptions =
  DeleteFileOptions
    { -- | Delete the content recursively if a folder is denoted.
      DeleteFileOptions -> Maybe Bool
_recursive          :: Maybe Bool
      -- | Ignore the operation if the file doesn't exist.
    , DeleteFileOptions -> Maybe Bool
_ignoreIfNotExists  :: Maybe Bool
    } deriving (Int -> DeleteFileOptions -> ShowS
[DeleteFileOptions] -> ShowS
DeleteFileOptions -> String
(Int -> DeleteFileOptions -> ShowS)
-> (DeleteFileOptions -> String)
-> ([DeleteFileOptions] -> ShowS)
-> Show DeleteFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFileOptions] -> ShowS
$cshowList :: [DeleteFileOptions] -> ShowS
show :: DeleteFileOptions -> String
$cshow :: DeleteFileOptions -> String
showsPrec :: Int -> DeleteFileOptions -> ShowS
$cshowsPrec :: Int -> DeleteFileOptions -> ShowS
Show, ReadPrec [DeleteFileOptions]
ReadPrec DeleteFileOptions
Int -> ReadS DeleteFileOptions
ReadS [DeleteFileOptions]
(Int -> ReadS DeleteFileOptions)
-> ReadS [DeleteFileOptions]
-> ReadPrec DeleteFileOptions
-> ReadPrec [DeleteFileOptions]
-> Read DeleteFileOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFileOptions]
$creadListPrec :: ReadPrec [DeleteFileOptions]
readPrec :: ReadPrec DeleteFileOptions
$creadPrec :: ReadPrec DeleteFileOptions
readList :: ReadS [DeleteFileOptions]
$creadList :: ReadS [DeleteFileOptions]
readsPrec :: Int -> ReadS DeleteFileOptions
$creadsPrec :: Int -> ReadS DeleteFileOptions
Read, DeleteFileOptions -> DeleteFileOptions -> Bool
(DeleteFileOptions -> DeleteFileOptions -> Bool)
-> (DeleteFileOptions -> DeleteFileOptions -> Bool)
-> Eq DeleteFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFileOptions -> DeleteFileOptions -> Bool
$c/= :: DeleteFileOptions -> DeleteFileOptions -> Bool
== :: DeleteFileOptions -> DeleteFileOptions -> Bool
$c== :: DeleteFileOptions -> DeleteFileOptions -> Bool
Eq)

deriveJSON lspOptions ''DeleteFileOptions

-- | Delete file operation
data DeleteFile =
  DeleteFile
    { -- | The file to delete.
      DeleteFile -> Uri
_uri      :: Uri
      -- | Delete options.
    , DeleteFile -> Maybe DeleteFileOptions
_options  :: Maybe DeleteFileOptions
      -- | An optional annotation identifer describing the operation.
      --
      -- @since 3.16.0
    , DeleteFile -> Maybe ChangeAnnotationIdentifier
_annotationId  :: Maybe ChangeAnnotationIdentifier
    } deriving (Int -> DeleteFile -> ShowS
[DeleteFile] -> ShowS
DeleteFile -> String
(Int -> DeleteFile -> ShowS)
-> (DeleteFile -> String)
-> ([DeleteFile] -> ShowS)
-> Show DeleteFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFile] -> ShowS
$cshowList :: [DeleteFile] -> ShowS
show :: DeleteFile -> String
$cshow :: DeleteFile -> String
showsPrec :: Int -> DeleteFile -> ShowS
$cshowsPrec :: Int -> DeleteFile -> ShowS
Show, ReadPrec [DeleteFile]
ReadPrec DeleteFile
Int -> ReadS DeleteFile
ReadS [DeleteFile]
(Int -> ReadS DeleteFile)
-> ReadS [DeleteFile]
-> ReadPrec DeleteFile
-> ReadPrec [DeleteFile]
-> Read DeleteFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFile]
$creadListPrec :: ReadPrec [DeleteFile]
readPrec :: ReadPrec DeleteFile
$creadPrec :: ReadPrec DeleteFile
readList :: ReadS [DeleteFile]
$creadList :: ReadS [DeleteFile]
readsPrec :: Int -> ReadS DeleteFile
$creadsPrec :: Int -> ReadS DeleteFile
Read, DeleteFile -> DeleteFile -> Bool
(DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> Bool) -> Eq DeleteFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFile -> DeleteFile -> Bool
$c/= :: DeleteFile -> DeleteFile -> Bool
== :: DeleteFile -> DeleteFile -> Bool
$c== :: DeleteFile -> DeleteFile -> Bool
Eq)

instance ToJSON DeleteFile where
    toJSON :: DeleteFile -> Value
toJSON DeleteFile{Maybe ChangeAnnotationIdentifier
Maybe DeleteFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe DeleteFileOptions
_uri :: Uri
$sel:_annotationId:DeleteFile :: DeleteFile -> Maybe ChangeAnnotationIdentifier
$sel:_options:DeleteFile :: DeleteFile -> Maybe DeleteFileOptions
$sel:_uri:DeleteFile :: DeleteFile -> Uri
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"kind" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"delete" :: Text)
        , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Text
"uri" Text -> Uri -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Uri
_uri
        , (Text
"options" Text -> DeleteFileOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (DeleteFileOptions -> Pair)
-> Maybe DeleteFileOptions -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DeleteFileOptions
_options
        , (Text
"annotationId" Text -> ChangeAnnotationIdentifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (ChangeAnnotationIdentifier -> Pair)
-> Maybe ChangeAnnotationIdentifier -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON DeleteFile where
    parseJSON :: Value -> Parser DeleteFile
parseJSON = String
-> (Object -> Parser DeleteFile) -> Value -> Parser DeleteFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DeleteFile" ((Object -> Parser DeleteFile) -> Value -> Parser DeleteFile)
-> (Object -> Parser DeleteFile) -> Value -> Parser DeleteFile
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"kind"
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"delete" :: Text)) 
          (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"delete\" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kind
        Uri
_uri <- Object
o Object -> Text -> Parser Uri
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uri"
        Maybe DeleteFileOptions
_options <- Object
o Object -> Text -> Parser (Maybe DeleteFileOptions)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o Object -> Text -> Parser (Maybe ChangeAnnotationIdentifier)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"annotationId"
        DeleteFile -> Parser DeleteFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeleteFile :: Uri
-> Maybe DeleteFileOptions
-> Maybe ChangeAnnotationIdentifier
-> DeleteFile
DeleteFile{Maybe ChangeAnnotationIdentifier
Maybe DeleteFileOptions
Uri
_annotationId :: Maybe ChangeAnnotationIdentifier
_options :: Maybe DeleteFileOptions
_uri :: Uri
$sel:_annotationId:DeleteFile :: Maybe ChangeAnnotationIdentifier
$sel:_options:DeleteFile :: Maybe DeleteFileOptions
$sel:_uri:DeleteFile :: Uri
..}

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

-- | `TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile` is a bit mouthful, here's the synonym
type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile

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

type WorkspaceEditMap = H.HashMap Uri (List TextEdit)
type ChangeAnnotationMap = H.HashMap ChangeAnnotationIdentifier ChangeAnnotation

data WorkspaceEdit =
  WorkspaceEdit
    {
      -- | Holds changes to existing resources.
      WorkspaceEdit -> Maybe WorkspaceEditMap
_changes           :: Maybe WorkspaceEditMap
      -- | Depending on the client capability
      -- `workspace.workspaceEdit.resourceOperations` document changes are either
      -- an array of `TextDocumentEdit`s to express changes to n different text
      -- documents where each text document edit addresses a specific version of
      -- a text document. Or it can contain above `TextDocumentEdit`s mixed with
      -- create, rename and delete file / folder operations.
      --
      -- Whether a client supports versioned document edits is expressed via
      -- `workspace.workspaceEdit.documentChanges` client capability.
      --
      -- If a client neither supports `documentChanges` nor
      -- `workspace.workspaceEdit.resourceOperations` then only plain `TextEdit`s
      -- using the `changes` property are supported.
    , WorkspaceEdit -> Maybe (List DocumentChange)
_documentChanges   :: Maybe (List DocumentChange)
      -- | A map of change annotations that can be referenced in
      -- `AnnotatedTextEdit`s or create, rename and delete file / folder
      -- operations.
      --
      -- Whether clients honor this property depends on the client capability
      -- `workspace.changeAnnotationSupport`.
      --
      -- @since 3.16.0
    , WorkspaceEdit -> Maybe ChangeAnnotationMap
_changeAnnotations :: Maybe ChangeAnnotationMap
    } deriving (Int -> WorkspaceEdit -> ShowS
[WorkspaceEdit] -> ShowS
WorkspaceEdit -> String
(Int -> WorkspaceEdit -> ShowS)
-> (WorkspaceEdit -> String)
-> ([WorkspaceEdit] -> ShowS)
-> Show WorkspaceEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceEdit] -> ShowS
$cshowList :: [WorkspaceEdit] -> ShowS
show :: WorkspaceEdit -> String
$cshow :: WorkspaceEdit -> String
showsPrec :: Int -> WorkspaceEdit -> ShowS
$cshowsPrec :: Int -> WorkspaceEdit -> ShowS
Show, ReadPrec [WorkspaceEdit]
ReadPrec WorkspaceEdit
Int -> ReadS WorkspaceEdit
ReadS [WorkspaceEdit]
(Int -> ReadS WorkspaceEdit)
-> ReadS [WorkspaceEdit]
-> ReadPrec WorkspaceEdit
-> ReadPrec [WorkspaceEdit]
-> Read WorkspaceEdit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceEdit]
$creadListPrec :: ReadPrec [WorkspaceEdit]
readPrec :: ReadPrec WorkspaceEdit
$creadPrec :: ReadPrec WorkspaceEdit
readList :: ReadS [WorkspaceEdit]
$creadList :: ReadS [WorkspaceEdit]
readsPrec :: Int -> ReadS WorkspaceEdit
$creadsPrec :: Int -> ReadS WorkspaceEdit
Read, WorkspaceEdit -> WorkspaceEdit -> Bool
(WorkspaceEdit -> WorkspaceEdit -> Bool)
-> (WorkspaceEdit -> WorkspaceEdit -> Bool) -> Eq WorkspaceEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceEdit -> WorkspaceEdit -> Bool
$c/= :: WorkspaceEdit -> WorkspaceEdit -> Bool
== :: WorkspaceEdit -> WorkspaceEdit -> Bool
$c== :: WorkspaceEdit -> WorkspaceEdit -> Bool
Eq)

instance Semigroup WorkspaceEdit where
  (WorkspaceEdit Maybe WorkspaceEditMap
a Maybe (List DocumentChange)
b Maybe ChangeAnnotationMap
c) <> :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
<> (WorkspaceEdit Maybe WorkspaceEditMap
a' Maybe (List DocumentChange)
b' Maybe ChangeAnnotationMap
c') = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (Maybe WorkspaceEditMap
a Maybe WorkspaceEditMap
-> Maybe WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. Semigroup a => a -> a -> a
<> Maybe WorkspaceEditMap
a') (Maybe (List DocumentChange)
b Maybe (List DocumentChange)
-> Maybe (List DocumentChange) -> Maybe (List DocumentChange)
forall a. Semigroup a => a -> a -> a
<> Maybe (List DocumentChange)
b') (Maybe ChangeAnnotationMap
c Maybe ChangeAnnotationMap
-> Maybe ChangeAnnotationMap -> Maybe ChangeAnnotationMap
forall a. Semigroup a => a -> a -> a
<> Maybe ChangeAnnotationMap
c')
instance Monoid WorkspaceEdit where
  mempty :: WorkspaceEdit
mempty = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing

deriveJSON lspOptions ''WorkspaceEdit

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

data ResourceOperationKind
  = ResourceOperationCreate -- ^ Supports creating new files and folders.
  | ResourceOperationRename -- ^ Supports renaming existing files and folders.
  | ResourceOperationDelete -- ^ Supports deleting existing files and folders.
  deriving (ReadPrec [ResourceOperationKind]
ReadPrec ResourceOperationKind
Int -> ReadS ResourceOperationKind
ReadS [ResourceOperationKind]
(Int -> ReadS ResourceOperationKind)
-> ReadS [ResourceOperationKind]
-> ReadPrec ResourceOperationKind
-> ReadPrec [ResourceOperationKind]
-> Read ResourceOperationKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResourceOperationKind]
$creadListPrec :: ReadPrec [ResourceOperationKind]
readPrec :: ReadPrec ResourceOperationKind
$creadPrec :: ReadPrec ResourceOperationKind
readList :: ReadS [ResourceOperationKind]
$creadList :: ReadS [ResourceOperationKind]
readsPrec :: Int -> ReadS ResourceOperationKind
$creadsPrec :: Int -> ReadS ResourceOperationKind
Read, Int -> ResourceOperationKind -> ShowS
[ResourceOperationKind] -> ShowS
ResourceOperationKind -> String
(Int -> ResourceOperationKind -> ShowS)
-> (ResourceOperationKind -> String)
-> ([ResourceOperationKind] -> ShowS)
-> Show ResourceOperationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceOperationKind] -> ShowS
$cshowList :: [ResourceOperationKind] -> ShowS
show :: ResourceOperationKind -> String
$cshow :: ResourceOperationKind -> String
showsPrec :: Int -> ResourceOperationKind -> ShowS
$cshowsPrec :: Int -> ResourceOperationKind -> ShowS
Show, ResourceOperationKind -> ResourceOperationKind -> Bool
(ResourceOperationKind -> ResourceOperationKind -> Bool)
-> (ResourceOperationKind -> ResourceOperationKind -> Bool)
-> Eq ResourceOperationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceOperationKind -> ResourceOperationKind -> Bool
$c/= :: ResourceOperationKind -> ResourceOperationKind -> Bool
== :: ResourceOperationKind -> ResourceOperationKind -> Bool
$c== :: ResourceOperationKind -> ResourceOperationKind -> Bool
Eq)
  
instance ToJSON ResourceOperationKind where
  toJSON :: ResourceOperationKind -> Value
toJSON ResourceOperationKind
ResourceOperationCreate = Text -> Value
String Text
"create"
  toJSON ResourceOperationKind
ResourceOperationRename = Text -> Value
String Text
"rename"
  toJSON ResourceOperationKind
ResourceOperationDelete = Text -> Value
String Text
"delete"

instance FromJSON ResourceOperationKind where
  parseJSON :: Value -> Parser ResourceOperationKind
parseJSON (String Text
"create") = ResourceOperationKind -> Parser ResourceOperationKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationCreate
  parseJSON (String Text
"rename") = ResourceOperationKind -> Parser ResourceOperationKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationRename
  parseJSON (String Text
"delete") = ResourceOperationKind -> Parser ResourceOperationKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationDelete
  parseJSON Value
_                 = Parser ResourceOperationKind
forall a. Monoid a => a
mempty

data FailureHandlingKind
  = FailureHandlingAbort -- ^ Applying the workspace change is simply aborted if one of the changes provided fails. All operations executed before the failing operation stay executed.
  | FailureHandlingTransactional -- ^ All operations are executed transactional. That means they either all succeed or no changes at all are applied to the workspace.
  | FailureHandlingTextOnlyTransactional -- ^ If the workspace edit contains only textual file changes they are executed transactional. If resource changes (create, rename or delete file) are part of the change the failure handling strategy is abort.
  | FailureHandlingUndo -- ^ The client tries to undo the operations already executed. But there is no guarantee that this is succeeding.
  deriving (ReadPrec [FailureHandlingKind]
ReadPrec FailureHandlingKind
Int -> ReadS FailureHandlingKind
ReadS [FailureHandlingKind]
(Int -> ReadS FailureHandlingKind)
-> ReadS [FailureHandlingKind]
-> ReadPrec FailureHandlingKind
-> ReadPrec [FailureHandlingKind]
-> Read FailureHandlingKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailureHandlingKind]
$creadListPrec :: ReadPrec [FailureHandlingKind]
readPrec :: ReadPrec FailureHandlingKind
$creadPrec :: ReadPrec FailureHandlingKind
readList :: ReadS [FailureHandlingKind]
$creadList :: ReadS [FailureHandlingKind]
readsPrec :: Int -> ReadS FailureHandlingKind
$creadsPrec :: Int -> ReadS FailureHandlingKind
Read, Int -> FailureHandlingKind -> ShowS
[FailureHandlingKind] -> ShowS
FailureHandlingKind -> String
(Int -> FailureHandlingKind -> ShowS)
-> (FailureHandlingKind -> String)
-> ([FailureHandlingKind] -> ShowS)
-> Show FailureHandlingKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureHandlingKind] -> ShowS
$cshowList :: [FailureHandlingKind] -> ShowS
show :: FailureHandlingKind -> String
$cshow :: FailureHandlingKind -> String
showsPrec :: Int -> FailureHandlingKind -> ShowS
$cshowsPrec :: Int -> FailureHandlingKind -> ShowS
Show, FailureHandlingKind -> FailureHandlingKind -> Bool
(FailureHandlingKind -> FailureHandlingKind -> Bool)
-> (FailureHandlingKind -> FailureHandlingKind -> Bool)
-> Eq FailureHandlingKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureHandlingKind -> FailureHandlingKind -> Bool
$c/= :: FailureHandlingKind -> FailureHandlingKind -> Bool
== :: FailureHandlingKind -> FailureHandlingKind -> Bool
$c== :: FailureHandlingKind -> FailureHandlingKind -> Bool
Eq)
  
instance ToJSON FailureHandlingKind where
  toJSON :: FailureHandlingKind -> Value
toJSON FailureHandlingKind
FailureHandlingAbort                 = Text -> Value
String Text
"abort"
  toJSON FailureHandlingKind
FailureHandlingTransactional         = Text -> Value
String Text
"transactional"
  toJSON FailureHandlingKind
FailureHandlingTextOnlyTransactional = Text -> Value
String Text
"textOnlyTransactional"
  toJSON FailureHandlingKind
FailureHandlingUndo                  = Text -> Value
String Text
"undo"

instance FromJSON FailureHandlingKind where
  parseJSON :: Value -> Parser FailureHandlingKind
parseJSON (String Text
"abort")                 = FailureHandlingKind -> Parser FailureHandlingKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingAbort
  parseJSON (String Text
"transactional")         = FailureHandlingKind -> Parser FailureHandlingKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingTransactional
  parseJSON (String Text
"textOnlyTransactional") = FailureHandlingKind -> Parser FailureHandlingKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingTextOnlyTransactional
  parseJSON (String Text
"undo")                  = FailureHandlingKind -> Parser FailureHandlingKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingUndo
  parseJSON Value
_                                = Parser FailureHandlingKind
forall a. Monoid a => a
mempty

data WorkspaceEditChangeAnnotationClientCapabilities =
  WorkspaceEditChangeAnnotationClientCapabilities
  {
    -- | Whether the client groups edits with equal labels into tree nodes,
    -- for instance all edits labelled with "Changes in Strings" would
    -- be a tree node.
    WorkspaceEditChangeAnnotationClientCapabilities -> Maybe Bool
groupsOnLabel :: Maybe Bool
  } deriving (Int -> WorkspaceEditChangeAnnotationClientCapabilities -> ShowS
[WorkspaceEditChangeAnnotationClientCapabilities] -> ShowS
WorkspaceEditChangeAnnotationClientCapabilities -> String
(Int -> WorkspaceEditChangeAnnotationClientCapabilities -> ShowS)
-> (WorkspaceEditChangeAnnotationClientCapabilities -> String)
-> ([WorkspaceEditChangeAnnotationClientCapabilities] -> ShowS)
-> Show WorkspaceEditChangeAnnotationClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceEditChangeAnnotationClientCapabilities] -> ShowS
$cshowList :: [WorkspaceEditChangeAnnotationClientCapabilities] -> ShowS
show :: WorkspaceEditChangeAnnotationClientCapabilities -> String
$cshow :: WorkspaceEditChangeAnnotationClientCapabilities -> String
showsPrec :: Int -> WorkspaceEditChangeAnnotationClientCapabilities -> ShowS
$cshowsPrec :: Int -> WorkspaceEditChangeAnnotationClientCapabilities -> ShowS
Show, ReadPrec [WorkspaceEditChangeAnnotationClientCapabilities]
ReadPrec WorkspaceEditChangeAnnotationClientCapabilities
Int -> ReadS WorkspaceEditChangeAnnotationClientCapabilities
ReadS [WorkspaceEditChangeAnnotationClientCapabilities]
(Int -> ReadS WorkspaceEditChangeAnnotationClientCapabilities)
-> ReadS [WorkspaceEditChangeAnnotationClientCapabilities]
-> ReadPrec WorkspaceEditChangeAnnotationClientCapabilities
-> ReadPrec [WorkspaceEditChangeAnnotationClientCapabilities]
-> Read WorkspaceEditChangeAnnotationClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceEditChangeAnnotationClientCapabilities]
$creadListPrec :: ReadPrec [WorkspaceEditChangeAnnotationClientCapabilities]
readPrec :: ReadPrec WorkspaceEditChangeAnnotationClientCapabilities
$creadPrec :: ReadPrec WorkspaceEditChangeAnnotationClientCapabilities
readList :: ReadS [WorkspaceEditChangeAnnotationClientCapabilities]
$creadList :: ReadS [WorkspaceEditChangeAnnotationClientCapabilities]
readsPrec :: Int -> ReadS WorkspaceEditChangeAnnotationClientCapabilities
$creadsPrec :: Int -> ReadS WorkspaceEditChangeAnnotationClientCapabilities
Read, WorkspaceEditChangeAnnotationClientCapabilities
-> WorkspaceEditChangeAnnotationClientCapabilities -> Bool
(WorkspaceEditChangeAnnotationClientCapabilities
 -> WorkspaceEditChangeAnnotationClientCapabilities -> Bool)
-> (WorkspaceEditChangeAnnotationClientCapabilities
    -> WorkspaceEditChangeAnnotationClientCapabilities -> Bool)
-> Eq WorkspaceEditChangeAnnotationClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceEditChangeAnnotationClientCapabilities
-> WorkspaceEditChangeAnnotationClientCapabilities -> Bool
$c/= :: WorkspaceEditChangeAnnotationClientCapabilities
-> WorkspaceEditChangeAnnotationClientCapabilities -> Bool
== :: WorkspaceEditChangeAnnotationClientCapabilities
-> WorkspaceEditChangeAnnotationClientCapabilities -> Bool
$c== :: WorkspaceEditChangeAnnotationClientCapabilities
-> WorkspaceEditChangeAnnotationClientCapabilities -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceEditChangeAnnotationClientCapabilities

data WorkspaceEditClientCapabilities =
  WorkspaceEditClientCapabilities
  { WorkspaceEditClientCapabilities -> Maybe Bool
_documentChanges :: Maybe Bool -- ^The client supports versioned document
                                   -- changes in 'WorkspaceEdit's
    -- | The resource operations the client supports. Clients should at least
    -- support @create@, @rename@ and @delete@ files and folders.
  , WorkspaceEditClientCapabilities
-> Maybe (List ResourceOperationKind)
_resourceOperations :: Maybe (List ResourceOperationKind)
    -- | The failure handling strategy of a client if applying the workspace edit
    -- fails.
  , WorkspaceEditClientCapabilities -> Maybe FailureHandlingKind
_failureHandling :: Maybe FailureHandlingKind
    -- | Whether the client normalizes line endings to the client specific
    -- setting.
    --
    -- If set to `true` the client will normalize line ending characters
    -- in a workspace edit to the client specific new line character(s).
    --
    -- @since 3.16.0
  , WorkspaceEditClientCapabilities -> Maybe Bool
_normalizesLineEndings :: Maybe Bool
    -- | Whether the client in general supports change annotations on text edits,
    -- create file, rename file and delete file changes.
    --
    -- @since 3.16.0
  , WorkspaceEditClientCapabilities
-> Maybe WorkspaceEditChangeAnnotationClientCapabilities
_changeAnnotationSupport :: Maybe WorkspaceEditChangeAnnotationClientCapabilities
  } deriving (Int -> WorkspaceEditClientCapabilities -> ShowS
[WorkspaceEditClientCapabilities] -> ShowS
WorkspaceEditClientCapabilities -> String
(Int -> WorkspaceEditClientCapabilities -> ShowS)
-> (WorkspaceEditClientCapabilities -> String)
-> ([WorkspaceEditClientCapabilities] -> ShowS)
-> Show WorkspaceEditClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceEditClientCapabilities] -> ShowS
$cshowList :: [WorkspaceEditClientCapabilities] -> ShowS
show :: WorkspaceEditClientCapabilities -> String
$cshow :: WorkspaceEditClientCapabilities -> String
showsPrec :: Int -> WorkspaceEditClientCapabilities -> ShowS
$cshowsPrec :: Int -> WorkspaceEditClientCapabilities -> ShowS
Show, ReadPrec [WorkspaceEditClientCapabilities]
ReadPrec WorkspaceEditClientCapabilities
Int -> ReadS WorkspaceEditClientCapabilities
ReadS [WorkspaceEditClientCapabilities]
(Int -> ReadS WorkspaceEditClientCapabilities)
-> ReadS [WorkspaceEditClientCapabilities]
-> ReadPrec WorkspaceEditClientCapabilities
-> ReadPrec [WorkspaceEditClientCapabilities]
-> Read WorkspaceEditClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceEditClientCapabilities]
$creadListPrec :: ReadPrec [WorkspaceEditClientCapabilities]
readPrec :: ReadPrec WorkspaceEditClientCapabilities
$creadPrec :: ReadPrec WorkspaceEditClientCapabilities
readList :: ReadS [WorkspaceEditClientCapabilities]
$creadList :: ReadS [WorkspaceEditClientCapabilities]
readsPrec :: Int -> ReadS WorkspaceEditClientCapabilities
$creadsPrec :: Int -> ReadS WorkspaceEditClientCapabilities
Read, WorkspaceEditClientCapabilities
-> WorkspaceEditClientCapabilities -> Bool
(WorkspaceEditClientCapabilities
 -> WorkspaceEditClientCapabilities -> Bool)
-> (WorkspaceEditClientCapabilities
    -> WorkspaceEditClientCapabilities -> Bool)
-> Eq WorkspaceEditClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceEditClientCapabilities
-> WorkspaceEditClientCapabilities -> Bool
$c/= :: WorkspaceEditClientCapabilities
-> WorkspaceEditClientCapabilities -> Bool
== :: WorkspaceEditClientCapabilities
-> WorkspaceEditClientCapabilities -> Bool
$c== :: WorkspaceEditClientCapabilities
-> WorkspaceEditClientCapabilities -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceEditClientCapabilities

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

data ApplyWorkspaceEditParams =
  ApplyWorkspaceEditParams
    { -- | An optional label of the workspace edit. This label is
      -- presented in the user interface for example on an undo
      -- stack to undo the workspace edit.
      ApplyWorkspaceEditParams -> Maybe Text
_label :: Maybe Text
      -- | The edits to apply
    , ApplyWorkspaceEditParams -> WorkspaceEdit
_edit :: WorkspaceEdit
    } deriving (Int -> ApplyWorkspaceEditParams -> ShowS
[ApplyWorkspaceEditParams] -> ShowS
ApplyWorkspaceEditParams -> String
(Int -> ApplyWorkspaceEditParams -> ShowS)
-> (ApplyWorkspaceEditParams -> String)
-> ([ApplyWorkspaceEditParams] -> ShowS)
-> Show ApplyWorkspaceEditParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyWorkspaceEditParams] -> ShowS
$cshowList :: [ApplyWorkspaceEditParams] -> ShowS
show :: ApplyWorkspaceEditParams -> String
$cshow :: ApplyWorkspaceEditParams -> String
showsPrec :: Int -> ApplyWorkspaceEditParams -> ShowS
$cshowsPrec :: Int -> ApplyWorkspaceEditParams -> ShowS
Show, ReadPrec [ApplyWorkspaceEditParams]
ReadPrec ApplyWorkspaceEditParams
Int -> ReadS ApplyWorkspaceEditParams
ReadS [ApplyWorkspaceEditParams]
(Int -> ReadS ApplyWorkspaceEditParams)
-> ReadS [ApplyWorkspaceEditParams]
-> ReadPrec ApplyWorkspaceEditParams
-> ReadPrec [ApplyWorkspaceEditParams]
-> Read ApplyWorkspaceEditParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyWorkspaceEditParams]
$creadListPrec :: ReadPrec [ApplyWorkspaceEditParams]
readPrec :: ReadPrec ApplyWorkspaceEditParams
$creadPrec :: ReadPrec ApplyWorkspaceEditParams
readList :: ReadS [ApplyWorkspaceEditParams]
$creadList :: ReadS [ApplyWorkspaceEditParams]
readsPrec :: Int -> ReadS ApplyWorkspaceEditParams
$creadsPrec :: Int -> ReadS ApplyWorkspaceEditParams
Read, ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
(ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool)
-> (ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool)
-> Eq ApplyWorkspaceEditParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
$c/= :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
== :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
$c== :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
Eq)

deriveJSON lspOptions ''ApplyWorkspaceEditParams

data ApplyWorkspaceEditResponseBody =
  ApplyWorkspaceEditResponseBody
    { -- | Indicates whether the edit was applied or not.
      ApplyWorkspaceEditResponseBody -> Bool
_applied :: Bool
      -- | An optional textual description for why the edit was not applied.
      -- This may be used may be used by the server for diagnostic
      -- logging or to provide a suitable error for a request that
      -- triggered the edit.
    , ApplyWorkspaceEditResponseBody -> Maybe Text
_failureReason :: Maybe Text
    } deriving (Int -> ApplyWorkspaceEditResponseBody -> ShowS
[ApplyWorkspaceEditResponseBody] -> ShowS
ApplyWorkspaceEditResponseBody -> String
(Int -> ApplyWorkspaceEditResponseBody -> ShowS)
-> (ApplyWorkspaceEditResponseBody -> String)
-> ([ApplyWorkspaceEditResponseBody] -> ShowS)
-> Show ApplyWorkspaceEditResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyWorkspaceEditResponseBody] -> ShowS
$cshowList :: [ApplyWorkspaceEditResponseBody] -> ShowS
show :: ApplyWorkspaceEditResponseBody -> String
$cshow :: ApplyWorkspaceEditResponseBody -> String
showsPrec :: Int -> ApplyWorkspaceEditResponseBody -> ShowS
$cshowsPrec :: Int -> ApplyWorkspaceEditResponseBody -> ShowS
Show, ReadPrec [ApplyWorkspaceEditResponseBody]
ReadPrec ApplyWorkspaceEditResponseBody
Int -> ReadS ApplyWorkspaceEditResponseBody
ReadS [ApplyWorkspaceEditResponseBody]
(Int -> ReadS ApplyWorkspaceEditResponseBody)
-> ReadS [ApplyWorkspaceEditResponseBody]
-> ReadPrec ApplyWorkspaceEditResponseBody
-> ReadPrec [ApplyWorkspaceEditResponseBody]
-> Read ApplyWorkspaceEditResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyWorkspaceEditResponseBody]
$creadListPrec :: ReadPrec [ApplyWorkspaceEditResponseBody]
readPrec :: ReadPrec ApplyWorkspaceEditResponseBody
$creadPrec :: ReadPrec ApplyWorkspaceEditResponseBody
readList :: ReadS [ApplyWorkspaceEditResponseBody]
$creadList :: ReadS [ApplyWorkspaceEditResponseBody]
readsPrec :: Int -> ReadS ApplyWorkspaceEditResponseBody
$creadsPrec :: Int -> ReadS ApplyWorkspaceEditResponseBody
Read, ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
(ApplyWorkspaceEditResponseBody
 -> ApplyWorkspaceEditResponseBody -> Bool)
-> (ApplyWorkspaceEditResponseBody
    -> ApplyWorkspaceEditResponseBody -> Bool)
-> Eq ApplyWorkspaceEditResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
$c/= :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
== :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
$c== :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
Eq)

deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody

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

-- | Applies a 'TextEdit' to some 'Text'.
-- >>> applyTextEdit (TextEdit (Range (Position 0 1) (Position 0 2)) "i") "foo"
-- "fio"
applyTextEdit :: TextEdit -> Text -> Text
applyTextEdit :: TextEdit -> Text -> Text
applyTextEdit (TextEdit (Range Position
sp Position
ep) Text
newText) Text
oldText =
  let (Text
_, Text
afterEnd) = Position -> Text -> (Text, Text)
splitAtPos Position
ep Text
oldText
      (Text
beforeStart, Text
_) = Position -> Text -> (Text, Text)
splitAtPos Position
sp Text
oldText
    in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
beforeStart, Text
newText, Text
afterEnd]
  where
    splitAtPos :: Position -> Text -> (Text, Text)
    splitAtPos :: Position -> Text -> (Text, Text)
splitAtPos (Position Int
sl Int
sc) Text
t =
      -- If we are looking for a line beyond the end of the text, this will give us an index
      -- past the end. Fortunately, T.splitAt is fine with this, and just gives us the whole
      -- string and an empty string, which is what we want.
      let index :: Int
index = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Text -> Int
forall t. (Eq t, Num t) => t -> Text -> Int
startLineIndex Int
sl Text
t
        in Int -> Text -> (Text, Text)
T.splitAt Int
index Text
t

    -- The index of the first character of line 'line'
    startLineIndex :: t -> Text -> Int
startLineIndex t
0 Text
_ = Int
0
    startLineIndex t
line Text
t' =
      case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t' of
        Just Int
i -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t -> Text -> Int
startLineIndex (t
line t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Int -> Text -> Text
T.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t')
        -- i != 0, and there are no newlines, so this is a line beyond the end of the text.
        -- In this case give the "start index" as the end, so we will at least append the text.
        Maybe Int
Nothing -> Text -> Int
T.length Text
t'

-- | 'editTextEdit' @outer@ @inner@ applies @inner@ to the text inside @outer@.
editTextEdit :: TextEdit -> TextEdit -> TextEdit
editTextEdit :: TextEdit -> TextEdit -> TextEdit
editTextEdit (TextEdit Range
origRange Text
origText) TextEdit
innerEdit =
  let newText :: Text
newText = TextEdit -> Text -> Text
applyTextEdit TextEdit
innerEdit Text
origText
    in Range -> Text -> TextEdit
TextEdit Range
origRange Text
newText