@@ -0,0 +1,112 @@
1+-- | Position indexed streams of characters
2+module Development.IDE.Plugin.CodeAction.PositionIndexed
3+ ( PositionIndexed
4+ , PositionIndexedString
5+ , indexedByPosition
6+ , indexedByPositionStartingFrom
7+ , extendAllToIncludeCommaIfPossible
8+ , mergeRanges
9+ )
10+where
11+
12+import Data.Char
13+import Data.List
14+import Language.Haskell.LSP.Types
15+
16+type PositionIndexed a = [(Position, a)]
17+
18+type PositionIndexedString = PositionIndexed Char
19+
20+-- | Add position indexing to a String.
21+--
22+-- > indexedByPositionStartingFrom (0,0) "hey\n ho" ≡
23+-- > [ ((0,0),'h')
24+-- > , ((0,1),'e')
25+-- > , ((0,2),'y')
26+-- > , ((0,3),'\n')
27+-- > , ((1,0),' ')
28+-- > , ((1,1),'h')
29+-- > , ((1,2),'o')
30+-- > ]
31+indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString
32+indexedByPositionStartingFrom initialPos = unfoldr f . (initialPos, ) where
33+ f (_, []) = Nothing
34+ f (p@(Position l _), '\n' : rest) =
35+ Just ((p, '\n'), (Position (l + 1) 0, rest))
36+ f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c + 1), rest))
37+
38+-- | Add position indexing to a String.
39+--
40+-- > indexedByPosition = indexedByPositionStartingFrom (Position 0 0)
41+indexedByPosition :: String -> PositionIndexedString
42+indexedByPosition = indexedByPositionStartingFrom (Position 0 0)
43+
44+-- | Returns a tuple (before, contents, after) if the range is present.
45+-- The range is present only if both its start and end positions are present
46+unconsRange
47+ :: Range
48+ -> PositionIndexed a
49+ -> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
50+unconsRange Range {..} indexedString
51+ | (before, rest@(_ : _)) <- span ((/= _start) . fst) indexedString
52+ , (mid, after@(_ : _)) <- span ((/= _end) . fst) rest
53+ = Just (before, mid, after)
54+ | otherwise
55+ = Nothing
56+
57+-- | Strips out all the positions included in the range.
58+-- Returns 'Nothing' if the start or end of the range are not included in the input.
59+stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)
60+stripRange r s = case unconsRange r s of
61+ Just (b, _, a) -> Just (b ++ a)
62+ Nothing -> Nothing
63+
64+-- | Returns the smallest possible set of disjoint ranges that is equivalent to the input.
65+-- Assumes input ranges are sorted on the start positions.
66+mergeRanges :: [Range] -> [Range]
67+mergeRanges (r : r' : rest)
68+ |
69+ -- r' is contained in r
70+ _end r > _end r' = mergeRanges (r : rest)
71+ |
72+ -- r and r' are overlapping
73+ _end r > _start r' = mergeRanges (r { _end = _end r' } : rest)
74+
75+ | otherwise = r : mergeRanges (r' : rest)
76+mergeRanges other = other
77+
78+-- | Returns a sorted list of ranges with extended selections including preceding or trailing commas
79+--
80+-- @
81+-- a, |b|, c ===> a|, b|, c
82+-- a, b, |c| ===> a, b|, c|
83+-- a, |b|, |c| ===> a|, b||, c|
84+-- @
85+extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]
86+extendAllToIncludeCommaIfPossible indexedString =
87+ mergeRanges . go indexedString . sortOn _start
88+ where
89+ go _ [] = []
90+ go input (r : rr)
91+ | r' : _ <- extendToIncludeCommaIfPossible input r
92+ , Just input' <- stripRange r' input
93+ = r' : go input' rr
94+ | otherwise
95+ = go input rr
96+
97+extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]
98+extendToIncludeCommaIfPossible indexedString range
99+ | Just (before, _, after) <- unconsRange range indexedString
100+ , after' <- dropWhile (isSpace . snd) after
101+ , before' <- dropWhile (isSpace . snd) (reverse before)
102+ =
103+ -- a, |b|, c ===> a|, b|, c
104+ [ range { _start = start' } | (start', ',') : _ <- [before'] ]
105+ ++
106+ -- a, |b|, c ===> a, |b, |c
107+ [ range { _end = end' }
108+ | (_, ',') : rest <- [after']
109+ , let (end', _) : _ = dropWhile (isSpace . snd) rest
110+ ]
111+ | otherwise
112+ = [range]