-- | 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 = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Position, String) -> Maybe ((Position, Char), (Position, String))
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
initialPos, ) where
  f :: (Position, String) -> Maybe ((Position, Char), (Position, String))
f (Position
_, []) = forall a. Maybe a
Nothing
  f (p :: Position
p@(Position UInt
l UInt
_), Char
'\n' : String
rest) =
    forall a. a -> Maybe a
Just ((Position
p, Char
'\n'), (UInt -> UInt -> Position
Position (UInt
l 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) = forall a. a -> Maybe a
Just ((Position
p, Char
x), (UInt -> UInt -> Position
Position UInt
l (UInt
c 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 :: forall a.
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
_)) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
/= Position
_start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) PositionIndexed a
indexedString
  , (PositionIndexed a
mid, after :: PositionIndexed a
after@((Position, a)
_ : PositionIndexed a
_)) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
/= Position
_end) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) PositionIndexed a
rest
  = forall a. a -> Maybe a
Just (PositionIndexed a
before, PositionIndexed a
mid, PositionIndexed a
after)
  | Bool
otherwise
  = 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 :: forall a. Range -> PositionIndexed a -> Maybe (PositionIndexed a)
stripRange Range
r PositionIndexed a
s = case 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) -> forall a. a -> Maybe a
Just (PositionIndexed a
b forall a. [a] -> [a] -> [a]
++ PositionIndexed a
a)
  Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
Nothing        -> 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 forall a. Ord a => a -> a -> Bool
> Range -> Position
_end Range
r'   = [Range] -> [Range]
mergeRanges (Range
r forall a. a -> [a] -> [a]
: [Range]
rest)
  |
    -- r and r' are overlapping
    Range -> Position
_end Range
r 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' } forall a. a -> [a] -> [a]
: [Range]
rest)

  | Bool
otherwise          = Range
r forall a. a -> [a] -> [a]
: [Range] -> [Range]
mergeRanges (Range
r' 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionIndexedString -> [Range] -> [Range]
go PositionIndexedString
indexedString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' <- forall a. Range -> PositionIndexed a -> Maybe (PositionIndexed a)
stripRange Range
r' PositionIndexedString
input
    = Range
r' 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) <- forall a.
Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range
range PositionIndexedString
indexedString
  , PositionIndexedString
after' <- forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) PositionIndexedString
after
  , PositionIndexedString
before' <- forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (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'] ]
    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
_ <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) PositionIndexedString
rest
    ]
    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
_) <- forall a.
Range
-> PositionIndexed a
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
unconsRange Range
range PositionIndexedString
indexedString
  , Maybe Position
maybeFirstSpacePos <- PositionIndexedString -> Maybe Position
lastSpacePos forall a b. (a -> b) -> a -> b
$ 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 [] = forall a. Maybe a
Nothing
    lastSpacePos ((Position
pos, Char
c):PositionIndexedString
xs) =
      if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSpace Char
c
      then forall a. Maybe a
Nothing -- didn't find any space
      else case PositionIndexedString
xs of
              ((Position, Char)
y:PositionIndexedString
ys) | Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Position, Char)
y -> PositionIndexedString -> Maybe Position
lastSpacePos ((Position, Char)
yforall a. a -> [a] -> [a]
:PositionIndexedString
ys)
              PositionIndexedString
_                        -> forall a. a -> Maybe a
Just Position
pos