diff --git a/hls-graph.cabal b/hls-graph.cabal
--- a/hls-graph.cabal
+++ b/hls-graph.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:          hls-graph
-version:       1.6.0.0
+version:       1.7.0.0
 synopsis:      Haskell Language Server internal graph API
 description:
   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server/tree/master/hls-graph#readme>
@@ -104,3 +104,33 @@
     DataKinds
     KindSignatures
     TypeOperators
+
+test-suite tests
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  other-modules:
+    ActionSpec
+    DatabaseSpec
+    Example
+    RulesSpec
+    Spec
+
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
+  build-depends:
+    , base
+    , containers
+    , directory
+    , extra
+    , filepath
+    , hls-graph
+    , hspec
+    , stm
+    , stm-containers
+    , tasty
+    , tasty-hspec
+    , tasty-hunit
+    , tasty-rerun
+    , text
+  build-tool-depends: hspec-discover:hspec-discover -any
diff --git a/src/Development/IDE/Graph.hs b/src/Development/IDE/Graph.hs
--- a/src/Development/IDE/Graph.hs
+++ b/src/Development/IDE/Graph.hs
@@ -5,7 +5,7 @@
     Key(..),
     actionFinally, actionBracket, actionCatch, actionFork,
     -- * Configuration
-    ShakeOptions(shakeAllowRedefineRules, shakeThreads, shakeFiles, shakeExtra),
+    ShakeOptions(shakeAllowRedefineRules, shakeExtra),
     getShakeExtra, getShakeExtraRules, newShakeExtra,
     -- * Explicit parallelism
     parallel,
diff --git a/src/Development/IDE/Graph/Classes.hs b/src/Development/IDE/Graph/Classes.hs
--- a/src/Development/IDE/Graph/Classes.hs
+++ b/src/Development/IDE/Graph/Classes.hs
@@ -1,8 +1,8 @@
-
-module Development.IDE.Graph.Classes(
-    Show(..), Typeable, Eq(..), Hashable(..), NFData(..)
-    ) where
-
-import           Control.DeepSeq
-import           Data.Hashable
-import           Data.Typeable
+
+module Development.IDE.Graph.Classes(
+    Show(..), Typeable, Eq(..), Hashable(..), NFData(..)
+    ) where
+
+import           Control.DeepSeq
+import           Data.Hashable
+import           Data.Typeable
diff --git a/src/Development/IDE/Graph/Database.hs b/src/Development/IDE/Graph/Database.hs
--- a/src/Development/IDE/Graph/Database.hs
+++ b/src/Development/IDE/Graph/Database.hs
@@ -4,7 +4,7 @@
 module Development.IDE.Graph.Database(
     ShakeDatabase,
     ShakeValue,
-    shakeOpenDatabase,
+    shakeNewDatabase,
     shakeRunDatabase,
     shakeRunDatabaseForKeys,
     shakeProfileDatabase,
@@ -23,14 +23,10 @@
 import           Development.IDE.Graph.Internal.Rules
 import           Development.IDE.Graph.Internal.Types
 
-data ShakeDatabase = ShakeDatabase !Int [Action ()] Database
 
 -- Placeholder to be the 'extra' if the user doesn't set it
 data NonExportedType = NonExportedType
 
-shakeOpenDatabase :: ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ())
-shakeOpenDatabase opts rules = pure (shakeNewDatabase opts rules, pure ())
-
 shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
 shakeNewDatabase opts rules = do
     let extra = fromMaybe (toDyn NonExportedType) $ shakeExtra opts
@@ -38,7 +34,7 @@
     db <- newDatabase extra theRules
     pure $ ShakeDatabase (length actions) actions db
 
-shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO ([a], [IO ()])
+shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
 shakeRunDatabase = shakeRunDatabaseForKeys Nothing
 
 -- | Returns the set of dirty keys annotated with their age (in # of builds)
@@ -62,11 +58,10 @@
       -- ^ Set of keys changed since last run. 'Nothing' means everything has changed
     -> ShakeDatabase
     -> [Action a]
-    -> IO ([a], [IO ()])
+    -> IO [a]
 shakeRunDatabaseForKeys keysChanged (ShakeDatabase lenAs1 as1 db) as2 = do
     incDatabase db keysChanged
-    as <- fmap (drop lenAs1) $ runActions db $ map unvoid as1 ++ as2
-    return (as, [])
+    fmap (drop lenAs1) $ runActions db $ map unvoid as1 ++ as2
 
 -- | Given a 'ShakeDatabase', write an HTML profile to the given file about the latest run.
 shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
diff --git a/src/Development/IDE/Graph/Internal/Action.hs b/src/Development/IDE/Graph/Internal/Action.hs
--- a/src/Development/IDE/Graph/Internal/Action.hs
+++ b/src/Development/IDE/Graph/Internal/Action.hs
@@ -1,137 +1,147 @@
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-
-module Development.IDE.Graph.Internal.Action
-( ShakeValue
-, actionFork
-, actionBracket
-, actionCatch
-, actionFinally
-, alwaysRerun
-, apply1
-, apply
-, parallel
-, reschedule
-, runActions
-, Development.IDE.Graph.Internal.Action.getDirtySet
-, getKeysAndVisitedAge
-) where
-
-import           Control.Concurrent.Async
-import           Control.Exception
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Reader
-import           Data.IORef
-import           Development.IDE.Graph.Classes
-import           Development.IDE.Graph.Internal.Database
-import           Development.IDE.Graph.Internal.Rules    (RuleResult)
-import           Development.IDE.Graph.Internal.Types
-import           System.Exit
-
-type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, NFData a)
-
--- | Always rerun this rule when dirty, regardless of the dependencies.
-alwaysRerun :: Action ()
-alwaysRerun = do
-    ref <- Action $ asks actionDeps
-    liftIO $ modifyIORef ref (AlwaysRerunDeps [] <>)
-
--- No-op for now
-reschedule :: Double -> Action ()
-reschedule _ = pure ()
-
-parallel :: [Action a] -> Action [a]
-parallel [] = pure []
-parallel [x] = fmap (:[]) x
-parallel xs = do
-    a <- Action ask
-    deps <- liftIO $ readIORef $ actionDeps a
-    case deps of
-        UnknownDeps ->
-            -- if we are already in the rerun mode, nothing we do is going to impact our state
-            liftIO $ mapConcurrently (ignoreState a) xs
-        deps -> do
-            (newDeps, res) <- liftIO $ unzip <$> mapConcurrently (usingState a) xs
-            liftIO $ writeIORef (actionDeps a) $ mconcat $ deps : newDeps
-            pure res
-    where
-        usingState a x = do
-            ref <- newIORef mempty
-            res <- runReaderT (fromAction x) a{actionDeps=ref}
-            deps <- readIORef ref
-            pure (deps, res)
-
-ignoreState :: SAction -> Action b -> IO b
-ignoreState a x = do
-    ref <- newIORef mempty
-    runReaderT (fromAction x) a{actionDeps=ref}
-
-actionFork :: Action a -> (Async a -> Action b) -> Action b
-actionFork act k = do
-    a <- Action ask
-    deps <- liftIO $ readIORef $ actionDeps a
-    let db = actionDatabase a
-    case deps of
-        UnknownDeps -> do
-            -- if we are already in the rerun mode, nothing we do is going to impact our state
-            [res] <- liftIO $ withAsync (ignoreState a act) $ \as -> runActions db [k as]
-            return res
-        _ ->
-            error "please help me"
-
-isAsyncException :: SomeException -> Bool
-isAsyncException e
-    | Just (_ :: AsyncCancelled) <- fromException e = True
-    | Just (_ :: AsyncException) <- fromException e = True
-    | Just (_ :: ExitCode) <- fromException e = True
-    | otherwise = False
-
-
-actionCatch :: Exception e => Action a -> (e -> Action a) -> Action a
-actionCatch a b = do
-    v <- Action ask
-    Action $ lift $ catchJust f (runReaderT (fromAction a) v) (\x -> runReaderT (fromAction (b x)) v)
-    where
-        -- Catch only catches exceptions that were caused by this code, not those that
-        -- are a result of program termination
-        f e | isAsyncException e = Nothing
-            | otherwise = fromException e
-
-actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c
-actionBracket a b c = do
-    v <- Action ask
-    Action $ lift $ bracket a b (\x -> runReaderT (fromAction (c x)) v)
-
-actionFinally :: Action a -> IO b -> Action a
-actionFinally a b = do
-    v <- Action ask
-    Action $ lift $ finally (runReaderT (fromAction a) v) b
-
-apply1 :: (RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action value
-apply1 k = head <$> apply [k]
-
-apply :: (RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
-apply ks = do
-    db <- Action $ asks actionDatabase
-    (is, vs) <- liftIO $ build db ks
-    ref <- Action $ asks actionDeps
-    liftIO $ modifyIORef ref (ResultDeps is <>)
-    pure vs
-
-runActions :: Database -> [Action a] -> IO [a]
-runActions db xs = do
-    deps <- newIORef mempty
-    runReaderT (fromAction $ parallel xs) $ SAction db deps
-
--- | Returns the set of dirty keys annotated with their age (in # of builds)
-getDirtySet  :: Action [(Key, Int)]
-getDirtySet = do
-    db <- getDatabase
-    liftIO $ Development.IDE.Graph.Internal.Database.getDirtySet db
-
-getKeysAndVisitedAge :: Action [(Key, Int)]
-getKeysAndVisitedAge = do
-    db <- getDatabase
-    liftIO $ Development.IDE.Graph.Internal.Database.getKeysAndVisitAge db
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+
+module Development.IDE.Graph.Internal.Action
+( ShakeValue
+, actionFork
+, actionBracket
+, actionCatch
+, actionFinally
+, alwaysRerun
+, apply1
+, apply
+, applyWithoutDependency
+, parallel
+, reschedule
+, runActions
+, Development.IDE.Graph.Internal.Action.getDirtySet
+, getKeysAndVisitedAge
+) where
+
+import           Control.Concurrent.Async
+import           Control.Exception
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Reader
+import           Data.IORef
+import           Development.IDE.Graph.Classes
+import           Development.IDE.Graph.Internal.Database
+import           Development.IDE.Graph.Internal.Rules    (RuleResult)
+import           Development.IDE.Graph.Internal.Types
+import           System.Exit
+
+type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, NFData a)
+
+-- | Always rerun this rule when dirty, regardless of the dependencies.
+alwaysRerun :: Action ()
+alwaysRerun = do
+    ref <- Action $ asks actionDeps
+    liftIO $ modifyIORef ref (AlwaysRerunDeps [] <>)
+
+-- No-op for now
+reschedule :: Double -> Action ()
+reschedule _ = pure ()
+
+parallel :: [Action a] -> Action [a]
+parallel [] = pure []
+parallel [x] = fmap (:[]) x
+parallel xs = do
+    a <- Action ask
+    deps <- liftIO $ readIORef $ actionDeps a
+    case deps of
+        UnknownDeps ->
+            -- if we are already in the rerun mode, nothing we do is going to impact our state
+            liftIO $ mapConcurrently (ignoreState a) xs
+        deps -> do
+            (newDeps, res) <- liftIO $ unzip <$> mapConcurrently (usingState a) xs
+            liftIO $ writeIORef (actionDeps a) $ mconcat $ deps : newDeps
+            pure res
+    where
+        usingState a x = do
+            ref <- newIORef mempty
+            res <- runReaderT (fromAction x) a{actionDeps=ref}
+            deps <- readIORef ref
+            pure (deps, res)
+
+ignoreState :: SAction -> Action b -> IO b
+ignoreState a x = do
+    ref <- newIORef mempty
+    runReaderT (fromAction x) a{actionDeps=ref}
+
+actionFork :: Action a -> (Async a -> Action b) -> Action b
+actionFork act k = do
+    a <- Action ask
+    deps <- liftIO $ readIORef $ actionDeps a
+    let db = actionDatabase a
+    case deps of
+        UnknownDeps -> do
+            -- if we are already in the rerun mode, nothing we do is going to impact our state
+            [res] <- liftIO $ withAsync (ignoreState a act) $ \as -> runActions db [k as]
+            return res
+        _ ->
+            error "please help me"
+
+isAsyncException :: SomeException -> Bool
+isAsyncException e
+    | Just (_ :: AsyncCancelled) <- fromException e = True
+    | Just (_ :: AsyncException) <- fromException e = True
+    | Just (_ :: ExitCode) <- fromException e = True
+    | otherwise = False
+
+
+actionCatch :: Exception e => Action a -> (e -> Action a) -> Action a
+actionCatch a b = do
+    v <- Action ask
+    Action $ lift $ catchJust f (runReaderT (fromAction a) v) (\x -> runReaderT (fromAction (b x)) v)
+    where
+        -- Catch only catches exceptions that were caused by this code, not those that
+        -- are a result of program termination
+        f e | isAsyncException e = Nothing
+            | otherwise = fromException e
+
+actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c
+actionBracket a b c = do
+    v <- Action ask
+    Action $ lift $ bracket a b (\x -> runReaderT (fromAction (c x)) v)
+
+actionFinally :: Action a -> IO b -> Action a
+actionFinally a b = do
+    v <- Action ask
+    Action $ lift $ finally (runReaderT (fromAction a) v) b
+
+apply1 :: (RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action value
+apply1 k = head <$> apply [k]
+
+apply :: (RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
+apply ks = do
+    db <- Action $ asks actionDatabase
+    stack <- Action $ asks actionStack
+    (is, vs) <- liftIO $ build db stack ks
+    ref <- Action $ asks actionDeps
+    liftIO $ modifyIORef ref (ResultDeps is <>)
+    pure vs
+
+-- | Evaluate a list of keys without recording any dependencies.
+applyWithoutDependency :: (RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
+applyWithoutDependency ks = do
+    db <- Action $ asks actionDatabase
+    stack <- Action $ asks actionStack
+    (_, vs) <- liftIO $ build db stack ks
+    pure vs
+
+runActions :: Database -> [Action a] -> IO [a]
+runActions db xs = do
+    deps <- newIORef mempty
+    runReaderT (fromAction $ parallel xs) $ SAction db deps emptyStack
+
+-- | Returns the set of dirty keys annotated with their age (in # of builds)
+getDirtySet  :: Action [(Key, Int)]
+getDirtySet = do
+    db <- getDatabase
+    liftIO $ Development.IDE.Graph.Internal.Database.getDirtySet db
+
+getKeysAndVisitedAge :: Action [(Key, Int)]
+getKeysAndVisitedAge = do
+    db <- getDatabase
+    liftIO $ Development.IDE.Graph.Internal.Database.getKeysAndVisitAge db
diff --git a/src/Development/IDE/Graph/Internal/Database.hs b/src/Development/IDE/Graph/Internal/Database.hs
--- a/src/Development/IDE/Graph/Internal/Database.hs
+++ b/src/Development/IDE/Graph/Internal/Database.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TupleSections #-}
 
 module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where
 
@@ -32,14 +33,15 @@
 import           Data.Maybe
 import           Data.Traversable                     (for)
 import           Data.Tuple.Extra
+import           Debug.Trace (traceM)
 import           Development.IDE.Graph.Classes
 import           Development.IDE.Graph.Internal.Rules
 import           Development.IDE.Graph.Internal.Types
 import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
+import           System.Time.Extra                    (duration, sleep)
 import           System.IO.Unsafe
-import           System.Time.Extra                    (duration)
 
 newDatabase :: Dynamic -> TheRules -> IO Database
 newDatabase databaseExtra databaseRules = do
@@ -77,10 +79,11 @@
 -- | Unwrap and build a list of keys in parallel
 build
     :: forall key value . (RuleResult key ~ value, Typeable key, Show key, Hashable key, Eq key, Typeable value)
-    => Database -> [key] -> IO ([Key], [value])
-build db keys = do
+    => Database -> Stack -> [key] -> IO ([Key], [value])
+-- build _ st k | traceShow ("build", st, k) False = undefined
+build db stack keys = do
     (ids, vs) <- runAIO $ fmap unzip $ either return liftIO =<<
-            builder db (map Key keys)
+            builder db stack (map Key keys)
     pure (ids, map (asV . resultValue) vs)
     where
         asV :: Value -> value
@@ -90,8 +93,9 @@
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
 builder
-    :: Database -> [Key] -> AIO (Either [(Key, Result)] (IO [(Key, Result)]))
-builder db@Database{..} keys = withRunInIO $ \(RunInIO run) -> do
+    :: Database -> Stack -> [Key] -> AIO (Either [(Key, Result)] (IO [(Key, Result)]))
+-- builder _ st kk | traceShow ("builder", st,kk) False = undefined
+builder db@Database{..} stack keys = withRunInIO $ \(RunInIO run) -> do
     -- Things that I need to force before my results are ready
     toForce <- liftIO $ newTVarIO []
     current <- liftIO $ readTVarIO databaseStep
@@ -103,11 +107,13 @@
             status <- SMap.lookup id databaseValues
             val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
                 Clean r -> pure r
-                Running _ force val _ -> do
+                Running _ force val _
+                  | memberStack id stack -> throw $ StackException stack
+                  | otherwise -> do
                     modifyTVar' toForce (Wait force :)
                     pure val
                 Dirty s -> do
-                    let act = run (refresh db id s)
+                    let act = run (refresh db stack id s)
                         (force, val) = splitIO (join act)
                     SMap.focus (updateStatus $ Running current force val s) id databaseValues
                     modifyTVar' toForce (Spawn force:)
@@ -116,7 +122,7 @@
             pure (id, val)
 
     toForceList <- liftIO $ readTVarIO toForce
-    let waitAll = run $ mapConcurrentlyAIO_ id toForceList
+    let waitAll = run $ waitConcurrently_ toForceList
     case toForceList of
         [] -> return $ Left results
         _ -> return $ Right $ do
@@ -127,32 +133,33 @@
 --     * If no dirty dependencies and we have evaluated the key previously, then we refresh it in the current thread.
 --       This assumes that the implementation will be a lookup
 --     * Otherwise, we spawn a new thread to refresh the dirty deps (if any) and the key itself
-refresh :: Database -> Key -> Maybe Result -> AIO (IO Result)
-refresh db key result@(Just me@Result{resultDeps = ResultDeps deps}) = do
-    res <- builder db deps
-    case res of
-      Left res ->
-        if isDirty res
-            then asyncWithCleanUp $ liftIO $ compute db key RunDependenciesChanged result
-            else pure $ compute db key RunDependenciesSame result
-      Right iores -> asyncWithCleanUp $ liftIO $ do
-        res <- iores
-        let mode = if isDirty res then RunDependenciesChanged else RunDependenciesSame
-        compute db key mode result
-    where
-        isDirty = any (\(_,dep) -> resultBuilt me < resultChanged dep)
-
-refresh db key result =
-    asyncWithCleanUp $ liftIO $ compute db key RunDependenciesChanged result
-
+refresh :: Database -> Stack -> Key -> Maybe Result -> AIO (IO Result)
+-- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
+refresh db stack key result = case (addStack key stack, result) of
+    (Left e, _) -> throw e
+    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> do
+        res <- builder db stack deps
+        let isDirty = any (\(_,dep) -> resultBuilt me < resultChanged dep)
+        case res of
+            Left res ->
+                if isDirty res
+                    then asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result
+                    else pure $ compute db stack key RunDependenciesSame result
+            Right iores -> asyncWithCleanUp $ liftIO $ do
+                res <- iores
+                let mode = if isDirty res then RunDependenciesChanged else RunDependenciesSame
+                compute db stack key mode result
+    (Right stack, _) ->
+        asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result
 
 -- | Compute a key.
-compute :: Database -> Key -> RunMode -> Maybe Result -> IO Result
-compute db@Database{..} key mode result = do
+compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
+-- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
+compute db@Database{..} stack key mode result = do
     let act = runRule databaseRules key (fmap resultData result) mode
     deps <- newIORef UnknownDeps
     (execution, RunResult{..}) <-
-        duration $ runReaderT (fromAction act) $ SAction db deps
+        duration $ runReaderT (fromAction act) $ SAction db deps stack
     built <- readTVarIO databaseStep
     deps <- readIORef deps
     let changed = if runChanged == ChangedRecomputeDiff then built else maybe built resultChanged result
@@ -165,7 +172,11 @@
         deps | not(null deps)
             && runChanged /= ChangedNothing
                     -> do
-            void $ forkIO $
+            -- IMPORTANT: record the reverse deps **before** marking the key Clean.
+            -- If an async exception strikes before the deps have been recorded,
+            -- we won't be able to accurately propagate dirtiness for this key
+            -- on the next build.
+            void $
                 updateReverseDeps key db
                     (getResultDepsDefault [] previousDeps)
                     (HSet.fromList deps)
@@ -219,7 +230,8 @@
     -> [Key] -- ^ Previous direct dependencies of Id
     -> HashSet Key -- ^ Current direct dependencies of Id
     -> IO ()
-updateReverseDeps myId db prev new = uninterruptibleMask_ $ do
+-- mask to ensure that all the reverse dependencies are updated
+updateReverseDeps myId db prev new = do
     forM_ prev $ \d ->
         unless (d `HSet.member` new) $
             doOne (HSet.delete myId) d
@@ -247,20 +259,27 @@
             next <- lift $ atomically $ getReverseDependencies database x
             traverse_ loop (maybe mempty HSet.toList next)
 
--- | IO extended to track created asyncs to clean them up when the thread is killed,
---   generalizing 'withAsync'
+--------------------------------------------------------------------------------
+-- Asynchronous computations with cancellation
+
+-- | A simple monad to implement cancellation on top of 'Async',
+--   generalizing 'withAsync' to monadic scopes.
 newtype AIO a = AIO { unAIO :: ReaderT (IORef [Async ()]) IO a }
   deriving newtype (Applicative, Functor, Monad, MonadIO)
 
+-- | Run the monadic computation, cancelling all the spawned asyncs if an exception arises
 runAIO :: AIO a -> IO a
 runAIO (AIO act) = do
     asyncs <- newIORef []
     runReaderT act asyncs `onException` cleanupAsync asyncs
 
+-- | Like 'async' but with built-in cancellation.
+--   Returns an IO action to wait on the result.
 asyncWithCleanUp :: AIO a -> AIO (IO a)
 asyncWithCleanUp act = do
     st <- AIO ask
     io <- unliftAIO act
+    -- mask to make sure we keep track of the spawned async
     liftIO $ uninterruptibleMask $ \restore -> do
         a <- async $ restore io
         atomicModifyIORef'_ st (void a :)
@@ -279,28 +298,45 @@
     k $ RunInIO (\aio -> runReaderT (unAIO aio) st)
 
 cleanupAsync :: IORef [Async a] -> IO ()
-cleanupAsync ref = uninterruptibleMask_ $ do
-    asyncs <- readIORef ref
+-- mask to make sure we interrupt all the asyncs
+cleanupAsync ref = uninterruptibleMask $ \unmask -> do
+    asyncs <- atomicModifyIORef' ref ([],)
+    -- interrupt all the asyncs without waiting
     mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
-    mapM_ waitCatch asyncs
+    -- Wait until all the asyncs are done
+    -- But if it takes more than 10 seconds, log to stderr
+    unless (null asyncs) $ do
+        let warnIfTakingTooLong = unmask $ forever $ do
+                sleep 10
+                traceM "cleanupAsync: waiting for asyncs to finish"
+        withAsync warnIfTakingTooLong $ \_ ->
+            mapM_ waitCatch asyncs
 
-data Wait a
-    = Wait {justWait :: !a}
-    | Spawn {justWait :: !a}
-    deriving Functor
+data Wait
+    = Wait {justWait :: !(IO ())}
+    | Spawn {justWait :: !(IO ())}
 
-waitOrSpawn :: Wait (IO a) -> IO (Either (IO a) (Async a))
+fmapWait :: (IO () -> IO ()) -> Wait -> Wait
+fmapWait f (Wait io) = Wait (f io)
+fmapWait f (Spawn io) = Spawn (f io)
+
+waitOrSpawn :: Wait -> IO (Either (IO ()) (Async ()))
 waitOrSpawn (Wait io)  = pure $ Left io
 waitOrSpawn (Spawn io) = Right <$> async io
 
-mapConcurrentlyAIO_ :: (a -> IO ()) -> [Wait a] -> AIO ()
-mapConcurrentlyAIO_ _ [] = pure ()
-mapConcurrentlyAIO_ f [one] = liftIO $ justWait $ fmap f one
-mapConcurrentlyAIO_ f many = do
+waitConcurrently_ :: [Wait] -> AIO ()
+waitConcurrently_ [] = pure ()
+waitConcurrently_ [one] = liftIO $ justWait one
+waitConcurrently_ many = do
     ref <- AIO ask
-    waits <- liftIO $ uninterruptibleMask $ \restore -> do
-        waits <- liftIO $ traverse (waitOrSpawn . fmap (restore . f)) many
-        let asyncs = rights waits
+    -- spawn the async computations.
+    -- mask to make sure we keep track of all the asyncs.
+    (asyncs, syncs) <- liftIO $ uninterruptibleMask $ \unmask -> do
+        waits <- liftIO $ traverse (waitOrSpawn . fmapWait unmask) many
+        let (syncs, asyncs) = partitionEithers waits
         liftIO $ atomicModifyIORef'_ ref (asyncs ++)
-        return waits
-    liftIO $ traverse_ (either id wait) waits
+        return (asyncs, syncs)
+    -- work on the sync computations
+    liftIO $ sequence_ syncs
+    -- wait for the async computations before returning
+    liftIO $ traverse_ wait asyncs
diff --git a/src/Development/IDE/Graph/Internal/Options.hs b/src/Development/IDE/Graph/Internal/Options.hs
--- a/src/Development/IDE/Graph/Internal/Options.hs
+++ b/src/Development/IDE/Graph/Internal/Options.hs
@@ -5,16 +5,13 @@
 import           Development.IDE.Graph.Internal.Types
 
 data ShakeOptions = ShakeOptions {
-    -- | Has no effect, kept only for api compatibility with Shake
-    shakeThreads            :: Int,
-    shakeFiles              :: FilePath,
     shakeExtra              :: Maybe Dynamic,
     shakeAllowRedefineRules :: Bool,
     shakeTimings            :: Bool
     }
 
 shakeOptions :: ShakeOptions
-shakeOptions = ShakeOptions 0 ".shake" Nothing False False
+shakeOptions = ShakeOptions Nothing False False
 
 getShakeExtra :: Typeable a => Action (Maybe a)
 getShakeExtra = do
diff --git a/src/Development/IDE/Graph/Internal/Rules.hs b/src/Development/IDE/Graph/Internal/Rules.hs
--- a/src/Development/IDE/Graph/Internal/Rules.hs
+++ b/src/Development/IDE/Graph/Internal/Rules.hs
@@ -1,58 +1,57 @@
--- We deliberately want to ensure the function we add to the rule database
--- has the constraints we need on it when we get it out.
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-
-module Development.IDE.Graph.Internal.Rules where
-
-import           Control.Exception.Extra
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Reader
-import qualified Data.ByteString                      as BS
-import           Data.Dynamic
-import qualified Data.HashMap.Strict                  as Map
-import           Data.IORef
-import           Data.Maybe
-import           Data.Typeable
-import           Development.IDE.Graph.Classes
-import           Development.IDE.Graph.Internal.Types
-
--- | The type mapping between the @key@ or a rule and the resulting @value@.
---   See 'addBuiltinRule' and 'Development.Shake.Rule.apply'.
-type family RuleResult key -- = value
-
-action :: Action a -> Rules ()
-action x = do
-    ref <- Rules $ asks rulesActions
-    liftIO $ modifyIORef' ref (void x:)
-
-addRule
-    :: forall key value .
-       (RuleResult key ~ value, Typeable key, Hashable key, Eq key, Typeable value)
-    => (key -> Maybe BS.ByteString -> RunMode -> Action (RunResult value))
-    -> Rules ()
-addRule f = do
-    ref <- Rules $ asks rulesMap
-    liftIO $ modifyIORef' ref $ Map.insert (typeRep (Proxy :: Proxy key)) (toDyn f2)
-    where
-        f2 :: Key -> Maybe BS.ByteString -> RunMode -> Action (RunResult Value)
-        f2 (Key a) b c = do
-            v <- f (fromJust $ cast a :: key) b c
-            v <- liftIO $ evaluate v
-            pure $ Value . toDyn <$> v
-
-runRule
-    :: TheRules -> Key -> Maybe BS.ByteString -> RunMode -> Action (RunResult Value)
-runRule rules key@(Key t) bs mode = case Map.lookup (typeOf t) rules of
-    Nothing -> liftIO $ errorIO "Could not find key"
-    Just x  -> unwrapDynamic x key bs mode
-
-runRules :: Dynamic -> Rules () -> IO (TheRules, [Action ()])
-runRules rulesExtra (Rules rules) = do
-    rulesActions <- newIORef []
-    rulesMap <- newIORef Map.empty
-    runReaderT rules SRules{..}
-    (,) <$> readIORef rulesMap <*> readIORef rulesActions
+-- We deliberately want to ensure the function we add to the rule database
+-- has the constraints we need on it when we get it out.
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+
+module Development.IDE.Graph.Internal.Rules where
+
+import           Control.Exception.Extra
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+import qualified Data.ByteString                      as BS
+import           Data.Dynamic
+import qualified Data.HashMap.Strict                  as Map
+import           Data.IORef
+import           Data.Maybe
+import           Data.Typeable
+import           Development.IDE.Graph.Classes
+import           Development.IDE.Graph.Internal.Types
+
+-- | The type mapping between the @key@ or a rule and the resulting @value@.
+type family RuleResult key -- = value
+
+action :: Action a -> Rules ()
+action x = do
+    ref <- Rules $ asks rulesActions
+    liftIO $ modifyIORef' ref (void x:)
+
+addRule
+    :: forall key value .
+       (RuleResult key ~ value, Typeable key, Hashable key, Eq key, Typeable value)
+    => (key -> Maybe BS.ByteString -> RunMode -> Action (RunResult value))
+    -> Rules ()
+addRule f = do
+    ref <- Rules $ asks rulesMap
+    liftIO $ modifyIORef' ref $ Map.insert (typeRep (Proxy :: Proxy key)) (toDyn f2)
+    where
+        f2 :: Key -> Maybe BS.ByteString -> RunMode -> Action (RunResult Value)
+        f2 (Key a) b c = do
+            v <- f (fromJust $ cast a :: key) b c
+            v <- liftIO $ evaluate v
+            pure $ Value . toDyn <$> v
+
+runRule
+    :: TheRules -> Key -> Maybe BS.ByteString -> RunMode -> Action (RunResult Value)
+runRule rules key@(Key t) bs mode = case Map.lookup (typeOf t) rules of
+    Nothing -> liftIO $ errorIO "Could not find key"
+    Just x  -> unwrapDynamic x key bs mode
+
+runRules :: Dynamic -> Rules () -> IO (TheRules, [Action ()])
+runRules rulesExtra (Rules rules) = do
+    rulesActions <- newIORef []
+    rulesMap <- newIORef Map.empty
+    runReaderT rules SRules{..}
+    (,) <$> readIORef rulesMap <*> readIORef rulesActions
diff --git a/src/Development/IDE/Graph/Internal/Types.hs b/src/Development/IDE/Graph/Internal/Types.hs
--- a/src/Development/IDE/Graph/Internal/Types.hs
+++ b/src/Development/IDE/Graph/Internal/Types.hs
@@ -26,7 +26,7 @@
 import qualified Data.ByteString               as BS
 import           Data.Dynamic
 import qualified Data.HashMap.Strict           as Map
-import           Data.HashSet                  (HashSet)
+import           Data.HashSet                  (HashSet, member)
 import           Data.IORef
 import           Data.Maybe
 import           Data.Typeable
@@ -36,6 +36,8 @@
 import           StmContainers.Map             (Map)
 import qualified StmContainers.Map             as SMap
 import           System.Time.Extra             (Seconds)
+import qualified Data.HashSet as Set
+import Data.List (intercalate)
 
 
 unwrapDynamic :: forall a . Typeable a => Dynamic -> a
@@ -66,7 +68,8 @@
 
 data SAction = SAction {
     actionDatabase :: !Database,
-    actionDeps     :: !(IORef ResultDeps)
+    actionDeps     :: !(IORef ResultDeps),
+    actionStack    :: !Stack
     }
 
 getDatabase :: Action Database
@@ -75,6 +78,8 @@
 ---------------------------------------------------------------------
 -- DATABASE
 
+data ShakeDatabase = ShakeDatabase !Int [Action ()] Database
+
 newtype Step = Step Int
     deriving newtype (Eq,Ord,Hashable)
 
@@ -115,12 +120,12 @@
                   . databaseValues
 
 data Status
-    = Clean Result
+    = Clean !Result
     | Dirty (Maybe Result)
     | Running {
         runningStep   :: !Step,
         runningWait   :: !(IO ()),
-        runningResult :: Result,
+        runningResult :: Result,     -- LAZY
         runningPrev   :: !(Maybe Result)
         }
 
@@ -140,10 +145,11 @@
     resultVisited   :: !Step, -- ^ the step when it was last looked up
     resultDeps      :: !ResultDeps,
     resultExecution :: !Seconds, -- ^ How long it took, last time it ran
-    resultData      :: BS.ByteString
+    resultData      :: !BS.ByteString
     }
 
 data ResultDeps = UnknownDeps | AlwaysRerunDeps ![Key] | ResultDeps ![Key]
+  deriving (Eq, Show)
 
 getResultDepsDefault :: [Key] -> ResultDeps -> [Key]
 getResultDepsDefault _ (ResultDeps ids)      = ids
@@ -200,6 +206,54 @@
 instance NFData value => NFData (RunResult value) where
     rnf (RunResult x1 x2 x3) = rnf x1 `seq` x2 `seq` rnf x3
 
+---------------------------------------------------------------------
+-- EXCEPTIONS
+
+data GraphException = forall e. Exception e => GraphException {
+    target :: String, -- ^ The key that was being built
+    stack  :: [String], -- ^ The stack of keys that led to this exception
+    inner  :: e -- ^ The underlying exception
+}
+  deriving (Typeable, Exception)
+
+instance Show GraphException where
+    show GraphException{..} = unlines $
+        ["GraphException: " ++ target] ++
+        stack ++
+        ["Inner exception: " ++ show inner]
+
+fromGraphException :: Typeable b => SomeException -> Maybe b
+fromGraphException x = do
+    GraphException _ _ e <- fromException x
+    cast e
+
+---------------------------------------------------------------------
+-- CALL STACK
+
+data Stack = Stack [Key] !(HashSet Key)
+
+instance Show Stack where
+    show (Stack kk _) = "Stack: " <> intercalate " -> " (map show kk)
+
+newtype StackException = StackException Stack
+  deriving (Typeable, Show)
+
+instance Exception StackException where
+    fromException = fromGraphException
+    toException this@(StackException (Stack stack _)) = toException $
+        GraphException (show$ last stack) (map show stack) this
+
+addStack :: Key -> Stack -> Either StackException Stack
+addStack k (Stack ks is)
+    | k `member` is = Left $ StackException stack2
+    | otherwise = Right stack2
+    where stack2 = Stack (k:ks) (Set.insert k is)
+
+memberStack :: Key -> Stack -> Bool
+memberStack k (Stack _ ks) = k `member` ks
+
+emptyStack :: Stack
+emptyStack = Stack [] mempty
 ---------------------------------------------------------------------
 -- INSTANCES
 
diff --git a/src/Development/IDE/Graph/Rule.hs b/src/Development/IDE/Graph/Rule.hs
--- a/src/Development/IDE/Graph/Rule.hs
+++ b/src/Development/IDE/Graph/Rule.hs
@@ -7,7 +7,7 @@
     RunMode(..), RunChanged(..), RunResult(..),
     -- * Calling builtin rules
     -- | Wrappers around calling Shake rules. In general these should be specialised to a builtin rule.
-    apply, apply1,
+    apply, apply1, applyWithoutDependency
     ) where
 
 import           Development.IDE.Graph.Internal.Action
diff --git a/test/ActionSpec.hs b/test/ActionSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ActionSpec.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module ActionSpec where
+
+import Control.Concurrent.STM
+import Development.IDE.Graph (shakeOptions)
+import Development.IDE.Graph.Database (shakeNewDatabase, shakeRunDatabase)
+import Development.IDE.Graph.Internal.Action (apply1)
+import Development.IDE.Graph.Internal.Types
+import Development.IDE.Graph.Rule
+import Example
+import qualified StmContainers.Map as STM
+import Test.Hspec
+import System.Time.Extra (timeout)
+
+spec :: Spec
+spec = do
+  describe "apply1" $ do
+    it "computes a rule with no dependencies" $ do
+      db <- shakeNewDatabase shakeOptions $ do
+        ruleUnit
+      res <- shakeRunDatabase db $
+        pure $ do
+          apply1 (Rule @())
+      res `shouldBe` [()]
+    it "computes a rule with one dependency" $ do
+      db <- shakeNewDatabase shakeOptions $ do
+        ruleUnit
+        ruleBool
+      res <- shakeRunDatabase db $ pure $ apply1 Rule
+      res `shouldBe` [True]
+    it "tracks direct dependencies" $ do
+      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+        ruleUnit
+        ruleBool
+      let theKey = Rule @Bool
+      res <- shakeRunDatabase db $
+        pure $ do
+          apply1 theKey
+      res `shouldBe` [True]
+      Just (Clean res) <- lookup (Key theKey) <$> getDatabaseValues theDb
+      resultDeps res `shouldBe` ResultDeps [Key (Rule @())]
+    it "tracks reverse dependencies" $ do
+      db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase shakeOptions $ do
+        ruleUnit
+        ruleBool
+      let theKey = Rule @Bool
+      res <- shakeRunDatabase db $
+        pure $ do
+          apply1 theKey
+      res `shouldBe` [True]
+      Just KeyDetails {..} <- atomically $ STM.lookup (Key (Rule @())) databaseValues
+      keyReverseDeps `shouldBe` [Key theKey]
+    it "rethrows exceptions" $ do
+      db <- shakeNewDatabase shakeOptions $ do
+        addRule $ \(Rule :: Rule ()) old mode -> error "boom"
+      let res = shakeRunDatabase db $ pure $ apply1 (Rule @())
+      res `shouldThrow` anyErrorCall
+  describe "applyWithoutDependency" $ do
+    it "does not track dependencies" $ do
+      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+        ruleUnit
+        addRule $ \Rule old mode -> do
+            [()] <- applyWithoutDependency [Rule]
+            return $ RunResult ChangedRecomputeDiff "" True
+
+      let theKey = Rule @Bool
+      res <- shakeRunDatabase db $
+        pure $ do
+          applyWithoutDependency [theKey]
+      res `shouldBe` [[True]]
+      Just (Clean res) <- lookup (Key theKey) <$> getDatabaseValues theDb
+      resultDeps res `shouldBe` UnknownDeps
diff --git a/test/DatabaseSpec.hs b/test/DatabaseSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/DatabaseSpec.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module DatabaseSpec where
+
+import Control.Concurrent.STM
+import Development.IDE.Graph (shakeOptions)
+import Development.IDE.Graph.Database (shakeNewDatabase, shakeRunDatabase)
+import Development.IDE.Graph.Internal.Action (apply1)
+import Development.IDE.Graph.Internal.Types
+import Development.IDE.Graph.Rule
+import Example
+import qualified StmContainers.Map as STM
+import Test.Hspec
+import System.Time.Extra (timeout)
+
+spec :: Spec
+spec = do
+    describe "Evaluation" $ do
+        it "detects cycles" $ do
+            db <- shakeNewDatabase shakeOptions $ do
+                ruleBool
+                addRule $ \Rule old mode -> do
+                    True <- apply1 (Rule @Bool)
+                    return $ RunResult ChangedRecomputeDiff "" ()
+            let res = shakeRunDatabase db $ pure $ apply1 (Rule @())
+            timeout 1 res `shouldThrow` \StackException{} -> True
diff --git a/test/Example.hs b/test/Example.hs
new file mode 100644
--- /dev/null
+++ b/test/Example.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+module Example where
+
+import Development.IDE.Graph
+import Development.IDE.Graph.Rule
+import Development.IDE.Graph.Classes
+import GHC.Generics
+import Type.Reflection (typeRep)
+
+data Rule a = Rule
+    deriving (Eq, Generic, Hashable, NFData)
+
+instance Typeable a => Show (Rule a) where
+    show Rule = show $ typeRep @a
+
+type instance RuleResult (Rule a) = a
+
+ruleUnit :: Rules ()
+ruleUnit = addRule $ \(Rule :: Rule ()) old mode -> do
+    return $ RunResult ChangedRecomputeDiff "" ()
+
+-- | Depends on Rule @()
+ruleBool :: Rules ()
+ruleBool = addRule $ \Rule old mode -> do
+    () <- apply1 Rule
+    return $ RunResult ChangedRecomputeDiff "" True
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,7 @@
+import qualified Spec
+import Test.Tasty
+import Test.Tasty.Hspec
+import Test.Tasty.Ingredients.Rerun (defaultMainWithRerun)
+
+main :: IO ()
+main = testSpecs Spec.spec >>= defaultMainWithRerun . testGroup "tactics"
diff --git a/test/RulesSpec.hs b/test/RulesSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/RulesSpec.hs
@@ -0,0 +1,8 @@
+module RulesSpec where
+
+import Test.Hspec
+
+spec :: Spec
+spec = do
+    describe "" $ do
+        pure ()
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}