on master help sign in
Use a custom Value type instead of Maybe for storing rule results (#2237)

This is a refactoring-only PR in preparation for supporting stale values in damlc so we can still produce some results if a rule fails to produce a value but has a stale value stored.

commit2b61d2c17c1ef44dca7682f7f144ca56b8efc8db authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateMon 22 Jul 2019, 10:46 (7 years ago) parentb2380ea
1 file changed+29−22
src/Development/IDE/Core/Shake.hs+29−22
src/Development/IDE/Core/Shake.hs+29−22
@@ -19,15 +19,12 @@
1919-- * The 'Values' type stores a map of keys to values. These values are
2020-- always stored as real Haskell values, whereas Shake serialises all 'A' values
2121-- between runs. To deserialise a Shake value, we just consult Values.
22−-- Additionally, Values can be used in an inconsistent way, for example
23−-- useStale.
2422module Development.IDE.Core.Shake(
2523 IdeState,
2624 IdeRule, IdeResult, GetModificationTime(..),
2725 shakeOpen, shakeShut,
2826 shakeRun,
2927 shakeProfile,
30− useStale,
3128 use, useNoFile, uses,
3229 use_, useNoFile_, uses_,
3330 define, defineEarlyCutoff,
@@ -126,8 +123,8 @@ getIdeGlobalState :: forall a . IsIdeGlobal a => IdeState -> IO a
126123getIdeGlobalState = getIdeGlobalExtras . shakeExtras
127124
128125
129−-- | The state of the all values - nested so you can easily find all errors at a given file.
130−type Values = HMap.HashMap (NormalizedFilePath, Key) (Maybe Dynamic)
126+-- | The state of the all values.
127+type Values = HMap.HashMap (NormalizedFilePath, Key) (Value Dynamic)
131128
132129-- | Key type
133130data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k
@@ -154,6 +151,25 @@ instance Hashable Key where
154151-- not propagate diagnostic errors through multiple phases.
155152type IdeResult v = ([FileDiagnostic], Maybe v)
156153
154+data Value v
155+ = Succeeded v
156+ | Failed
157+ deriving (Functor, Generic, Show)
158+
159+instance NFData v => NFData (Value v)
160+
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
166+
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
172+
157173type IdeRule k v =
158174 ( Shake.RuleResult k ~ v
159175 , Show k
@@ -203,15 +219,13 @@ setValues :: IdeRule k v
203219 => Var Values
204220 -> k
205221 -> NormalizedFilePath
206− -> Maybe v
222+ -> Value v
207223 -> IO ()
208224setValues state key file val = modifyVar_ state $
209225 pure . HMap.insert (file, Key key) (fmap toDyn val)
210226
211−-- | The outer Maybe is Nothing if this function hasn't been computed before
212−-- the inner Maybe is Nothing if the result of the previous computation failed to produce
213−-- a value
214−getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Maybe v))
227+-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
228+getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Value v))
215229getValues state key file = do
216230 vs <- readVar state
217231 return $ do
@@ -300,14 +314,6 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $
300314 -- important: we send an async exception to the thread, then wait for it to die, before continuing
301315 return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)
302316
303−-- | Use the last stale value, if it's ever been computed.
304−useStale
305− :: IdeRule k v
306− => IdeState -> k -> NormalizedFilePath -> IO (Maybe v)
307−useStale IdeState{shakeExtras=ShakeExtras{state}} k fp =
308− join <$> getValues state k fp
309−
310−
311317getDiagnostics :: IdeState -> IO [FileDiagnostic]
312318getDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do
313319 val <- readVar diagnostics
@@ -376,7 +382,7 @@ instance Show k => Show (Q k) where
376382
377383-- | Invariant: the 'v' must be in normal form (fully evaluated).
378384-- 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)
380386 deriving Show
381387
382388instance NFData (A v) where rnf (A v x) = v `seq` rnf x
@@ -389,7 +395,7 @@ type instance RuleResult (Q k) = A (RuleResult k)
389395-- | Compute the value
390396uses :: IdeRule k v
391397 => 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)
393399
394400defineEarlyCutoff
395401 :: IdeRule k v
@@ -408,8 +414,9 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old m
408414 Just res -> return res
409415 Nothing -> do
410416 (bs, (diags, res)) <- actionCatch
411− (do v <- op key file; liftIO $ evaluate $ force v) $
417+ (do v <- op key file; liftIO $ evaluate $ force $ v) $
412418 \(e :: SomeException) -> pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
419+ res <- pure $ maybeToValue res
413420
414421 liftIO $ setValues state key file res
415422 updateFileDiagnostics file (Key key) extras $ map snd diags
@@ -431,7 +438,7 @@ updateFileDiagnostics ::
431438 -> [Diagnostic] -- ^ current results
432439 -> Action ()
433440updateFileDiagnostics 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
435442 mask_ $ do
436443 -- Mask async exceptions to ensure that updated diagnostics are always
437444 -- published. Otherwise, we might never publish certain diagnostics if