@@ -19,15 +19,12 @@
19-- * The 'Values' type stores a map of keys to values. These values are
19-- * The 'Values' type stores a map of keys to values. These values are
20-- always stored as real Haskell values, whereas Shake serialises all 'A' values
20-- always stored as real Haskell values, whereas Shake serialises all 'A' values
21-- between runs. To deserialise a Shake value, we just consult Values.
21-- between runs. To deserialise a Shake value, we just consult Values.
22−-- Additionally, Values can be used in an inconsistent way, for example
24module Development.IDE.Core.Shake(
22module Development.IDE.Core.Shake(
26 IdeRule, IdeResult, GetModificationTime(..),
24 IdeRule, IdeResult, GetModificationTime(..),
27 shakeOpen, shakeShut,
25 shakeOpen, shakeShut,
29 shakeProfile,
27 shakeProfile,
31 use, useNoFile, uses,
28 use, useNoFile, uses,
32 use_, useNoFile_, uses_,
29 use_, useNoFile_, uses_,
33 define, defineEarlyCutoff,
30 define, defineEarlyCutoff,
@@ -126,8 +123,8 @@ getIdeGlobalState :: forall a . IsIdeGlobal a => IdeState -> IO a
126getIdeGlobalState = getIdeGlobalExtras . shakeExtras
123getIdeGlobalState = getIdeGlobalExtras . shakeExtras
129−-- | The state of the all values - nested so you can easily find all errors at a given file.
126+-- | The state of the all values.
130−type Values = HMap.HashMap (NormalizedFilePath, Key) (Maybe Dynamic)
127+type Values = HMap.HashMap (NormalizedFilePath, Key) (Value Dynamic)
132-- | Key type
129-- | Key type
133data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k
130data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k
@@ -154,6 +151,25 @@ instance Hashable Key where
154-- not propagate diagnostic errors through multiple phases.
151-- not propagate diagnostic errors through multiple phases.
155type IdeResult v = ([FileDiagnostic], Maybe v)
152type IdeResult v = ([FileDiagnostic], Maybe v)
157+ deriving (Functor, Generic, Show)
159+instance NFData v => NFData (Value v)
161+-- | Convert a Value to a Maybe. This will only return `Just` for
162+-- up2date results not for stale values.
163+valueToMaybe :: Value v -> Maybe v
164+valueToMaybe (Succeeded v) = Just v
165+valueToMaybe Failed = Nothing
167+-- | Convert a Value to a Maybe. A `Just` will be treated as a
168+-- succesful run rather than a stale result
169+maybeToValue :: Maybe v -> Value v
170+maybeToValue (Just v) = Succeeded v
171+maybeToValue Nothing = Failed
157type IdeRule k v =
173type IdeRule k v =
158 ( Shake.RuleResult k ~ v
174 ( Shake.RuleResult k ~ v
@@ -203,15 +219,13 @@ setValues :: IdeRule k v
203 => Var Values
219 => Var Values
205 -> NormalizedFilePath
221 -> NormalizedFilePath
206− -> Maybe v
222+ -> Value v
208setValues state key file val = modifyVar_ state $
224setValues state key file val = modifyVar_ state $
209 pure . HMap.insert (file, Key key) (fmap toDyn val)
225 pure . HMap.insert (file, Key key) (fmap toDyn val)
211−-- | The outer Maybe is Nothing if this function hasn't been computed before
227+-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
212−-- the inner Maybe is Nothing if the result of the previous computation failed to produce
214−getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Maybe v))
228+getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Value v))
215getValues state key file = do
229getValues state key file = do
216 vs <- readVar state
230 vs <- readVar state
217 return $ do
231 return $ do
@@ -300,14 +314,6 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $
300 -- important: we send an async exception to the thread, then wait for it to die, before continuing
314 -- important: we send an async exception to the thread, then wait for it to die, before continuing
301 return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)
315 return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)
303−-- | Use the last stale value, if it's ever been computed.
306− => IdeState -> k -> NormalizedFilePath -> IO (Maybe v)
307−useStale IdeState{shakeExtras=ShakeExtras{state}} k fp =
308− join <$> getValues state k fp
311getDiagnostics :: IdeState -> IO [FileDiagnostic]
317getDiagnostics :: IdeState -> IO [FileDiagnostic]
312getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do
318getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do
313 val <- readVar diagnostics
319 val <- readVar diagnostics
@@ -376,7 +382,7 @@ instance Show k => Show (Q k) where
377-- | Invariant: the 'v' must be in normal form (fully evaluated).
383-- | Invariant: the 'v' must be in normal form (fully evaluated).
378-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database
384-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database
379−data A v = A (Maybe v) (Maybe BS.ByteString)
385+data A v = A (Value v) (Maybe BS.ByteString)
380 deriving Show
386 deriving Show
382instance NFData (A v) where rnf (A v x) = v `seq` rnf x
388instance NFData (A v) where rnf (A v x) = v `seq` rnf x
@@ -389,7 +395,7 @@ type instance RuleResult (Q k) = A (RuleResult k)
389-- | Compute the value
395-- | Compute the value
390uses :: IdeRule k v
396uses :: IdeRule k v
391 => k -> [NormalizedFilePath] -> Action [Maybe v]
397 => k -> [NormalizedFilePath] -> Action [Maybe v]
392−uses key files = map (\(A value _) -> value) <$> apply (map (Q . (key,)) files)
398+uses key files = map (\(A value _) -> valueToMaybe value) <$> apply (map (Q . (key,)) files)
394defineEarlyCutoff
400defineEarlyCutoff
395 :: IdeRule k v
401 :: IdeRule k v
@@ -408,8 +414,9 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old m
408 Just res -> return res
414 Just res -> return res
409 Nothing -> do
415 Nothing -> do
410 (bs, (diags, res)) <- actionCatch
416 (bs, (diags, res)) <- actionCatch
411− (do v <- op key file; liftIO $ evaluate $ force v) $
417+ (do v <- op key file; liftIO $ evaluate $ force $ v) $
412 \(e :: SomeException) -> pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
418 \(e :: SomeException) -> pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
419+ res <- pure $ maybeToValue res
414 liftIO $ setValues state key file res
421 liftIO $ setValues state key file res
415 updateFileDiagnostics file (Key key) extras $ map snd diags
422 updateFileDiagnostics file (Key key) extras $ map snd diags
@@ -431,7 +438,7 @@ updateFileDiagnostics ::
431 -> [Diagnostic] -- ^ current results
438 -> [Diagnostic] -- ^ current results
432 -> Action ()
439 -> Action ()
433updateFileDiagnostics fp k ShakeExtras{diagnostics, publishedDiagnostics, state, debouncer, eventer} current = liftIO $ do
440updateFileDiagnostics fp k ShakeExtras{diagnostics, publishedDiagnostics, state, debouncer, eventer} current = liftIO $ do
434− modTime <- join <$> getValues state GetModificationTime fp
441+ modTime <- join . fmap valueToMaybe <$> getValues state GetModificationTime fp
435 mask_ $ do
442 mask_ $ do
436 -- Mask async exceptions to ensure that updated diagnostics are always
443 -- Mask async exceptions to ensure that updated diagnostics are always
437 -- published. Otherwise, we might never publish certain diagnostics if
444 -- published. Otherwise, we might never publish certain diagnostics if