{-# LANGUAGE OverloadedStrings #-}
module Ide.PluginUtils where

import qualified Data.Text as T
import           Data.Maybe
import           Data.Algorithm.DiffOutput
import           Data.Algorithm.Diff
import qualified Data.HashMap.Strict as H
import           Language.Haskell.LSP.Types.Capabilities
import qualified Language.Haskell.LSP.Types            as J
import           Language.Haskell.LSP.Types

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

-- | Extend to the line below and above to replace newline character.
normalize :: Range -> Range
normalize :: Range -> Range
normalize (Range (Position Int
sl Int
_) (Position Int
el Int
_)) =
  Position -> Position -> Range
Range (Int -> Int -> Position
Position Int
sl Int
0) (Int -> Int -> Position
Position (Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0)

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

data WithDeletions = IncludeDeletions | SkipDeletions
  deriving WithDeletions -> WithDeletions -> Bool
(WithDeletions -> WithDeletions -> Bool)
-> (WithDeletions -> WithDeletions -> Bool) -> Eq WithDeletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithDeletions -> WithDeletions -> Bool
$c/= :: WithDeletions -> WithDeletions -> Bool
== :: WithDeletions -> WithDeletions -> Bool
$c== :: WithDeletions -> WithDeletions -> Bool
Eq

-- | Generate a 'WorkspaceEdit' value from a pair of source Text
diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText :: ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
clientCaps (Uri, Text)
old Text
new WithDeletions
withDeletions =
  let
    supports :: Bool
supports = ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
clientCaps
  in Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri, Text)
old Text
new WithDeletions
withDeletions

makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit
makeDiffTextEdit :: Text -> Text -> List TextEdit
makeDiffTextEdit Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
IncludeDeletions

makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit
makeDiffTextEditAdditive :: Text -> Text -> List TextEdit
makeDiffTextEditAdditive Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
SkipDeletions

diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit
diffTextEdit :: Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions = [TextEdit] -> List TextEdit
forall a. [a] -> List a
J.List [TextEdit]
r
  where
    r :: [TextEdit]
r = (DiffOperation LineRange -> TextEdit)
-> [DiffOperation LineRange] -> [TextEdit]
forall a b. (a -> b) -> [a] -> [b]
map DiffOperation LineRange -> TextEdit
diffOperationToTextEdit [DiffOperation LineRange]
diffOps
    d :: [Diff [String]]
d = [String] -> [String] -> [Diff [String]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fText) (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
f2Text)

    diffOps :: [DiffOperation LineRange]
diffOps = (DiffOperation LineRange -> Bool)
-> [DiffOperation LineRange] -> [DiffOperation LineRange]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DiffOperation LineRange
x -> (WithDeletions
withDeletions WithDeletions -> WithDeletions -> Bool
forall a. Eq a => a -> a -> Bool
== WithDeletions
IncludeDeletions) Bool -> Bool -> Bool
|| Bool -> Bool
not (DiffOperation LineRange -> Bool
forall a. DiffOperation a -> Bool
isDeletion DiffOperation LineRange
x))
                     ([Diff [String]] -> [DiffOperation LineRange]
diffToLineRanges [Diff [String]]
d)

    isDeletion :: DiffOperation a -> Bool
isDeletion (Deletion a
_ Int
_) = Bool
True
    isDeletion DiffOperation a
_ = Bool
False


    diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit
    diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit
diffOperationToTextEdit (Change LineRange
fm LineRange
to) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
      where
        range :: Range
range = LineRange -> Range
calcRange LineRange
fm
        nt :: Text
nt = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
to

    {-
      In order to replace everything including newline characters,
      the end range should extend below the last line. From the specification:
      "If you want to specify a range that contains a line including
      the line ending character(s) then use an end position denoting
      the start of the next line"
    -}
    diffOperationToTextEdit (Deletion (LineRange (Int
sl, Int
el) [String]
_) Int
_) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
""
      where
        range :: Range
range = Position -> Position -> Range
J.Range (Int -> Int -> Position
J.Position (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0)
                        (Int -> Int -> Position
J.Position Int
el Int
0)

    diffOperationToTextEdit (Addition LineRange
fm Int
l) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
    -- fm has a range wrt to the changed file, which starts in the current file at l + 1
    -- So the range has to be shifted to start at l + 1
      where
        range :: Range
range = Position -> Position -> Range
J.Range (Int -> Int -> Position
J.Position Int
l Int
0)
                        (Int -> Int -> Position
J.Position Int
l Int
0)
        nt :: Text
nt = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm


    calcRange :: LineRange -> Range
calcRange LineRange
fm = Position -> Position -> Range
J.Range Position
s Position
e
      where
        sl :: Int
sl = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
        sc :: Int
sc = Int
0
        s :: Position
s = Int -> Int -> Position
J.Position (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
sc -- Note: zero-based lines
        el :: Int
el = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
        ec :: Int
ec = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
last ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm
        e :: Position
e = Int -> Int -> Position
J.Position (Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
ec  -- Note: zero-based lines


-- | A pure version of 'diffText' for testing
diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText' :: Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri
f,Text
fText) Text
f2Text WithDeletions
withDeletions  =
  if Bool
supports
    then Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing (List TextDocumentEdit -> Maybe (List TextDocumentEdit)
forall a. a -> Maybe a
Just List TextDocumentEdit
docChanges)
    else Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
h) Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing
  where
    diff :: List TextEdit
diff = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions
    h :: WorkspaceEditMap
h = Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Uri
f List TextEdit
diff
    docChanges :: List TextDocumentEdit
docChanges = [TextDocumentEdit] -> List TextDocumentEdit
forall a. [a] -> List a
J.List [TextDocumentEdit
docEdit]
    docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List TextEdit -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
f (Int -> TextDocumentVersion
forall a. a -> Maybe a
Just Int
0)) List TextEdit
diff

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

clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
caps =
  let ClientCapabilities Maybe WorkspaceClientCapabilities
mwCaps Maybe TextDocumentClientCapabilities
_ Maybe WindowClientCapabilities
_ Maybe Object
_ = ClientCapabilities
caps
      supports :: Maybe Bool
supports = do
        WorkspaceClientCapabilities
wCaps <- Maybe WorkspaceClientCapabilities
mwCaps
        WorkspaceEditClientCapabilities Maybe Bool
mDc <- WorkspaceClientCapabilities
-> Maybe WorkspaceEditClientCapabilities
_workspaceEdit WorkspaceClientCapabilities
wCaps
        Maybe Bool
mDc
  in
    Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
supports