module Development.IDE.Core.PositionMapping
( PositionMapping(..)
, fromCurrentPosition
, toCurrentPosition
, PositionDelta(..)
, addDelta
, mkDelta
, toCurrentRange
, fromCurrentRange
, applyChange
, zeroMapping
, toCurrent
, fromCurrent
) where
import Control.Monad
import qualified Data.Text as T
import Language.Haskell.LSP.Types
import Data.List
data PositionDelta = PositionDelta
{ toDelta :: !(Position -> Maybe Position)
, fromDelta :: !(Position -> Maybe Position)
}
fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
fromCurrentPosition (PositionMapping pm) = fromDelta pm
toCurrentPosition :: PositionMapping -> Position -> Maybe Position
toCurrentPosition (PositionMapping pm) = toDelta pm
newtype PositionMapping = PositionMapping PositionDelta
toCurrentRange :: PositionMapping -> Range -> Maybe Range
toCurrentRange mapping (Range a b) =
Range <$> toCurrentPosition mapping a <*> toCurrentPosition mapping b
fromCurrentRange :: PositionMapping -> Range -> Maybe Range
fromCurrentRange mapping (Range a b) =
Range <$> fromCurrentPosition mapping a <*> fromCurrentPosition mapping b
zeroMapping :: PositionMapping
zeroMapping = PositionMapping idDelta
composeDelta :: PositionDelta
-> PositionDelta
-> PositionDelta
composeDelta (PositionDelta to1 from1) (PositionDelta to2 from2) =
PositionDelta (to1 <=< to2)
(from1 >=> from2)
idDelta :: PositionDelta
idDelta = PositionDelta Just Just
mkDelta :: [TextDocumentContentChangeEvent] -> PositionDelta
mkDelta cs = foldl' applyChange idDelta cs
addDelta :: PositionDelta -> PositionMapping -> PositionMapping
addDelta delta (PositionMapping pm) = PositionMapping (composeDelta delta pm)
applyChange :: PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
applyChange PositionDelta{..} (TextDocumentContentChangeEvent (Just r) _ t) = PositionDelta
{ toDelta = toCurrent r t <=< toDelta
, fromDelta = fromDelta <=< fromCurrent r t
}
applyChange posMapping _ = posMapping
toCurrent :: Range -> T.Text -> Position -> Maybe Position
toCurrent (Range (Position startLine startColumn) (Position endLine endColumn)) t (Position line column)
| line < startLine || line == startLine && column < startColumn =
Just $ Position line column
| line > endLine || line == endLine && column >= endColumn =
Just $ Position (line + lineDiff) newColumn
| otherwise = Nothing
where
lineDiff = linesNew - linesOld
linesNew = T.count "\n" t
linesOld = endLine - startLine
newEndColumn
| linesNew == 0 = startColumn + T.length t
| otherwise = T.length $ T.takeWhileEnd (/= '\n') t
newColumn
| line == endLine = column + newEndColumn - endColumn
| otherwise = column
fromCurrent :: Range -> T.Text -> Position -> Maybe Position
fromCurrent (Range (Position startLine startColumn) (Position endLine endColumn)) t (Position line column)
| line < startLine || line == startLine && column < startColumn =
Just $ Position line column
| line > newEndLine || line == newEndLine && column >= newEndColumn =
Just $ Position (line - lineDiff) newColumn
| otherwise = Nothing
where
lineDiff = linesNew - linesOld
linesNew = T.count "\n" t
linesOld = endLine - startLine
newEndLine = endLine + lineDiff
newEndColumn
| linesNew == 0 = startColumn + T.length t
| otherwise = T.length $ T.takeWhileEnd (/= '\n') t
newColumn
| line == newEndLine = column - (newEndColumn - endColumn)
| otherwise = column