@@ -6,6 +6,20 @@
66{-# LANGUAGE ConstraintKinds #-}
77
88-- | A Shake implementation of the compiler service.
9+--
10+-- There are two primary locations where data lives, and both of
11+-- these contain much the same data:
12+--
13+-- * The Shake database (inside 'shakeDb') stores a map of shake keys
14+-- to shake values. In our case, these are all of type 'Q' to 'A'.
15+-- During a single run all the values in the Shake database are consistent
16+-- so are used in conjunction with each other, e.g. in 'uses'.
17+--
18+-- * The 'Values' type stores a map of keys to values. These values are
19+-- always stored as real Haskell values, whereas Shake serialises all 'A' values
20+-- between runs. To deserialise a Shake value, we just consult Values.
21+-- Additionally, Values can be used in an inconsistent way, for example
22+-- useStale.
923module Development.IDE.State.Shake(
1024 IdeState,
1125 IdeRule, IdeResult,
@@ -73,9 +87,8 @@ getShakeExtras = do
7387
7488getShakeExtrasRules :: Rules ShakeExtras
7589getShakeExtrasRules = do
76− -- We'd like to use binding, but no MonadFail Rules https://github.com/ndmitchell/shake/issues/643
77− x <- getShakeExtraRules @ShakeExtras
78− return $ fromMaybe (error "Can't find ShakeExtras, serious error") x
90+ Just x <- getShakeExtraRules @ShakeExtras
91+ return x
7992
8093
8194
@@ -135,7 +148,7 @@ instance Hashable Key where
135148type IdeResult v = ([Diagnostic], Maybe v)
136149
137150type IdeRule k v =
138− ( Shake.RuleResult k ~ IdeResult v
151+ ( Shake.RuleResult k ~ v
139152 , Shake.ShakeValue k
140153 , Show v
141154 , Typeable v
@@ -184,15 +197,17 @@ setValues :: IdeRule k v
184197 -> IO (Maybe [Diagnostic], [Diagnostic]) -- ^ (before, after)
185198setValues state key file val = modifyVar state $ \inVal -> do
186199 let k = Key key
187− outVal = Map.insertWith Map.union file (Map.singleton k $ fmap toDyn <$> val) inVal
200+ outVal = Map.insertWith Map.union file (Map.singleton k $ second (fmap toDyn) val) inVal
188201 f = concatMap fst . Map.elems
189202 return (outVal, (f <$> Map.lookup file inVal, f $ outVal Map.! file))
190203
191−getValues :: forall k v. IdeRule k v => Var Values -> k -> FilePath -> IO (Maybe (IdeResult v))
192−getValues state key file = flip fmap (readVar state) $ \vs -> do
193− f <- Map.lookup file vs
194− k <- Map.lookup (Key key) f
195− pure $ fmap (fromJust . fromDynamic) <$> k
204+getValues :: forall k v. IdeRule k v => Var Values -> k -> FilePath -> IO (Maybe (Maybe v))
205+getValues state key file = do
206+ vs <- readVar state
207+ return $ do
208+ f <- Map.lookup file vs
209+ v <- Map.lookup (Key key) f
210+ pure $ fmap (fromJust . fromDynamic @v) $ snd v
196211
197212-- | Open a 'IdeState', should be shut using 'shakeShut'.
198213shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler
@@ -235,9 +250,8 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $
235250useStale
236251 :: IdeRule k v
237252 => IdeState -> k -> FilePath -> IO (Maybe v)
238−useStale IdeState{shakeExtras=ShakeExtras{state}} k fp = do
239− v <- getValues state k fp
240− return $ maybe Nothing snd v
253+useStale IdeState{shakeExtras=ShakeExtras{state}} k fp =
254+ join <$> getValues state k fp
241255
242256
243257getAllDiagnostics :: IdeState -> IO [Diagnostic]
@@ -262,7 +276,7 @@ define
262276define op = defineEarlyCutoff $ \k v -> (Nothing,) <$> op k v
263277
264278use :: IdeRule k v
265− => k -> FilePath -> Action (IdeResult v)
279+ => k -> FilePath -> Action (Maybe v)
266280use key file = head <$> uses key [file]
267281
268282use_ :: IdeRule k v => k -> FilePath -> Action v
@@ -271,7 +285,7 @@ use_ key file = head <$> uses_ key [file]
271285uses_ :: IdeRule k v => k -> [FilePath] -> Action [v]
272286uses_ key files = do
273287 res <- uses key files
274− case mapM snd res of
288+ case sequence res of
275289 Nothing -> liftIO $ throwIO BadDependency
276290 Just v -> return v
277291
@@ -307,17 +321,19 @@ instance Show k => Show (Q k) where
307321
308322-- | Invariant: the 'v' must be in normal form (fully evaluated).
309323-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database
310−data A v = A v (Maybe BS.ByteString)
324+data A v = A (Maybe v) (Maybe BS.ByteString)
311325 deriving Show
312326
313327instance NFData (A v) where rnf (A v x) = v `seq` rnf x
314328
329+-- In the Shake database we only store one type of key/result pairs,
330+-- namely Q (question) / A (answer).
315331type instance RuleResult (Q k) = A (RuleResult k)
316332
317333
318334-- | Compute the value
319335uses :: IdeRule k v
320− => k -> [FilePath] -> Action [IdeResult v]
336+ => k -> [FilePath] -> Action [Maybe v]
321337uses key files = map (\(A value _) -> value) <$> apply (map (Q . (key,)) files)
322338
323339defineEarlyCutoff
@@ -353,7 +369,7 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old m
353369 return $ RunResult
354370 (if eq then ChangedRecomputeSame else ChangedRecomputeDiff)
355371 (wrap bs)
356− $ A res bs
372+ $ A (snd res) bs
357373 where
358374 wrap = maybe BS.empty (BS.cons '_')
359375 unwrap x = if BS.null x then Nothing else Just $ BS.tail x