fix position mapping for persistent

Author: wz1000

cabal.project

@@ -12,6 +12,7 @@ packages:
          ./plugins/hls-hlint-plugin
          ./plugins/hls-retrie-plugin
          ./plugins/hls-splice-plugin
+         /home/zubin/hiedb/
 
 tests: true
 

ghcide/src/Development/IDE/Core/PositionMapping.hs

@@ -10,12 +10,13 @@ module Development.IDE.Core.PositionMapping
   , toCurrentPosition
   , PositionDelta(..)
   , addDelta
+  , idDelta
   , mkDelta
   , toCurrentRange
   , fromCurrentRange
   , applyChange
   , zeroMapping
-  , mappingFromDiff
+  , deltaFromDiff
   -- toCurrent and fromCurrent are mainly exposed for testing
   , toCurrent
   , fromCurrent
@@ -28,6 +29,8 @@ import Data.List
 import Data.Algorithm.Diff
 import Data.Maybe
 import Data.Bifunctor
+import Control.DeepSeq
+import Debug.Trace
 
 -- | Either an exact position, or the range of text that was substituted
 data PositionResult a
@@ -68,6 +71,12 @@ data PositionDelta = PositionDelta
   , fromDelta :: !(Position -> PositionResult Position)
   }
 
+instance Show PositionDelta where
+  show PositionDelta{} = "PositionDelta{..}"
+
+instance NFData PositionDelta where
+  rnf (PositionDelta a b) = a `seq` b `seq` ()
+
 fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
 fromCurrentPosition (PositionMapping pm) = positionResultToMaybe . fromDelta pm
 
@@ -163,8 +172,8 @@ fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine
           | otherwise = column
         newLine = line - lineDiff
 
-mappingFromDiff :: T.Text -> T.Text -> PositionMapping
-mappingFromDiff (T.lines -> old) (T.lines -> new) = PositionMapping (PositionDelta (lookupPos lnew old2new) (lookupPos lold new2old))
+deltaFromDiff :: T.Text -> T.Text -> PositionDelta
+deltaFromDiff (T.lines -> old) (T.lines -> new) = PositionDelta (lookupPos lnew old2new) (lookupPos lold new2old)
   where
     diff = getDiff old new
 
@@ -174,7 +183,7 @@ mappingFromDiff (T.lines -> old) (T.lines -> new) = PositionMapping (PositionDel
     lold = length old
 
     lookupPos :: Int -> [(Int,Maybe Int)] -> Position -> PositionResult Position
-    lookupPos maxNew xs (Position line col) = go (-1) xs
+    lookupPos maxNew xs (Position line col) = (\x -> traceShow ("lookupPos",line,x) x) $ go (-1) xs
       where
         go prev [] = PositionRange (Position (prev+1) 0) (Position maxNew 0)
         go prev ((l,b):xs)

ghcide/src/Development/IDE/Core/Rules.hs

@@ -102,6 +102,9 @@ import Module
 import qualified Data.Rope.UTF16 as Rope
 import GHC.IO.Encoding
 import Data.ByteString.Encoding as T
+import Debug.Trace
+import Outputable (showSDocUnsafe)
+import HieDebug
 
 import qualified HieDb
 
@@ -149,10 +152,12 @@ getAtPoint file pos = runMaybeT $ do
   ide <- ask
   opts <- liftIO $ getIdeOptionsIO ide
 
-  (hf, mapping) <- useE GetHieAst file
+  (hf@HAR{hieAst = asts}, mapping) <- useE GetHieAst file
   dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)
 
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
+  traceShowM ("Got pos",pos',"in original file")
+  -- traceM (showSDocUnsafe $ ppHies asts)
   MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos'
 
 toCurrentLocations :: PositionMapping -> [Location] -> [Location]
@@ -518,15 +523,15 @@ persistentHieFileRule :: Rules ()
 persistentHieFileRule = addPersistentRule GetHieAst $ \file -> runMaybeT $ do
   res <- readHieFileForSrcFromDisk file
   vfs <- asks vfs
-  currentSource <- liftIO $ do
+  (currentSource,ver) <- liftIO $ do
     mvf <- getVirtualFile vfs $ filePathToUri' file
     case mvf of
-      Nothing -> T.readFile $ fromNormalizedFilePath file
-      Just vf -> pure $ Rope.toText $ _text vf
+      Nothing -> (,Nothing) <$> T.readFile (fromNormalizedFilePath file)
+      Just vf -> pure $ (Rope.toText $ _text vf, Just $ _lsp_version vf)
   encoding <- liftIO $ getLocaleEncoding
   let refmap = generateReferencesMap . getAsts . hie_asts $ res
-      mapping = mappingFromDiff (T.decode encoding $ hie_hs_src res) currentSource
-  pure $ (HAR (hie_module res) (hie_asts res) refmap (HieFromDisk res),mapping)
+      del = deltaFromDiff (T.decode encoding $ hie_hs_src res) currentSource
+  pure $ (HAR (hie_module res) (hie_asts res) refmap (HieFromDisk res),del,ver)
 
 getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
 getHieAstRuleDefinition f hsc tmr = do
@@ -554,7 +559,7 @@ getImportMapRule = define $ \GetImportMap f -> do
 
 -- | Ensure that go to definition doesn't block on startup
 persistentImportMapRule :: Rules ()
-persistentImportMapRule = addPersistentRule GetImportMap $ \_ -> pure $ Just (ImportMap mempty, zeroMapping)
+persistentImportMapRule = addPersistentRule GetImportMap $ \_ -> pure $ Just (ImportMap mempty, idDelta, Nothing)
 
 getBindingsRule :: Rules ()
 getBindingsRule =
@@ -588,7 +593,7 @@ getDocMapRule =
 
 -- | Persistent rule to ensure that hover doesn't block on startup
 persistentDocMapRule :: Rules ()
-persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, zeroMapping)
+persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing)
 
 readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction HieFile
 readHieFileForSrcFromDisk file = do

