-- | Position indexed streams of characters
module Development.IDE.Plugin.CodeAction.PositionIndexed
  ( PositionIndexed
  , PositionIndexedString
  , indexedByPosition
  , indexedByPositionStartingFrom
  , extendAllToIncludeCommaIfPossible
  , extendToIncludePreviousNewlineIfPossible
  , mergeRanges
  )
where

import           Data.Char
import           Data.List
import           Language.LSP.Types (Position (Position),
                                     Range (Range, _end, _start))

type PositionIndexed a = [(Position, a)]

type PositionIndexedString = PositionIndexed Char

-- | Add position indexing to a String.
--
--   > indexedByPositionStartingFrom (0,0) "hey\n ho" ≡
--   >   [ ((0,0),'h')
--   >   , ((0,1),'e')
--   >   , ((0,2),'y')
--   >   , ((0,3),'\n')
--   >   , ((1,0),' ')
--   >   , ((1,1),'h')
--   >   , ((1,2),'o')
--   >   ]
indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString
indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString
indexedByPositionStartingFrom Position
initialPos = ((Position, String)
 -> Maybe ((Position, Char), (Position, String)))
-> (Position, String) -> PositionIndexedString
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Position, String) -> Maybe ((Position, Char), (Position, String))
f ((Position, String) -> PositionIndexedString)
-> (String -> (Position, String))
-> String
-> PositionIndexedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
initialPos, ) where
  f :: (Position, String) -> Maybe ((Position, Char), (Position, String))
f (Position
_, []) = Maybe ((Position, Char), (Position, String))
forall a. Maybe a
Nothing
  f (p :: Position
p@(Position UInt
l UInt
_), Char
'\n' : String
rest) =
    ((Position, Char), (Position, String))
-> Maybe ((Position, Char), (Position, String))
forall a. a -> Maybe a
Just ((Position
p, Char
'\n'), (UInt -> UInt -> Position
Position (UInt
l UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) UInt
0, String
rest))
  f (p :: Position
p@(Position UInt
l UInt
c), Char
x : String
rest) = ((Position, Char), (Position, String))
-> Maybe ((Position, Char), (Position, String))
forall a. a -> Maybe a
Just ((Position
p, Char
x), (UInt -> UInt -> Position
Position UInt
l (UInt
c UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1), String
rest))

-- | Add position indexing to a String.
--
--   > indexedByPosition = indexedByPositionStartingFrom (Position 0 0)
indexedByPosition :: String -> PositionIndexedString
indexedByPosition :: String -> PositionIndexedString
indexedByPosition = Position -> String -> PositionIndexedString
indexedByPositionStartingFrom (UInt -> UInt -> Position
Position UInt
0 UInt
0)

-- | Returns a tuple (before, contents, after) if the range is present.
--   The range is present only if both its start and end positions are present
unconsRange
  :: Range
  -> PositionIndexed a
  -> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange :: Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range {Position
_end :: Position
_start :: Position
_start :: Range -> Position
_end :: Range -> Position
..} PositionIndexed a
indexedString
  | (PositionIndexed a
before, rest :: PositionIndexed a
rest@((Position, a)
_ : PositionIndexed a
_)) <- ((Position, a) -> Bool)
-> PositionIndexed a -> (PositionIndexed a, PositionIndexed a)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
/= Position
_start) (Position -> Bool)
-> ((Position, a) -> Position) -> (Position, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, a) -> Position
forall a b. (a, b) -> a
fst) PositionIndexed a
indexedString
  , (PositionIndexed a
mid, after :: PositionIndexed a
after@((Position, a)
_ : PositionIndexed a
_)) <- ((Position, a) -> Bool)
-> PositionIndexed a -> (PositionIndexed a, PositionIndexed a)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
/= Position
_end) (Position -> Bool)
-> ((Position, a) -> Position) -> (Position, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, a) -> Position
forall a b. (a, b) -> a
fst) PositionIndexed a
rest
  = (PositionIndexed a, PositionIndexed a, PositionIndexed a)
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
forall a. a -> Maybe a
Just (PositionIndexed a
before, PositionIndexed a
mid, PositionIndexed a
after)
  | Bool
