diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 2a5854d16a..72423db76b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -336,6 +336,7 @@ test-suite ghcide-tests , containers , data-default , directory + , enummapset , extra , filepath , fuzzy diff --git a/ghcide/src/Development/IDE/Core/PositionMapping.hs b/ghcide/src/Development/IDE/Core/PositionMapping.hs index 82d8334c87..d04856389c 100644 --- a/ghcide/src/Development/IDE/Core/PositionMapping.hs +++ b/ghcide/src/Development/IDE/Core/PositionMapping.hs @@ -10,7 +10,7 @@ module Development.IDE.Core.PositionMapping , fromCurrentPosition , toCurrentPosition , PositionDelta(..) - , addDelta + , addOldDelta , idDelta , composeDelta , mkDelta @@ -119,9 +119,13 @@ idDelta = PositionDelta pure pure mkDelta :: [TextDocumentContentChangeEvent] -> PositionDelta mkDelta cs = foldl' applyChange idDelta cs --- | Add a new delta onto a Mapping k n to make a Mapping (k - 1) n -addDelta :: PositionDelta -> PositionMapping -> PositionMapping -addDelta delta (PositionMapping pm) = PositionMapping (composeDelta delta pm) +-- | addOldDelta +-- Add a old delta onto a Mapping k n to make a Mapping (k - 1) n +addOldDelta :: + PositionDelta -- ^ delta from version k - 1 to version k + -> PositionMapping -- ^ The input mapping is from version k to version n + -> PositionMapping -- ^ The output mapping is from version k - 1 to version n +addOldDelta delta (PositionMapping pm) = PositionMapping (composeDelta pm delta) -- TODO: We currently ignore the right hand side (if there is only text), as -- that was what was done with lsp* 1.6 packages diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 80837a6668..fbe1ab1b8a 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -62,6 +62,7 @@ module Development.IDE.Core.Shake( FileVersion(..), Priority(..), updatePositionMapping, + updatePositionMappingHelper, deleteValue, recordDirtyKeys, WithProgressFunc, WithIndefiniteProgressFunc, ProgressEvent(..), @@ -266,7 +267,7 @@ data ShakeExtras = ShakeExtras -- ^ Map from a text document version to a PositionMapping that describes how to map -- positions in a version of that document to positions in the latest version -- First mapping is delta from previous version and second one is an - -- accumulation of all previous mappings. + -- accumulation to the current version. ,progress :: ProgressReporting ,ideTesting :: IdeTesting -- ^ Whether to enable additional lsp messages used by the test suite for checking invariants @@ -443,7 +444,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do `catch` (\(_ :: IOException) -> pure Nothing) atomicallyNamed "lastValueIO 2" $ do STM.focus (Focus.alter (alterValue $ Stale (Just del) actual_version (toDyn v))) (toKey k file) state - Just . (v,) . addDelta del <$> mappingForVersion positionMapping file actual_version + Just . (v,) . addOldDelta del <$> mappingForVersion positionMapping file actual_version -- We got a new stale value from the persistent rule, insert it in the map without affecting diagnostics alterValue new Nothing = Just (ValueWithDiagnostics new mempty) -- If it wasn't in the map, give it empty diagnostics @@ -459,7 +460,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do Succeeded ver (fromDynamic -> Just v) -> atomicallyNamed "lastValueIO 5" $ Just . (v,) <$> mappingForVersion positionMapping file ver Stale del ver (fromDynamic -> Just v) -> - atomicallyNamed "lastValueIO 6" $ Just . (v,) . maybe id addDelta del <$> mappingForVersion positionMapping file ver + atomicallyNamed "lastValueIO 6" $ Just . (v,) . maybe id addOldDelta del <$> mappingForVersion positionMapping file ver Failed p | not p -> readPersistent _ -> pure Nothing @@ -1352,12 +1353,18 @@ updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} Versi STM.focus (Focus.alter f) uri positionMapping where uri = toNormalizedUri _uri - f = Just . f' . fromMaybe mempty - f' mappingForUri = snd $ - -- Very important to use mapAccum here so that the tails of - -- each mapping can be shared, otherwise quadratic space is - -- used which is evident in long running sessions. - EM.mapAccumRWithKey (\acc _k (delta, _) -> let new = addDelta delta acc in (new, (delta, acc))) - zeroMapping - (EM.insert _version (shared_change, zeroMapping) mappingForUri) - shared_change = mkDelta changes + f = Just . updatePositionMappingHelper _version changes . fromMaybe mempty + + +updatePositionMappingHelper :: + Int32 + -> [TextDocumentContentChangeEvent] + -> EnumMap Int32 (PositionDelta, PositionMapping) + -> EnumMap Int32 (PositionDelta, PositionMapping) +updatePositionMappingHelper ver changes mappingForUri = snd $ + -- Very important to use mapAccum here so that the tails of + -- each mapping can be shared, otherwise quadratic space is + -- used which is evident in long running sessions. + EM.mapAccumRWithKey (\acc _k (delta, _) -> let new = addOldDelta delta acc in (new, (delta, acc))) + zeroMapping + (EM.insert ver (mkDelta changes, zeroMapping) mappingForUri) diff --git a/ghcide/test/exe/PositionMappingTests.hs b/ghcide/test/exe/PositionMappingTests.hs index 083e765db0..8ffbdfd4c1 100644 --- a/ghcide/test/exe/PositionMappingTests.hs +++ b/ghcide/test/exe/PositionMappingTests.hs @@ -3,6 +3,7 @@ module PositionMappingTests (tests) where +import qualified Data.EnumMap.Strict as EM import Data.Row import qualified Data.Text as T import Data.Text.Utf16.Rope (Rope) @@ -10,7 +11,8 @@ import qualified Data.Text.Utf16.Rope as Rope import Development.IDE.Core.PositionMapping (PositionResult (..), fromCurrent, positionResultToMaybe, - toCurrent) + toCurrent, + toCurrentPosition) import Development.IDE.Types.Location import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..), @@ -20,15 +22,36 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.VFS (applyChange) import Test.QuickCheck -- import Test.QuickCheck.Instances () +import Control.Arrow (second) import Data.Functor.Identity (runIdentity) +import Data.Text (Text) +import Development.IDE.Core.Shake (updatePositionMappingHelper) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +enumMapMappingTest :: TestTree +enumMapMappingTest = testCase "enumMapMappingTest" $ do + let mkChangeEvent :: Range -> Text -> TextDocumentContentChangeEvent + mkChangeEvent r t = TextDocumentContentChangeEvent $ InL $ #range .== r .+ #rangeLength .== Nothing .+ #text .== t + mkCE :: UInt -> UInt -> UInt -> UInt -> Text -> TextDocumentContentChangeEvent + mkCE l1 c1 l2 c2 = mkChangeEvent (Range (Position l1 c1) (Position l2 c2)) + events :: [(Int32, [TextDocumentContentChangeEvent])] + events = map (second return) [(0, mkCE 0 0 0 0 ""), (1, mkCE 0 1 0 1 " "), (2, mkCE 0 2 0 2 " "), (3, mkCE 0 3 0 3 " "), (4, mkCE 0 4 0 4 " "), (5, mkCE 0 5 0 5 " ")] + finalMap = Prelude.foldl (\m (i, e) -> updatePositionMappingHelper i e m) mempty events + let updatePose fromPos = do + mapping <- snd <$> EM.lookup 0 finalMap + toCurrentPosition mapping fromPos + updatePose (Position 0 4) @?= Just (Position 0 9) + updatePose (Position 0 5) @?= Just (Position 0 10) + + tests :: TestTree tests = testGroup "position mapping" - [ testGroup "toCurrent" + [ + enumMapMappingTest + , testGroup "toCurrent" [ testCase "before" $ toCurrent (Range (Position 0 1) (Position 0 3))