ghcide/src/Development/IDE/Core/Service.hs

@@ -21,7 +21,7 @@ module Development.IDE.Core.Service(
 import Data.Maybe
 import Development.IDE.Types.Options (IdeOptions(..))
 import Development.IDE.Core.Debouncer
-import           Development.IDE.Core.FileStore  (VFSHandle, fileStoreRules)
+import           Development.IDE.Core.FileStore  (fileStoreRules)
 import           Development.IDE.Core.FileExists (fileExistsRules)
 import           Development.IDE.Core.OfInterest
 import Development.IDE.Types.Logger as Logger

ghcide/src/Development/IDE/Core/Shake.hs

@@ -135,6 +135,7 @@ import OpenTelemetry.Eventlog
 import GHC.Fingerprint
 
 import HieDb.Types
+import Debug.Trace
 
 -- | We need to serialize writes to the database, so we send any function that
 -- needs to write to the database over the channel, where it will be picked up by
@@ -207,7 +208,7 @@ data ProgressEvent
     = KickStarted
     | KickCompleted
 
-type GetStalePersistent = NormalizedFilePath -> IdeAction (Maybe (Dynamic,PositionMapping))
+type GetStalePersistent = NormalizedFilePath -> IdeAction (Maybe (Dynamic,PositionDelta,TextDocumentVersion))
 
 getShakeExtras :: Action ShakeExtras
 getShakeExtras = do
@@ -223,11 +224,11 @@ getShakeExtrasRules = do
 -- This is called when we don't already have a result, or computing the rule failed.
 -- The result of this function will always be marked as 'stale', and a 'proper' rebuild of the rule will
 -- be queued if the rule hasn't run before.
-addPersistentRule :: IdeRule k v => k -> (NormalizedFilePath -> IdeAction (Maybe (v,PositionMapping))) -> Rules ()
+addPersistentRule :: IdeRule k v => k -> (NormalizedFilePath -> IdeAction (Maybe (v,PositionDelta,TextDocumentVersion))) -> Rules ()
 addPersistentRule k getVal = do
   ShakeExtras{persistentKeys} <- getShakeExtrasRules
   liftIO $ modifyVar_ persistentKeys $ \hm -> do
-    pure $ HMap.insert (Key k) (fmap (fmap (first toDyn)) . getVal) hm
+    pure $ HMap.insert (Key k) (fmap (fmap (first3 toDyn)) . getVal) hm
   return ()
 
 class Typeable a => IsIdeGlobal a where
@@ -291,34 +292,36 @@ getIdeOptionsIO ide = do
 -- for the version of that value.
 lastValueIO :: IdeRule k v => ShakeExtras -> k -> NormalizedFilePath -> IO (Maybe (v, PositionMapping))
 lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do
+    hm <- readVar state
+    allMappings <- readVar positionMapping
+
     let readPersistent = do
           pmap <- readVar persistentKeys
           mv <- runMaybeT $ do
             liftIO $ Logger.logDebug (logger s) $ T.pack $ "LOOKUP UP PERSISTENT FOR" ++ show k
             f <- MaybeT $ pure $ HMap.lookup (Key k) pmap
-            (dv,mapping) <- MaybeT $ runIdeAction "lastValueIO" s $ f file
-            MaybeT $ pure $ (,mapping) <$> fromDynamic dv
-          modifyVar state $ \hm -> case mv of
-            Nothing -> pure (HMap.insertWith upd (file,Key k) (Failed True) hm,Nothing)
-            Just (v,mapping) -> pure (HMap.insertWith upd (file,Key k) (Stale Nothing (toDyn v)) hm, Just (v,mapping))
+            (dv,del,ver) <- MaybeT $ runIdeAction "lastValueIO" s $ f file
+            MaybeT $ pure $ (,del,ver) <$> fromDynamic dv
+          modifyVar state $ \hm -> pure $ case mv of
+            Nothing -> (HMap.insertWith upd (file,Key k) (Failed True) hm,Nothing)
+            Just (v,del,ver) -> (HMap.insertWith upd (file,Key k) (Stale (Just del) ver (toDyn v)) hm
+                                ,Just (v,addDelta del $ mappingForVersion allMappings file ver))
 
         -- Update preserving 'monotonicity'
         -- Don't want to overwrite a newer value with an older one
         upd _new@(Failed False) old = old
         upd new@(Failed True) (Failed False) = new
         upd _new@(Failed True) old = old
-        upd new@(Stale _ _) Failed{} = new
-        upd new@(Stale v _) old@(Stale v' _) = if v >= v' then new else old
-        upd new@(Stale v _) old@(Succeeded v' _) = if v >= v' then new else old
+        upd new@(Stale _ _ _) Failed{} = new
+        upd new@(Stale _ v _) old@(Stale _ v' _) = if v >= v' then new else old
+        upd new@(Stale _ v _) old@(Succeeded v' _) = if v >= v' then new else old
         upd new _old = new
 
-    hm <- readVar state
-    allMappings <- readVar positionMapping
     case HMap.lookup (file,Key k) hm of
       Nothing -> readPersistent
       Just v -> case v of
         Succeeded ver (fromDynamic -> Just v) -> pure (Just (v, mappingForVersion allMappings file ver))
-        Stale ver (fromDynamic -> Just v) -> pure (Just (v, mappingForVersion allMappings file ver))
+        Stale del ver (fromDynamic -> Just v) -> pure (Just (v, maybe id addDelta del $ mappingForVersion allMappings file ver))
         Failed p | not p -> readPersistent
         _ -> pure Nothing
 
@@ -332,7 +335,7 @@ lastValue key file = do
 valueVersion :: Value v -> Maybe TextDocumentVersion
 valueVersion = \case
     Succeeded ver _ -> Just ver
-    Stale ver _ -> Just ver
+    Stale _ ver _ -> Just ver
     Failed _ -> Nothing
 
 mappingForVersion
@@ -435,7 +438,7 @@ knownTargets = do
 seqValue :: Value v -> b -> b
 seqValue v b = case v of
     Succeeded ver v -> rnf ver `seq` v `seq` b
-    Stale ver v -> rnf ver `seq` v `seq` b
+    Stale d ver v -> rnf d `seq` rnf ver `seq` v `seq` b
     Failed _ -> b
 
 -- | Open a 'IdeState', should be shut using 'shakeShut'.
@@ -936,8 +939,8 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old
                         pure $ case staleV of
                             Nothing -> (toShakeValue ShakeResult bs, Failed False)
                             Just v -> case v of
-                                Succeeded ver v -> (toShakeValue ShakeStale bs, Stale ver v)
-                                Stale ver v -> (toShakeValue ShakeStale bs, Stale ver v)
+                                Succeeded ver v -> (toShakeValue ShakeStale bs, Stale Nothing ver v)
+                                Stale d ver v -> (toShakeValue ShakeStale bs, Stale d ver v)
                                 Failed b -> (toShakeValue ShakeResult bs, Failed b)
                     Just v -> pure (maybe ShakeNoCutoff ShakeResult bs, Succeeded (vfsVersion =<< modTime) v)
                 liftIO $ setValues state key file res
@@ -1180,7 +1183,8 @@ filterVersionMap =
     HMap.intersectionWith $ \versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
 
 updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()
-updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} (List changes) = do
+updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} v@VersionedTextDocumentIdentifier{..} (List changes) = do
+    traceShowM ("UpdatePositionMapping",v,changes)
     modifyVar_ positionMapping $ \allMappings -> do
         let uri = toNormalizedUri _uri
         let mappingForUri = HMap.lookupDefault Map.empty uri allMappings

ghcide/src/Development/IDE/Types/Shake.hs

@@ -8,10 +8,11 @@ import Data.HashMap.Strict
 import Data.Typeable
 import GHC.Generics
 import Language.Haskell.LSP.Types
+import Development.IDE.Core.PositionMapping
 
 data Value v
     = Succeeded TextDocumentVersion v
-    | Stale TextDocumentVersion v
+    | Stale (Maybe PositionDelta) TextDocumentVersion v
     | Failed Bool
     deriving (Functor, Generic, Show)
 
@@ -21,7 +22,7 @@ instance NFData v => NFData (Value v)
 -- up2date results not for stale values.
 currentValue :: Value v -> Maybe v
 currentValue (Succeeded _ v) = Just v
-currentValue (Stale _ _) = Nothing
+currentValue (Stale _ _ _) = Nothing
 currentValue Failed{} = Nothing
 
 -- | The state of the all values.