{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.LSP.Types.Location where

import           Control.DeepSeq
import           Data.Aeson.TH
import           Data.Hashable
import           GHC.Generics              hiding (UInt)
import           Language.LSP.Types.Common
import           Language.LSP.Types.Uri
import           Language.LSP.Types.Utils

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

-- | A position in a document. Note that the character offsets in a line
-- are given in UTF-16 code units, *not* Unicode code points.
data Position =
  Position
    { -- | Line position in a document (zero-based).
      Position -> UInt
_line      :: UInt
      -- | Character offset on a line in a document (zero-based). Assuming that
      -- the line is represented as a string, the @character@ value represents the
      -- gap between the @character@ and @character + 1@.
    , Position -> UInt
_character :: UInt
    } 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, ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read, 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, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord, forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic)

instance NFData Position
deriveJSON lspOptions ''Position

instance Hashable Position

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

data Range =
  Range
    { Range -> Position
_start :: Position -- ^ The range's start position. (inclusive)
    , Range -> Position
_end   :: Position -- ^ The range's end position. (exclusive, see: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#range )
    } 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, ReadPrec [Range]
ReadPrec Range
Int -> ReadS Range
ReadS [Range]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Range]
$creadListPrec :: ReadPrec [Range]
readPrec :: ReadPrec Range
$creadPrec :: ReadPrec Range
readList :: ReadS [Range]
$creadList :: ReadS [Range]
readsPrec :: Int -> ReadS Range
$creadsPrec :: Int -> ReadS Range
Read, 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, Eq Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
Ord, forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Range x -> Range
$cfrom :: forall x. Range -> Rep Range x
Generic)

instance NFData Range
deriveJSON lspOptions ''Range

instance Hashable Range

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

data Location =
  Location
    { Location -> Uri
_uri   :: Uri
    , Location -> Range
_range :: Range
    } deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Location]
$creadListPrec :: ReadPrec [Location]
readPrec :: ReadPrec Location
$creadPrec :: ReadPrec Location
readList :: ReadS [Location]
$creadList :: ReadS [Location]
readsPrec :: Int -> ReadS Location
$creadsPrec :: Int -> ReadS Location
Read, Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
Ord, forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic)

instance NFData Location
deriveJSON lspOptions ''Location

instance Hashable Location

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

-- | Represents a link between a source and a target location.
data LocationLink =
  LocationLink
  { -- | Span of the origin of this link.
    -- Used as the underlined span for mouse interaction. Defaults to the word
    -- range at the mouse position.
    LocationLink -> Maybe Range
_originSelectionRange :: Maybe Range
    -- | The target resource identifier of this link.
  , LocationLink -> Uri
_targetUri            :: Uri
    -- | The full target range of this link. If the target for example is a
    -- symbol then target range is the range enclosing this symbol not including
    -- leading/trailing whitespace but everything else like comments. This
    -- information is typically used to highlight the range in the editor.
  , LocationLink -> Range
_targetRange          :: Range
    -- | The range that should be selected and revealed when this link is being
    -- followed, e.g the name of a function. Must be contained by the the
    -- 'targetRange'. See also @DocumentSymbol._range@
  , LocationLink -> Range
_targetSelectionRange :: Range
  } deriving (ReadPrec [LocationLink]
ReadPrec LocationLink
Int -> ReadS LocationLink
ReadS [LocationLink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocationLink]
$creadListPrec :: ReadPrec [LocationLink]
readPrec :: ReadPrec LocationLink
$creadPrec :: ReadPrec LocationLink
readList :: ReadS [LocationLink]
$creadList :: ReadS [LocationLink]
readsPrec :: Int -> ReadS LocationLink
$creadsPrec :: Int -> ReadS LocationLink
Read, Int -> LocationLink -> ShowS
[LocationLink] -> ShowS
LocationLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationLink] -> ShowS
$cshowList :: [LocationLink] -> ShowS
show :: LocationLink -> String
$cshow :: LocationLink -> String
showsPrec :: Int -> LocationLink -> ShowS
$cshowsPrec :: Int -> LocationLink -> ShowS
Show, LocationLink -> LocationLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationLink -> LocationLink -> Bool
$c/= :: LocationLink -> LocationLink -> Bool
== :: LocationLink -> LocationLink -> Bool
$c== :: LocationLink -> LocationLink -> Bool
Eq)
deriveJSON lspOptions ''LocationLink

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

-- | A helper function for creating ranges.
-- prop> mkRange l c l' c' = Range (Position l c) (Position l' c')
mkRange :: UInt -> UInt -> UInt -> UInt -> Range
mkRange :: UInt -> UInt -> UInt -> UInt -> Range
mkRange UInt
l UInt
c UInt
l' UInt
c' = Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
l UInt
c) (UInt -> UInt -> Position
Position UInt
l' UInt
c')

-- | 'isSubrangeOf' returns true if for every 'Position' in the first 'Range', it's also in the second 'Range'.
isSubrangeOf :: Range -> Range -> Bool
isSubrangeOf :: Range -> Range -> Bool
isSubrangeOf Range
smallRange Range
range = Range -> Position
_start Range
smallRange forall a. Ord a => a -> a -> Bool
>= Range -> Position
_start Range
range Bool -> Bool -> Bool
&& Range -> Position
_end Range
smallRange forall a. Ord a => a -> a -> Bool
<= Range -> Position
_end Range
range

-- | 'positionInRange' returns true if the given 'Position' is in the 'Range'.
positionInRange :: Position -> Range -> Bool
positionInRange :: Position -> Range -> Bool
positionInRange Position
p (Range Position
sp Position
ep) = Position
sp forall a. Ord a => a -> a -> Bool
<= Position
p Bool -> Bool -> Bool
&& Position
p forall a. Ord a => a -> a -> Bool
< Position
ep -- Range's end position is exclusive.