From 050586d59e80fbbfd7b1aec2319cebcc3a3da251 Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Wed, 4 Sep 2024 06:48:42 -0500 Subject: [PATCH] WIP Add input rule constraints --- ghcide/ghcide.cabal | 1 + ghcide/src/Development/IDE/Core/InputPath.hs | 7 ++ ghcide/src/Development/IDE/Core/Shake.hs | 113 ++++++++++-------- hls-graph/hls-graph.cabal | 1 + .../IDE/Graph/Internal/RuleInput.hs | 17 +++ 5 files changed, 86 insertions(+), 53 deletions(-) create mode 100644 ghcide/src/Development/IDE/Core/InputPath.hs create mode 100644 hls-graph/src/Development/IDE/Graph/Internal/RuleInput.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index bf88a55ed3..9c93aecc08 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -135,6 +135,7 @@ library Development.IDE.Core.FileStore Development.IDE.Core.FileUtils Development.IDE.Core.IdeConfiguration + Development.IDE.Core.InputPath Development.IDE.Core.OfInterest Development.IDE.Core.PluginUtils Development.IDE.Core.PositionMapping diff --git a/ghcide/src/Development/IDE/Core/InputPath.hs b/ghcide/src/Development/IDE/Core/InputPath.hs new file mode 100644 index 0000000000..7148ec682b --- /dev/null +++ b/ghcide/src/Development/IDE/Core/InputPath.hs @@ -0,0 +1,7 @@ +module Development.IDE.Core.InputPath where + +import Development.IDE.Graph.Internal.RuleInput (Input) +import Development.IDE (NormalizedFilePath) + +newtype InputPath (i :: Input) = + InputPath { unInputPath :: NormalizedFilePath } \ No newline at end of file diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index e37c3741c7..120d8a0515 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1,6 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -121,6 +122,7 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector import Development.IDE.Core.Debouncer import Development.IDE.Core.FileUtils (getModTime) +import Development.IDE.Core.InputPath (InputPath (unInputPath, InputPath)) import Development.IDE.Core.PositionMapping import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes @@ -179,6 +181,7 @@ import System.FilePath hiding (makeRelative) import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra import UnliftIO (MonadUnliftIO (withRunInIO)) +import Development.IDE.Graph.Internal.RuleInput (RuleInput, HasInput) data Log @@ -342,7 +345,7 @@ type WithProgressFunc = forall a. type WithIndefiniteProgressFunc = forall a. T.Text -> LSP.ProgressCancellable -> IO a -> IO a -type GetStalePersistent = NormalizedFilePath -> IdeAction (Maybe (Dynamic,PositionDelta,Maybe Int32)) +type GetStalePersistent = InputPath i -> IdeAction (Maybe (Dynamic,PositionDelta,Maybe Int32)) getShakeExtras :: Action ShakeExtras getShakeExtras = do @@ -384,7 +387,7 @@ getPluginConfigAction plId = 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,PositionDelta,Maybe Int32))) -> Rules () +addPersistentRule :: IdeRule k i is v => k -> (InputPath i -> IdeAction (Maybe (v,PositionDelta,Maybe Int32))) -> Rules () addPersistentRule k getVal = do ShakeExtras{persistentKeys} <- getShakeExtrasRules void $ liftIO $ atomically $ modifyTVar' persistentKeys $ insertKeyMap (newKey k) (fmap (fmap (first3 toDyn)) . getVal) @@ -452,7 +455,7 @@ getIdeOptionsIO ide = do -- | Return the most recent, potentially stale, value and a PositionMapping -- for the version of that value. -lastValueIO :: IdeRule k v => ShakeExtras -> k -> NormalizedFilePath -> IO (Maybe (v, PositionMapping)) +lastValueIO :: IdeRule k i is v => ShakeExtras -> k -> InputPath i -> IO (Maybe (v, PositionMapping)) lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do let readPersistent @@ -498,7 +501,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do -- | Return the most recent, potentially stale, value and a PositionMapping -- for the version of that value. -lastValue :: IdeRule k v => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping)) +lastValue :: IdeRule k i is v => k -> InputPath i -> Action (Maybe (v, PositionMapping)) lastValue key file = do s <- getShakeExtras liftIO $ lastValueIO s key file @@ -513,9 +516,11 @@ mappingForVersion allMappings file (Just (VFSVersion ver)) = do return $ maybe zeroMapping snd $ EM.lookup ver =<< mapping mappingForVersion _ _ _ = pure zeroMapping -type IdeRule k v = +type IdeRule k i is v = ( Shake.RuleResult k ~ v , Shake.ShakeValue k + , RuleInput k ~ is + , HasInput i is , Show v , Typeable v , NFData v @@ -581,10 +586,10 @@ shakeDatabaseProfileIO mbProfileDir = do shakeProfileDatabase shakeDb $ dir file return (dir file) -setValues :: IdeRule k v +setValues :: IdeRule k i is v => Values -> k - -> NormalizedFilePath + -> InputPath i -> Value v -> Vector FileDiagnostic -> STM () @@ -607,11 +612,11 @@ deleteValue ShakeExtras{state} key file = do -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. getValues :: - forall k v. - IdeRule k v => + forall k i is v. + IdeRule k i is v => Values -> k -> - NormalizedFilePath -> + InputPath i -> STM (Maybe (Value v, Vector FileDiagnostic)) getValues state key file = do STM.lookup (toKey key file) state >>= \case @@ -1010,23 +1015,23 @@ preservedKeys checkParents = HSet.fromList $ -- | Define a new Rule without early cutoff define - :: IdeRule k v - => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules () + :: IdeRule k i is v + => Recorder (WithPriority Log) -> (k -> InputPath i -> Action (IdeResult v)) -> Rules () define recorder op = defineEarlyCutoff recorder $ Rule $ \k v -> (Nothing,) <$> op k v defineNoDiagnostics - :: IdeRule k v - => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules () + :: IdeRule k i is v + => Recorder (WithPriority Log) -> (k -> InputPath i -> Action (Maybe v)) -> Rules () defineNoDiagnostics recorder op = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k v -> (Nothing,) <$> op k v -- | Request a Rule result if available -use :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe v) +use :: IdeRule k i is v + => k -> InputPath i -> Action (Maybe v) use key file = runIdentity <$> uses key (Identity file) -- | Request a Rule result, it not available return the last computed result, if any, which may be stale -useWithStale :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping)) +useWithStale :: IdeRule k i is v + => k -> InputPath i -> Action (Maybe (v, PositionMapping)) useWithStale key file = runIdentity <$> usesWithStale key (Identity file) -- |Request a Rule result, it not available return the last computed result @@ -1036,8 +1041,8 @@ useWithStale key file = runIdentity <$> usesWithStale key (Identity file) -- none available. -- -- WARNING: Not suitable for PluginHandlers. Use `useWithStaleE` instead. -useWithStale_ :: IdeRule k v - => k -> NormalizedFilePath -> Action (v, PositionMapping) +useWithStale_ :: IdeRule k i is v + => k -> InputPath i -> Action (v, PositionMapping) useWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file) -- |Plural version of 'useWithStale_' @@ -1046,7 +1051,7 @@ useWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file) -- none available. -- -- WARNING: Not suitable for PluginHandlers. -usesWithStale_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f (v, PositionMapping)) +usesWithStale_ :: (Traversable f, IdeRule k i is v) => k -> f (InputPath i) -> Action (f (v, PositionMapping)) usesWithStale_ key files = do res <- usesWithStale key files case sequence res of @@ -1077,11 +1082,11 @@ data FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: -- | Lookup value in the database and return with the stale value immediately -- Will queue an action to refresh the value. -- Might block the first time the rule runs, but never blocks after that. -useWithStaleFast :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping)) +useWithStaleFast :: IdeRule k i is v => k -> InputPath i -> IdeAction (Maybe (v, PositionMapping)) useWithStaleFast key file = stale <$> useWithStaleFast' key file -- | Same as useWithStaleFast but lets you wait for an up to date result -useWithStaleFast' :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (FastResult v) +useWithStaleFast' :: IdeRule k i is v => k -> InputPath i -> IdeAction (FastResult v) useWithStaleFast' key file = do -- This lookup directly looks up the key in the shake database and -- returns the last value that was computed for this key without @@ -1108,7 +1113,7 @@ useWithStaleFast' key file = do res <- lastValueIO s key file pure $ FastResult res waitValue -useNoFile :: IdeRule k v => k -> Action (Maybe v) +useNoFile :: IdeRule k i is v => k -> Action (Maybe v) useNoFile key = use key emptyFilePath -- Requests a rule if available. @@ -1117,10 +1122,10 @@ useNoFile key = use key emptyFilePath -- none available. -- -- WARNING: Not suitable for PluginHandlers. Use `useE` instead. -use_ :: IdeRule k v => k -> NormalizedFilePath -> Action v +use_ :: IdeRule k i is v => k -> InputPath i -> Action v use_ key file = runIdentity <$> uses_ key (Identity file) -useNoFile_ :: IdeRule k v => k -> Action v +useNoFile_ :: IdeRule k i is v => k -> Action v useNoFile_ key = use_ key emptyFilePath -- |Plural version of `use_` @@ -1129,7 +1134,7 @@ useNoFile_ key = use_ key emptyFilePath -- none available. -- -- WARNING: Not suitable for PluginHandlers. Use `usesE` instead. -uses_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f v) +uses_ :: (Traversable f, IdeRule k i is v) => k -> f (InputPath i) -> Action (f v) uses_ key files = do res <- uses key files case sequence res of @@ -1137,13 +1142,13 @@ uses_ key files = do Just v -> return v -- | Plural version of 'use' -uses :: (Traversable f, IdeRule k v) - => k -> f NormalizedFilePath -> Action (f (Maybe v)) +uses :: (Traversable f, IdeRule k i is v) + => k -> f (InputPath i) -> Action (f (Maybe v)) uses key files = fmap (\(A value) -> currentValue value) <$> apply (fmap (Q . (key,)) files) -- | Return the last computed result which might be stale. -usesWithStale :: (Traversable f, IdeRule k v) - => k -> f NormalizedFilePath -> Action (f (Maybe (v, PositionMapping))) +usesWithStale :: (Traversable f, IdeRule k i is v) + => k -> f (InputPath i) -> Action (f (Maybe (v, PositionMapping))) usesWithStale key files = do _ <- apply (fmap (Q . (key,)) files) -- We don't look at the result of the 'apply' since 'lastValue' will @@ -1151,25 +1156,25 @@ usesWithStale key files = do -- whether the rule succeeded or not. traverse (lastValue key) files -useWithoutDependency :: IdeRule k v - => k -> NormalizedFilePath -> Action (Maybe v) +useWithoutDependency :: IdeRule k i is v + => k -> InputPath i -> Action (Maybe v) useWithoutDependency key file = (\(Identity (A value)) -> currentValue value) <$> applyWithoutDependency (Identity (Q (key, file))) -data RuleBody k v - = Rule (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v)) - | RuleNoDiagnostics (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v)) +data RuleBody k i v + = Rule (k -> InputPath i -> Action (Maybe BS.ByteString, IdeResult v)) + | RuleNoDiagnostics (k -> InputPath i -> Action (Maybe BS.ByteString, Maybe v)) | RuleWithCustomNewnessCheck { newnessCheck :: BS.ByteString -> BS.ByteString -> Bool - , build :: k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v) + , build :: k -> InputPath i -> Action (Maybe BS.ByteString, Maybe v) } - | RuleWithOldValue (k -> NormalizedFilePath -> Value v -> Action (Maybe BS.ByteString, IdeResult v)) + | RuleWithOldValue (k -> InputPath i -> Value v -> Action (Maybe BS.ByteString, IdeResult v)) -- | Define a new Rule with early cutoff defineEarlyCutoff - :: IdeRule k v + :: IdeRule k i is v => Recorder (WithPriority Log) - -> RuleBody k v + -> RuleBody k i v -> Rules () defineEarlyCutoff recorder (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \traceDiagnostics -> do extras <- getShakeExtras @@ -1197,32 +1202,33 @@ defineEarlyCutoff recorder (RuleWithOldValue op) = addRule $ \(Q (key, file)) (o updateFileDiagnostics recorder file ver (newKey key) extras . map (\(_,y,z) -> (y,z)) $ diags defineEarlyCutoff' diagnostics (==) key file old mode $ op key file -defineNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action v) -> Rules () +defineNoFile :: IdeRule k i is v => Recorder (WithPriority Log) -> (k -> Action v) -> Rules () defineNoFile recorder f = defineNoDiagnostics recorder $ \k file -> do if file == emptyFilePath then do res <- f k; return (Just res) else fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file" -defineEarlyCutOffNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action (BS.ByteString, v)) -> Rules () -defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k file -> do +defineEarlyCutOffNoFile :: IdeRule k i is v => Recorder (WithPriority Log) -> (k -> Action (BS.ByteString, v)) -> Rules () +defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k (InputPath file) -> do if file == emptyFilePath then do (hashString, res) <- f k; return (Just hashString, Just res) else fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file" defineEarlyCutoff' - :: forall k v. IdeRule k v + :: forall k i is v. IdeRule k i is v => (Maybe Int32 -> [FileDiagnostic] -> Action ()) -- ^ update diagnostics -- | compare current and previous for freshness -> (BS.ByteString -> BS.ByteString -> Bool) -> k - -> NormalizedFilePath + -> InputPath i -> Maybe BS.ByteString -> RunMode -> (Value v -> Action (Maybe BS.ByteString, IdeResult v)) -> Action (RunResult (A (RuleResult k))) defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do + let rawFile = unInputPath file ShakeExtras{state, progress, dirtyKeys} <- getShakeExtras options <- getIdeOptions let trans g x = withRunInIO $ \run -> g (run x) - (if optSkipProgress options key then id else trans (inProgress progress file)) $ do + (if optSkipProgress options key then id else trans (inProgress progress rawFile)) $ do val <- case mbOld of Just old | mode == RunDependenciesSame -> do mbValue <- liftIO $ atomicallyNamed "define - read 1" $ getValues state key file @@ -1249,7 +1255,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (mbBs, (diags, mbRes)) <- actionCatch (do v <- action staleV; liftIO $ evaluate $ force v) $ \(e :: SomeException) -> do - pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing)) + pure (Nothing, ([ideErrorText rawFile $ T.pack $ show e | not $ isBadDependency e],Nothing)) ver <- estimateFileVersionUnsafely key mbRes file (bs, res) <- case mbRes of @@ -1270,7 +1276,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do -- this hook needs to be run in the same transaction as the key is marked clean -- see Note [Housekeeping rule cache and dirty key outside of hls-graph] setValues state key file res (Vector.fromList diags) - modifyTVar' dirtyKeys (deleteKeySet $ toKey key file) + modifyTVar' dirtyKeys (deleteKeySet $ toKey key rawFile) return res where -- Highly unsafe helper to compute the version of a file @@ -1279,10 +1285,10 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do estimateFileVersionUnsafely :: k -> Maybe v - -> NormalizedFilePath + -> InputPath i -> Action (Maybe FileVersion) estimateFileVersionUnsafely _k v fp - | fp == emptyFilePath = pure Nothing + | unInputPath fp == emptyFilePath = pure Nothing | Just Refl <- eqT @k @GetModificationTime = pure v -- GetModificationTime depends on these rules, so avoid creating a cycle | Just Refl <- eqT @k @AddWatchedFile = pure Nothing @@ -1457,9 +1463,10 @@ kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $ toJSON $ map fromNormalizedFilePath files -- | Add kick start/done signal to rule -runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action () -runWithSignal msgStart msgEnd files rule = do +runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k i is v) => Proxy s0 -> Proxy s1 -> [InputPath i] -> k -> Action () +runWithSignal msgStart msgEnd inputFiles rule = do + let files = map unInputPath inputFiles ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras kickSignal testing lspEnv files msgStart - void $ uses rule files + void $ uses rule inputFiles kickSignal testing lspEnv files msgEnd diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal index d5a9f781de..f9d3ca15ca 100644 --- a/hls-graph/hls-graph.cabal +++ b/hls-graph/hls-graph.cabal @@ -60,6 +60,7 @@ library Development.IDE.Graph.Internal.Key Development.IDE.Graph.Internal.Paths Development.IDE.Graph.Internal.Profile + Development.IDE.Graph.Internal.RuleInput Development.IDE.Graph.Internal.Rules Development.IDE.Graph.Internal.Types Development.IDE.Graph.KeyMap diff --git a/hls-graph/src/Development/IDE/Graph/Internal/RuleInput.hs b/hls-graph/src/Development/IDE/Graph/Internal/RuleInput.hs new file mode 100644 index 0000000000..093cd01269 --- /dev/null +++ b/hls-graph/src/Development/IDE/Graph/Internal/RuleInput.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} +module Development.IDE.Graph.Internal.RuleInput where + +type ValidInputs = [Input] + +data Input + = ProjectHaskellFile + | DependencyHaskellFile + +type family RuleInput k :: ValidInputs + +class HasInput (i :: Input) (is :: ValidInputs) + +instance HasInput i (i : is) + +instance {-# OVERLAPPABLE #-} + HasInput i is => HasInput i (j : is)