{-# OPTIONS_GHC -fno-warn-partial-fields #-}
{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}

module Data.Diff.Types where

import Data.Text


data Edit = EditDelete { Edit -> Int
deleteFrom :: Int
                       , Edit -> Int
deleteTo :: Int }
          | EditInsert { Edit -> Int
insertPos :: Int
                       , Edit -> Int
insertFrom :: Int
                       , Edit -> Int
insertTo :: Int }
  deriving (Int -> Edit -> ShowS
[Edit] -> ShowS
Edit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit] -> ShowS
$cshowList :: [Edit] -> ShowS
show :: Edit -> String
$cshow :: Edit -> String
showsPrec :: Int -> Edit -> ShowS
$cshowsPrec :: Int -> Edit -> ShowS
Show, Edit -> Edit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit -> Edit -> Bool
$c/= :: Edit -> Edit -> Bool
== :: Edit -> Edit -> Bool
$c== :: Edit -> Edit -> Bool
Eq)


-- * Types to mimic TextDocumentContentChangeEvent from the lsp-types package

data Position = Position { Position -> Int
positionLine :: Int
                         , Position -> Int
positionCh :: Int }
  deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Position -> Position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq)

data Range = Range { Range -> Position
rangeStart :: Position
                   , Range -> Position
rangeEnd :: Position }
  deriving (Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, Range -> Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq)

data ChangeEvent = ChangeEvent { ChangeEvent -> Range
range :: Range
                               , ChangeEvent -> Text
text :: Text }
  deriving (Int -> ChangeEvent -> ShowS
[ChangeEvent] -> ShowS
ChangeEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeEvent] -> ShowS
$cshowList :: [ChangeEvent] -> ShowS
show :: ChangeEvent -> String
$cshow :: ChangeEvent -> String
showsPrec :: Int -> ChangeEvent -> ShowS
$cshowsPrec :: Int -> ChangeEvent -> ShowS
Show, ChangeEvent -> ChangeEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeEvent -> ChangeEvent -> Bool
$c/= :: ChangeEvent -> ChangeEvent -> Bool
== :: ChangeEvent -> ChangeEvent -> Bool
$c== :: ChangeEvent -> ChangeEvent -> Bool
Eq)