otherwise
  = Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
forall a. Maybe a
Nothing

-- | Strips out all the positions included in the range.
--   Returns 'Nothing' if the start or end of the range are not included in the input.
stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)
stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)
stripRange Range
r PositionIndexed a
s = case Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
forall a.
Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range
r PositionIndexed a
s of
  Just (PositionIndexed a
b, PositionIndexed a
_, PositionIndexed a
a) -> PositionIndexed a -> Maybe (PositionIndexed a)
forall a. a -> Maybe a
Just (PositionIndexed a
b PositionIndexed a -> PositionIndexed a -> PositionIndexed a
forall a. [a] -> [a] -> [a]
++ PositionIndexed a
a)
  Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
Nothing        -> Maybe (PositionIndexed a)
forall a. Maybe a
Nothing

-- | Returns the smallest possible set of disjoint ranges that is equivalent to the input.
--   Assumes input ranges are sorted on the start positions.
mergeRanges :: [Range] -> [Range]
mergeRanges :: [Range] -> [Range]
mergeRanges (Range
r : Range
r' : [Range]
rest)
  |
    -- r' is contained in r
    Range -> Position
_end Range
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> Range -> Position
_end Range
r'   = [Range] -> [Range]
mergeRanges (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rest)
  |
    -- r and r' are overlapping
    Range -> Position
_end Range
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> Range -> Position
_start Range
r' = [Range] -> [Range]
mergeRanges (Range
r { _end :: Position
_end = Range -> Position
_end Range
r' } Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rest)

  | Bool
otherwise          = Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range] -> [Range]
mergeRanges (Range
r' Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rest)
mergeRanges [Range]
other = [Range]
other

-- | Returns a sorted list of ranges with extended selections including preceding or trailing commas
--
-- @
--   a, |b|,  c  ===> a|, b|,  c
--   a,  b,  |c| ===> a,  b|,  c|
--   a, |b|, |c| ===> a|, b||, c|
-- @
--
-- If 'acceptNoComma' is enabled, additional ranges are returned
--
-- @
--   |a|       ===> |a|
--   |a|,  |b| ===> |a,|  |b|
-- @
extendAllToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> [Range] -> [Range]
extendAllToIncludeCommaIfPossible Bool
acceptNoComma PositionIndexedString
indexedString =
  [Range] -> [Range]
mergeRanges ([Range] -> [Range]) -> ([Range] -> [Range]) -> [Range] -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionIndexedString -> [Range] -> [Range]
go PositionIndexedString
indexedString ([Range] -> [Range]) -> ([Range] -> [Range]) -> [Range] -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> Position) -> [Range] -> [Range]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Range -> Position
_start
 where
  go :: PositionIndexedString -> [Range] -> [Range]
go PositionIndexedString
_ [] = []
  go PositionIndexedString
input (Range
r : [Range]
rr)
    | Range
r' : [Range]
_ <- Bool -> PositionIndexedString -> Range -> [Range]
extendToIncludeCommaIfPossible Bool
acceptNoComma PositionIndexedString
input Range
r
    , Just PositionIndexedString
input' <- Range -> PositionIndexedString -> Maybe PositionIndexedString
forall a. Range -> PositionIndexed a -> Maybe (PositionIndexed a)
stripRange Range
r' PositionIndexedString
input
    = Range
r' Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: PositionIndexedString -> [Range] -> [Range]
go PositionIndexedString
input' [Range]
rr
    | Bool
otherwise
    = PositionIndexedString -> [Range] -> [Range]
go PositionIndexedString
input [Range]
rr

extendToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> Range -> [Range]
extendToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> Range -> [Range]
extendToIncludeCommaIfPossible Bool
acceptNoComma PositionIndexedString
indexedString Range
range
  | Just (PositionIndexedString
before, PositionIndexedString
_, PositionIndexedString
after) <- Range
-> PositionIndexedString
-> Maybe
     (PositionIndexedString, PositionIndexedString,
      PositionIndexedString)
forall a.
Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range
range PositionIndexedString
indexedString
  , PositionIndexedString
after' <- ((Position, Char) -> Bool)
-> PositionIndexedString -> PositionIndexedString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace (Char -> Bool)
-> ((Position, Char) -> Char) -> (Position, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Char) -> Char
forall a b. (a, b) -> b
snd) PositionIndexedString
after
  , PositionIndexedString
