{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE TemplateHaskell            #-}
module Language.Haskell.LSP.Types.WorkspaceEdit where

import           Data.Aeson.TH
import qualified Data.HashMap.Strict                        as H
-- For <= 8.2.2
import           Data.Monoid                                ((<>))
import           Data.Text                                  (Text)
import qualified Data.Text                                  as T
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.Uri

-- ---------------------------------------------------------------------
{-
TextEdit

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#textedit

A textual edit applicable to a text document.

interface TextEdit {
    /**
     * The range of the text document to be manipulated. To insert
     * text into a document create a range where start === end.
     */
    range: Range;

    /**
     * The string to be inserted. For delete operations use an
     * empty string.
     */
    newText: string;
}


-}

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

-- ---------------------------------------------------------------------
{-
VersionedTextDocumentIdentifier

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#versionedtextdocumentidentifier

    New: An identifier to denote a specific version of a text document.

interface VersionedTextDocumentIdentifier extends TextDocumentIdentifier {
    /**
	 * The version number of this document. If a versioned text document identifier
	 * is sent from the server to the client and the file is not open in the editor
	 * (the server has not received an open notification before) the server can send
	 * `null` to indicate that the version is known and the content on disk is the
	 * truth (as speced with document content ownership)
	 */
	version: number | null;
-}

type TextDocumentVersion = Maybe Int

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

deriveJSON lspOptions ''VersionedTextDocumentIdentifier

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

TextDocumentEdit
https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#new-textdocumentedit

If multiple TextEdits are applied to a text document, all text edits describe
changes made to the initial document version. Execution wise text edits should
applied from the bottom to the top of the text document. Overlapping text edits
are not supported.

export interface TextDocumentEdit {
        /**
         * The text document to change.
         */
        textDocument: VersionedTextDocumentIdentifier;

        /**
         * The edits to be applied.
         */
        edits: TextEdit[];
}

-}

data TextDocumentEdit =
  TextDocumentEdit
    { TextDocumentEdit -> VersionedTextDocumentIdentifier
_textDocument :: VersionedTextDocumentIdentifier
    , TextDocumentEdit -> List TextEdit
_edits        :: List TextEdit
    } 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

-- ---------------------------------------------------------------------
{-
Changed in 3.0
--------------

WorkspaceEdit

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#workspaceedit


Changed A workspace edit represents changes to many resources managed in the
workspace. The edit should either provide changes or documentChanges. If
documentChanges are present they are preferred over changes if the client can
handle versioned document edits.

export interface WorkspaceEdit {
        /**
         * Holds changes to existing resources.
         */
        changes?: { [uri: string]: TextEdit[]; };

        /**
         * An array of `TextDocumentEdit`s to express changes to specific a specific
         * version of a text document. Whether a client supports versioned document
         * edits is expressed via `WorkspaceClientCapabilities.versionedWorkspaceEdit`.
         */
        documentChanges?: TextDocumentEdit[];
}
-}

type WorkspaceEditMap = H.HashMap Uri (List TextEdit)

data WorkspaceEdit =
  WorkspaceEdit
    { WorkspaceEdit -> Maybe WorkspaceEditMap
_changes         :: Maybe WorkspaceEditMap
    , WorkspaceEdit -> Maybe (List TextDocumentEdit)
_documentChanges :: Maybe (List TextDocumentEdit)
    } 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 Monoid WorkspaceEdit where
  mempty :: WorkspaceEdit
mempty = Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing
  mappend :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
mappend (WorkspaceEdit Maybe WorkspaceEditMap
a Maybe (List TextDocumentEdit)
b) (WorkspaceEdit Maybe WorkspaceEditMap
c Maybe (List TextDocumentEdit)
d) = Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (Maybe WorkspaceEditMap
a Maybe WorkspaceEditMap
-> Maybe WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. Semigroup a => a -> a -> a
<> Maybe WorkspaceEditMap
c) (Maybe (List TextDocumentEdit)
b Maybe (List TextDocumentEdit)
-> Maybe (List TextDocumentEdit) -> Maybe (List TextDocumentEdit)
forall a. Semigroup a => a -> a -> a
<> Maybe (List TextDocumentEdit)
d)

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup WorkspaceEdit where
  <> :: WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
(<>) = WorkspaceEdit -> WorkspaceEdit -> WorkspaceEdit
forall a. Monoid a => a -> a -> a
mappend
#endif

deriveJSON lspOptions ''WorkspaceEdit

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

-- | 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 =
      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 -> TextDocumentVersion
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')
        TextDocumentVersion
Nothing -> Int
0

-- | '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