{-# 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
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]
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
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
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]
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
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
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]
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
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
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
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
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
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ChangeAnnotationIdentifier]
$cfromJSONKeyList :: FromJSONKeyFunction [ChangeAnnotationIdentifier]
fromJSONKey :: FromJSONKeyFunction ChangeAnnotationIdentifier
$cfromJSONKey :: FromJSONKeyFunction ChangeAnnotationIdentifier
FromJSONKey, Eq ChangeAnnotationIdentifier
Int -> ChangeAnnotationIdentifier -> Int
ChangeAnnotationIdentifier -> Int
forall a. Eq 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
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]
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
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
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]
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
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
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]
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
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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
        [ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"kind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"create" :: Text)
        , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Uri
_uri
        , (Key
"options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CreateFileOptions
_options
        , (Key
"annotationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON CreateFile where
    parseJSON :: Value -> Parser CreateFile
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateFile" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind forall a. Eq a => a -> a -> Bool
== (Text
"create" :: Text)) 
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"create\" but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
kind
        Uri
_uri <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
        Maybe CreateFileOptions
_options <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotationId"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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]
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
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
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]
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
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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
        [ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"kind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"rename" :: Text)
        , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"oldUri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Uri
_oldUri
        , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"newUri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Uri
_newUri
        , (Key
"options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RenameFileOptions
_options
        , (Key
"annotationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON RenameFile where
    parseJSON :: Value -> Parser RenameFile
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RenameFile" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind forall a. Eq a => a -> a -> Bool
== (Text
"rename" :: Text)) 
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"rename\" but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
kind
        Uri
_oldUri <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"oldUri"
        Uri
_newUri <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"newUri"
        Maybe RenameFileOptions
_options <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotationId"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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]
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
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
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]
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
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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
        [ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"kind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"delete" :: Text)
        , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
"uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Uri
_uri
        , (Key
"options" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DeleteFileOptions
_options
        , (Key
"annotationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChangeAnnotationIdentifier
_annotationId
        ]

instance FromJSON DeleteFile where
    parseJSON :: Value -> Parser DeleteFile
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DeleteFile" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
kind <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
kind forall a. Eq a => a -> a -> Bool
== (Text
"delete" :: Text)) 
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected kind \"delete\" but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
kind
        Uri
_uri <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
        Maybe DeleteFileOptions
_options <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
        Maybe ChangeAnnotationIdentifier
_annotationId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotationId"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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]
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
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 forall a. Semigroup a => a -> a -> a
<> Maybe WorkspaceEditMap
a') (Maybe (List DocumentChange)
b forall a. Semigroup a => a -> a -> a
<> Maybe (List DocumentChange)
b') (Maybe ChangeAnnotationMap
c 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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]
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
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
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") = forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationCreate
  parseJSON (String Text
"rename") = forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationRename
  parseJSON (String Text
"delete") = forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceOperationKind
ResourceOperationDelete
  parseJSON Value
_                 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ResourceOperationKind"

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]
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
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
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")                 = forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingAbort
  parseJSON (String Text
"transactional")         = forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingTransactional
  parseJSON (String Text
"textOnlyTransactional") = forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingTextOnlyTransactional
  parseJSON (String Text
"undo")                  = forall (f :: * -> *) a. Applicative f => a -> f a
pure FailureHandlingKind
FailureHandlingUndo
  parseJSON Value
_                                = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FailureHandlingKind"

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
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]
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
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
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]
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
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
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]
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
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
      -- | Depending on the client's failure handling strategy `failedChange`
      -- might contain the index of the change that failed. This property is
      -- only available if the client signals a `failureHandling` strategy
      -- in its client capabilities.
    , ApplyWorkspaceEditResponseBody -> Maybe UInt
_failedChange :: Maybe UInt
    } deriving (Int -> ApplyWorkspaceEditResponseBody -> ShowS
[ApplyWorkspaceEditResponseBody] -> ShowS
ApplyWorkspaceEditResponseBody -> String
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]
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
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 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 UInt
sl UInt
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 :: UInt
index = UInt
sc forall a. Num a => a -> a -> a
+ UInt -> Text -> UInt
startLineIndex UInt
sl Text
t
        in Int -> Text -> (Text, Text)
T.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
index) Text
t

    -- The index of the first character of line 'line'
    startLineIndex :: UInt -> Text -> UInt
    startLineIndex :: UInt -> Text -> UInt
startLineIndex UInt
0 Text
_ = UInt
0
    startLineIndex UInt
line Text
t' =
      case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t' of
        Just Int
i -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
+ UInt
1 forall a. Num a => a -> a -> a
+ UInt -> Text -> UInt
startLineIndex (UInt
line forall a. Num a => a -> a -> a
- UInt
1) (Int -> Text -> Text
T.drop (Int
i 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 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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