before' <- ((Position, Char) -> Bool)
-> PositionIndexedString -> PositionIndexedString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace (Char -> Bool)
-> ((Position, Char) -> Char) -> (Position, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Char) -> Char
forall a b. (a, b) -> b
snd) (PositionIndexedString -> PositionIndexedString
forall a. [a] -> [a]
reverse PositionIndexedString
before)
  =
    -- a, |b|, c ===> a|, b|, c
    [ Range
range { _start :: Position
_start = Position
start' } | (Position
start', Char
',') : PositionIndexedString
_ <- [PositionIndexedString
before'] ]
    [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++
    -- a, |b|, c ===> a, |b, |c
    [ Range
range { _end :: Position
_end = Position
end' }
    | (Position
_, Char
',') : PositionIndexedString
rest <- [PositionIndexedString
after']
    , (Position
end', Char
_) : PositionIndexedString
_ <- PositionIndexedString -> [PositionIndexedString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PositionIndexedString -> [PositionIndexedString])
-> PositionIndexedString -> [PositionIndexedString]
forall a b. (a -> b) -> a -> b
$ ((Position, Char) -> Bool)
-> PositionIndexedString -> PositionIndexedString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace (Char -> Bool)
-> ((Position, Char) -> Char) -> (Position, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Char) -> Char
forall a b. (a, b) -> b
snd) PositionIndexedString
rest
    ]
    [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++
    ([Range
range | Bool
acceptNoComma])
  | Bool
otherwise
  = [Range
range]

extendToIncludePreviousNewlineIfPossible :: PositionIndexedString -> Range -> Range
extendToIncludePreviousNewlineIfPossible :: PositionIndexedString -> Range -> Range
extendToIncludePreviousNewlineIfPossible PositionIndexedString
indexedString Range
range
  | Just (PositionIndexedString
before, PositionIndexedString
_, PositionIndexedString
_) <- Range
-> PositionIndexedString
-> Maybe
     (PositionIndexedString, PositionIndexedString,
      PositionIndexedString)
forall a.
Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range
range PositionIndexedString
indexedString
  , Maybe Position
maybeFirstSpacePos <- PositionIndexedString -> Maybe Position
lastSpacePos (PositionIndexedString -> Maybe Position)
-> PositionIndexedString -> Maybe Position
forall a b. (a -> b) -> a -> b
$ PositionIndexedString -> PositionIndexedString
forall a. [a] -> [a]
reverse PositionIndexedString
before
  = case Maybe Position
maybeFirstSpacePos of
      Maybe Position
Nothing  -> Range
range
      Just Position
pos -> Range
range { _start :: Position
_start = Position
pos }
  | Bool
otherwise = Range
range
  where
    lastSpacePos :: PositionIndexedString -> Maybe Position
    lastSpacePos :: PositionIndexedString -> Maybe Position
lastSpacePos [] = Maybe Position
forall a. Maybe a
Nothing
    lastSpacePos ((Position
pos, Char
c):PositionIndexedString
xs) =
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSpace Char
c
      then Maybe Position
forall a. Maybe a
Nothing -- didn't find any space
      else case PositionIndexedString
xs of
              ((Position, Char)
y:PositionIndexedString
ys) | Char -> Bool
isSpace (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Position, Char) -> Char
forall a b. (a, b) -> b
snd (Position, Char)
y -> PositionIndexedString -> Maybe Position
lastSpacePos ((Position, Char)
y(Position, Char) -> PositionIndexedString -> PositionIndexedString
forall a. a -> [a] -> [a]
:PositionIndexedString
ys)
              PositionIndexedString
_                        -> Position -> Maybe Position
forall a. a -> Maybe a
Just Position
pos