diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,11 @@
 Changelog for Shake (* = breaking change)
 
+0.18, released 2019-05-14
+*   Make files copied to the shared cache read-only
+    Delete files before writing, giving symlink/readonly safety
+    #677, make --help work even if the build system throws errors
+*   Use parallelism for Applicative adjacent needs
+    Support GHC 8.8
 0.17.9, released 2019-05-01
     #675, allow --compact=yes|no|auto
     Make lintTrackAllow work after the lintTrackRead/Write
diff --git a/shake.cabal b/shake.cabal
--- a/shake.cabal
+++ b/shake.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.18
 build-type:         Simple
 name:               shake
-version:            0.17.9
+version:            0.18
 license:            BSD3
 license-file:       LICENSE
 category:           Development, Shake
@@ -84,7 +84,7 @@
         binary,
         bytestring,
         deepseq >= 1.1,
-        directory,
+        directory >= 1.2.7.0,
         extra >= 1.6.14,
         filepath,
         filepattern,
diff --git a/src/Development/Shake/Command.hs b/src/Development/Shake/Command.hs
--- a/src/Development/Shake/Command.hs
+++ b/src/Development/Shake/Command.hs
@@ -21,6 +21,7 @@
 import Data.Tuple.Extra
 import Control.Monad.Extra
 import Control.Monad.IO.Class
+import Control.Exception.Extra
 import Data.Char
 import Data.Either.Extra
 import Data.List.Extra
@@ -190,7 +191,7 @@
     | not $ isFSATrace params = call params
     | ResultProcess PID0 `elem` results =
         -- This is a bad state to get into, you could technically just ignore the tracing, but that's a bit dangerous
-        fail "Asyncronous process execution combined with FSATrace is not support"
+        liftIO $ errorIO "Asyncronous process execution combined with FSATrace is not support"
     | otherwise = runWithTempDir $ \dir -> do
         let file = dir </> "fsatrace.txt"
         liftIO $ writeFile file "" -- ensures even if we fail before fsatrace opens the file, we can still read it
diff --git a/src/Development/Shake/Internal/Args.hs b/src/Development/Shake/Internal/Args.hs
--- a/src/Development/Shake/Internal/Args.hs
+++ b/src/Development/Shake/Internal/Args.hs
@@ -19,11 +19,13 @@
 import Development.Shake.Internal.Progress
 import Development.Shake.Database
 import General.Timing
+import General.Extra
 import General.Thread
 import General.GetOpt
 import General.EscCodes
 
 import Data.Tuple.Extra
+import Control.DeepSeq
 import Control.Exception.Extra
 import Control.Monad
 import Data.Either
@@ -158,14 +160,15 @@
     let putWhenLn v msg = putWhen v $ msg ++ "\n"
     let showHelp long = do
             progName <- getProgName
-            targets <- if not long then return [] else do
-                -- run the rules as simply as we can
-                rs <- rules shakeOpts [] []
-                case rs of
-                    Just (_, rs) -> do
-                        xs <- getTargets shakeOpts rs
-                        return ["  - " ++ a ++ maybe "" (" - " ++) b | (a,b) <- xs]
-                    _ -> return []
+            targets <- if not long then return [] else
+                handleSynchronous (\e -> do putWhenLn Normal $ "Failure to collect targets: " ++ show e; return []) $ do
+                    -- run the rules as simply as we can
+                    rs <- rules shakeOpts [] []
+                    case rs of
+                        Just (_, rs) -> do
+                            xs <- getTargets shakeOpts rs
+                            evaluate $ force ["  - " ++ a ++ maybe "" (" - " ++) b | (a,b) <- xs]
+                        _ -> return []
             changes <- return $
                 let as = shakeOptionsFields baseOpts
                     bs = shakeOptionsFields oshakeOpts
diff --git a/src/Development/Shake/Internal/Core/Build.hs b/src/Development/Shake/Internal/Core/Build.hs
--- a/src/Development/Shake/Internal/Core/Build.hs
+++ b/src/Development/Shake/Internal/Core/Build.hs
@@ -4,6 +4,7 @@
 module Development.Shake.Internal.Core.Build(
     getDatabaseValue, getDatabaseValueGeneric,
     historyIsEnabled, historySave, historyLoad,
+    applyKeyValue,
     apply, apply1,
     ) where
 
@@ -141,12 +142,18 @@
 -- ACTUAL WORKERS
 
 applyKeyValue :: [String] -> [Key] -> Action [Value]
-applyKeyValue _ [] = return []
 applyKeyValue callStack ks = do
+    -- this is the only place a user can inject a key into our world, so check they aren't throwing
+    -- in unevaluated bottoms
+    liftIO $ mapM_ (evaluate . rnf) ks
+
     global@Global{..} <- Action getRO
-    Local{localStack} <- Action getRW
+    Local{localStack, localBlockApply} <- Action getRW
     let stack = addCallStack callStack localStack
 
+    let tk = typeKey $ head $ ks ++ [newKey ()] -- always called at non-empty so never see () key
+    whenJust localBlockApply $ throwM . errorNoApply tk (show <$> listToMaybe ks)
+
     let database = globalDatabase
     (is, wait) <- liftIO $ runLocked database $ do
         is <- mapM (mkId database) ks
@@ -223,16 +230,11 @@
 --   This function requires that appropriate rules have been added with 'addBuiltinRule'.
 --   All @key@ values passed to 'apply' become dependencies of the 'Action'.
 apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
--- Don't short-circuit [] as we still want error messages
-apply ks = do
-    -- this is the only place a user can inject a key into our world, so check they aren't throwing
-    -- in unevaluated bottoms
-    liftIO $ mapM_ (evaluate . rnf) ks
-
-    let tk = typeRep ks
-    Local{localBlockApply} <- Action getRW
-    whenJust localBlockApply $ throwM . errorNoApply tk (show <$> listToMaybe ks)
-    fmap (map fromValue) $ applyKeyValue callStackFull $ map newKey ks
+apply [] =
+    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not
+    return []
+apply ks =
+    fmap (map fromValue) $ Action $ stepRAW (callStackFull, map newKey ks)
 
 
 -- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,
diff --git a/src/Development/Shake/Internal/Core/Monad.hs b/src/Development/Shake/Internal/Core/Monad.hs
--- a/src/Development/Shake/Internal/Core/Monad.hs
+++ b/src/Development/Shake/Internal/Core/Monad.hs
@@ -1,14 +1,16 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GADTs, ScopedTypeVariables, TupleSections #-}
+{-# LANGUAGE GADTs, ScopedTypeVariables, TupleSections, GeneralizedNewtypeDeriving #-}
 
 module Development.Shake.Internal.Core.Monad(
     RAW, Capture, runRAW,
     getRO, getRW, putRW, modifyRW,
+    stepRAW,
     catchRAW, tryRAW, throwRAW, finallyRAW,
     captureRAW,
     ) where
 
 import Control.Exception.Extra
+import Development.Shake.Internal.Errors
 import Control.Monad.IO.Class
 import Data.IORef
 import Control.Monad
@@ -21,45 +23,46 @@
 #endif
 
 
-data RAW ro rw a where
-    Fmap :: (a -> b) -> RAW ro rw a -> RAW ro rw b
-    Pure :: a -> RAW ro rw a
-    Ap :: RAW ro rw (a -> b) -> RAW ro rw a -> RAW ro rw b
-    Next :: RAW ro rw a -> RAW ro rw b -> RAW ro rw b
-    Bind :: RAW ro rw a -> (a -> RAW ro rw b) -> RAW ro rw b
-    LiftIO :: IO a -> RAW ro rw a
-    GetRO :: RAW ro rw ro
-    GetRW :: RAW ro rw rw
-    PutRW :: !rw -> RAW ro rw ()
-    ModifyRW :: (rw -> rw) -> RAW ro rw ()
-    CaptureRAW :: Capture (Either SomeException a) -> RAW ro rw a
-    CatchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
+data RAW k v ro rw a where
+    Fmap :: (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
+    Pure :: a -> RAW k v ro rw a
+    Ap :: RAW k v ro rw (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b
+    Next :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b
+    Bind :: RAW k v ro rw a -> (a -> RAW k v ro rw b) -> RAW k v ro rw b
+    LiftIO :: IO a -> RAW k v ro rw a
+    GetRO :: RAW k v ro rw ro
+    GetRW :: RAW k v ro rw rw
+    PutRW :: !rw -> RAW k v ro rw ()
+    ModifyRW :: (rw -> rw) -> RAW k v ro rw ()
+    StepRAW :: k -> RAW k v ro rw v
+    CaptureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a
+    CatchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
 
-instance Functor (RAW ro rw) where
+instance Functor (RAW k v ro rw) where
     fmap = Fmap
 
-instance Applicative (RAW ro rw) where
+instance Applicative (RAW k v ro rw) where
     pure = Pure
     (*>) = Next
     (<*>) = Ap
 
-instance Monad (RAW ro rw) where
+instance Monad (RAW k v ro rw) where
     return = pure
     (>>) = (*>)
     (>>=) = Bind
 
-instance MonadIO (RAW ro rw) where
+instance MonadIO (RAW k v ro rw) where
     liftIO = LiftIO
 
 #if __GLASGOW_HASKELL__ >= 800
-instance MonadFail (RAW ro rw) where
+instance MonadFail (RAW k v ro rw) where
     fail = liftIO . Control.Monad.Fail.fail
 #endif
 
-instance Semigroup a => Semigroup (RAW ro rw a) where
+instance Semigroup a => Semigroup (RAW k v ro rw a) where
     (<>) a b = (<>) <$> a <*> b
 
-instance (Semigroup a, Monoid a) => Monoid (RAW ro rw a) where
+instance (Semigroup a, Monoid a) => Monoid (RAW k v ro rw a) where
     mempty = pure mempty
     mappend = (<>)
 
@@ -84,48 +87,66 @@
             k v
 
 -- | Run and then call a continuation.
-runRAW :: ro -> rw -> RAW ro rw a -> Capture (Either SomeException a)
-runRAW ro rw m k = do
+runRAW :: ([k] -> RAW k v ro rw [v]) -> ro -> rw -> RAW k v ro rw a -> Capture (Either SomeException a)
+runRAW step ro rw m k = do
     k <- assertOnce "runRAW" k
     rw <- newIORef rw
     handler <- newIORef throwIO
+    steps <- newSteps
     writeIORef handler $ \e -> do
         -- make sure we never call the error continuation twice
         writeIORef handler throwIO
         k $ Left e
     -- If the continuation itself throws an error we need to make sure we
     -- don't end up running it twice (once with its result, once with its own exception)
-    goRAW handler ro rw m (\v -> do writeIORef handler throwIO; k $ Right v)
+    goRAW step steps handler ro rw m (\v -> do writeIORef handler throwIO; k $ Right v)
         `catch_` \e -> ($ e) =<< readIORef handler
 
 
-goRAW :: forall ro rw a . IORef (SomeException -> IO ()) -> ro -> IORef rw -> RAW ro rw a -> Capture a
-goRAW handler ro rw = go
+goRAW :: forall k v ro rw a . ([k] -> RAW k v ro rw [v]) -> Steps k v -> IORef (SomeException -> IO ()) -> ro -> IORef rw -> RAW k v ro rw a -> Capture a
+goRAW step steps handler ro rw = \x k -> go x $ \v -> sio v k
     where
-        go :: RAW ro rw b -> Capture b
+        sio :: SIO b -> Capture b
+        sio (SIO v) k = flush $ do v <- v; k v
+
+        flush :: IO () -> IO ()
+        flush k = do
+            v <- flushSteps steps
+            case v of
+                Nothing -> k
+                Just f -> go (f step) $ const k
+
+        unflush :: IO ()
+        unflush = unflushSteps steps
+
+        go :: RAW k v ro rw b -> Capture (SIO b)
         go x k = case x of
-            Fmap f a -> go a $ \v -> k $ f v
-            Pure a -> k a
-            Ap f x -> go f $ \f -> go x $ \v -> k $ f v
-            Bind a b -> go a $ \a -> go (b a) k
-            Next a b -> go a $ \_ -> go b k
-            LiftIO x -> k =<< x
+            Fmap f a -> go a $ \v -> k $ fmap f v
+            Pure a -> k $ pure a
+            Ap f x -> go f $ \f -> go x $ \v -> k $ f <*> v
+            Next a b -> go a $ \a -> go b $ \b -> k $ a *> b
+            StepRAW q -> do
+                v <- addStep steps q
+                k v
 
-            GetRO -> k ro
-            GetRW -> k =<< readIORef rw
-            PutRW x -> writeIORef rw x >> k ()
-            ModifyRW f -> modifyIORef' rw f >> k ()
+            Bind a b -> go a $ \a -> sio a $ \a -> go (b a) k
+            LiftIO act -> flush $ do v <- act; k $ pure v
 
-            CatchRAW m hdl -> do
+            GetRO -> k $ return ro
+            GetRW -> flush $ k . return =<< readIORef rw
+            PutRW x -> flush $ writeIORef rw x >> k (return ())
+            ModifyRW f -> flush $ modifyIORef' rw f >> k (return ())
+
+            CatchRAW m hdl -> flush $ do
                 hdl <- assertOnce "CatchRAW" hdl
                 old <- readIORef handler
                 writeIORef handler $ \e -> do
                     writeIORef handler old
                     go (hdl e) k `catch_`
-                        \e -> ($ e) =<< readIORef handler
+                        \e -> do unflush; ($ e) =<< readIORef handler
                 go m $ \x -> writeIORef handler old >> k x
 
-            CaptureRAW f -> do
+            CaptureRAW f -> flush $ do
                 f <- assertOnce "CaptureRAW" f
                 old <- readIORef handler
                 writeIORef handler throwIO
@@ -133,41 +154,71 @@
                     Left e -> old e
                     Right v -> do
                         writeIORef handler old
-                        k v `catch_` \e -> ($ e) =<< readIORef handler
+                        k (return v) `catch_` \e -> do unflush; ($ e) =<< readIORef handler
 
 
+newtype SIO a = SIO (IO a)
+    deriving (Functor, Monad, Applicative)
+
+
+newtype Steps k v = Steps (IORef [(k, IORef v)])
+
+newSteps :: IO (Steps k v)
+newSteps = Steps <$> newIORef []
+
+addStep :: Steps k v -> k -> IO (SIO v)
+addStep (Steps ref) k = do
+    out <- newIORef $ throwImpure $ errorInternal "Monad, addStep not flushed"
+    modifyIORef ref ((k,out):)
+    return $ SIO $ readIORef out
+
+unflushSteps :: Steps k v -> IO ()
+unflushSteps (Steps ref) = writeIORef ref []
+
+flushSteps :: MonadIO m => Steps k v -> IO (Maybe (([k] -> m [v]) -> m ()))
+flushSteps (Steps ref) = do
+    v <- reverse <$> readIORef ref
+    case v of
+        [] -> return Nothing
+        xs -> do
+            writeIORef ref []
+            return $ Just $ \step -> do
+                vs <- step $ map fst xs
+                liftIO $ zipWithM_ writeIORef (map snd xs) vs
+
+
 ---------------------------------------------------------------------
 -- STANDARD
 
-getRO :: RAW ro rw ro
+getRO :: RAW k v ro rw ro
 getRO = GetRO
 
-getRW :: RAW ro rw rw
+getRW :: RAW k v ro rw rw
 getRW = GetRW
 
 -- | Strict version
-putRW :: rw -> RAW ro rw ()
+putRW :: rw -> RAW k v ro rw ()
 putRW = PutRW
 
-modifyRW :: (rw -> rw) -> RAW ro rw ()
+modifyRW :: (rw -> rw) -> RAW k v ro rw ()
 modifyRW = ModifyRW
 
 
 ---------------------------------------------------------------------
 -- EXCEPTIONS
 
-catchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a
+catchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
 catchRAW = CatchRAW
 
-tryRAW :: RAW ro rw a -> RAW ro rw (Either SomeException a)
+tryRAW :: RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
 tryRAW m = catchRAW (fmap Right m) (return . Left)
 
-throwRAW :: Exception e => e -> RAW ro rw a
+throwRAW :: Exception e => e -> RAW k v ro rw a
 -- Note that while we could directly pass this to the handler
 -- that would avoid triggering the catch, which would mean they built up on the stack
 throwRAW = liftIO . throwIO
 
-finallyRAW :: RAW ro rw a -> RAW ro rw b -> RAW ro rw a
+finallyRAW :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw a
 finallyRAW a undo = do
     r <- catchRAW a (\e -> undo >> throwRAW e)
     undo
@@ -179,5 +230,12 @@
 
 -- | Capture a continuation. The continuation should be called at most once.
 --   Calling the same continuation, multiple times, in parallel, results in incorrect behaviour.
-captureRAW :: Capture (Either SomeException a) -> RAW ro rw a
+captureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a
 captureRAW = CaptureRAW
+
+
+---------------------------------------------------------------------
+-- STEPS
+
+stepRAW :: k -> RAW k v ro rw v
+stepRAW = StepRAW
diff --git a/src/Development/Shake/Internal/Core/Run.hs b/src/Development/Shake/Internal/Core/Run.hs
--- a/src/Development/Shake/Internal/Core/Run.hs
+++ b/src/Development/Shake/Internal/Core/Run.hs
@@ -21,6 +21,7 @@
 import General.Binary
 import Development.Shake.Classes
 import Development.Shake.Internal.Core.Storage
+import Development.Shake.Internal.Core.Build
 import Development.Shake.Internal.History.Shared
 import Development.Shake.Internal.History.Cloud
 import qualified General.TypeMap as TMap
@@ -140,7 +141,7 @@
             addTiming "Running rules"
             locals <- newIORef []
             runPool (shakeThreads == 1) shakeThreads $ \pool -> do
-                let global = Global database pool cleanup start ruleinfo output opts diagnostic ruleFinished after absent getProgress userRules shared cloud step oneshot
+                let global = Global applyKeyValue database pool cleanup start ruleinfo output opts diagnostic ruleFinished after absent getProgress userRules shared cloud step oneshot
                 -- give each action a stack to start with!
                 forM_ (actions ++ map (emptyStack,) actions2) $ \(stack, act) -> do
                     let local = newLocal stack shakeVerbosity
diff --git a/src/Development/Shake/Internal/Core/Types.hs b/src/Development/Shake/Internal/Core/Types.hs
--- a/src/Development/Shake/Internal/Core/Types.hs
+++ b/src/Development/Shake/Internal/Core/Types.hs
@@ -60,7 +60,7 @@
 -- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'Development.Shake.need' to execute files.
 --   Action values are used by 'addUserRule' and 'action'. The 'Action' monad tracks the dependencies of a rule.
 --   To raise an exception call 'error', 'fail' or @'liftIO' . 'throwIO'@.
-newtype Action a = Action {fromAction :: RAW Global Local a}
+newtype Action a = Action {fromAction :: RAW ([String],[Key]) [Value] Global Local a}
     deriving (Functor, Applicative, Monad, MonadIO, Typeable, Semigroup, Monoid
 #if __GLASGOW_HASKELL__ >= 800
              ,MonadFail
@@ -68,7 +68,15 @@
         )
 
 runAction :: Global -> Local -> Action a -> Capture (Either SomeException a)
-runAction g l (Action x) = runRAW g l x
+runAction g l (Action x) = runRAW (fromAction . build) g l x
+    where
+        -- first argument is a list of call stacks, since build only takes one we use the first
+        -- they are very probably all identical...
+        build :: [([String], [Key])] -> Action [[Value]]
+        build [] = return []
+        build ks@((callstack,_):_) = do
+            let kss = map snd ks
+            unconcat kss <$> globalBuild g callstack (concat kss)
 
 
 ---------------------------------------------------------------------
@@ -386,7 +394,8 @@
 
 -- global constants of Action
 data Global = Global
-    {globalDatabase :: Database -- ^ Database, contains knowledge of the state of each key
+    {globalBuild :: [String] -> [Key] -> Action [Value]
+    ,globalDatabase :: Database -- ^ Database, contains knowledge of the state of each key
     ,globalPool :: Pool -- ^ Pool, for queuing new elements
     ,globalCleanup :: Cleanup -- ^ Cleanup operations
     ,globalTimestamp :: IO Seconds -- ^ Clock saying how many seconds through the build
diff --git a/src/Development/Shake/Internal/Derived.hs b/src/Development/Shake/Internal/Derived.hs
--- a/src/Development/Shake/Internal/Derived.hs
+++ b/src/Development/Shake/Internal/Derived.hs
@@ -87,18 +87,19 @@
 -- | @copyFile' old new@ copies the existing file from @old@ to @new@.
 --   The @old@ file will be tracked as a dependency.
 --   Also creates the new directory if necessary.
-copyFile' :: FilePath -> FilePath -> Action ()
+copyFile' :: Partial => FilePath -> FilePath -> Action ()
 copyFile' old new = do
     need [old]
     putLoud $ "Copying from " ++ old ++ " to " ++ new
     liftIO $ do
         createDirectoryRecursive $ takeDirectory new
+        removeFile_ new -- symlink safety
         copyFile old new
 
 -- | @copyFileChanged old new@ copies the existing file from @old@ to @new@, if the contents have changed.
 --   The @old@ file will be tracked as a dependency.
 --   Also creates the new directory if necessary.
-copyFileChanged :: FilePath -> FilePath -> Action ()
+copyFileChanged :: Partial => FilePath -> FilePath -> Action ()
 copyFileChanged old new = do
     need [old]
     -- in newer versions of the directory package we can use copyFileWithMetadata which (we think) updates
@@ -108,32 +109,34 @@
         liftIO $ do
             createDirectoryRecursive $ takeDirectory new
             -- copyFile does a lot of clever stuff with permissions etc, so make sure we just reuse it
+            removeFile_ new -- symlink safety
             liftIO $ copyFile old new
 
 
 -- | Read a file, after calling 'need'. The argument file will be tracked as a dependency.
-readFile' :: FilePath -> Action String
+readFile' :: Partial => FilePath -> Action String
 readFile' x = need [x] >> liftIO (readFile x)
 
 -- | Write a file, lifted to the 'Action' monad.
-writeFile' :: MonadIO m => FilePath -> String -> m ()
+writeFile' :: (MonadIO m, Partial) => FilePath -> String -> m ()
 writeFile' name x = liftIO $ do
     createDirectoryRecursive $ takeDirectory name
+    removeFile_ x -- symlink safety
     writeFile name x
 
 
 -- | A version of 'readFile'' which also splits the result into lines.
 --   The argument file will be tracked as a dependency.
-readFileLines :: FilePath -> Action [String]
+readFileLines :: Partial => FilePath -> Action [String]
 readFileLines = fmap lines . readFile'
 
 -- | A version of 'writeFile'' which writes out a list of lines.
-writeFileLines :: MonadIO m => FilePath -> [String] -> m ()
+writeFileLines :: (MonadIO m, Partial) => FilePath -> [String] -> m ()
 writeFileLines name = writeFile' name . unlines
 
 
 -- | Write a file, but only if the contents would change.
-writeFileChanged :: MonadIO m => FilePath -> String -> m ()
+writeFileChanged :: (MonadIO m, Partial) => FilePath -> String -> m ()
 writeFileChanged name x = liftIO $ do
     createDirectoryRecursive $ takeDirectory name
     b <- doesFileExist name
@@ -143,7 +146,9 @@
         b <- withFile name ReadMode $ \h -> do
             src <- hGetContents h
             return $! src /= x
-        when b $ writeFile name x
+        when b $ do
+            removeFile_ x -- symlink safety
+            writeFile name x
 
 
 -- | Create a temporary file in the temporary directory. The file will be deleted
diff --git a/src/Development/Shake/Internal/History/Shared.hs b/src/Development/Shake/Internal/History/Shared.hs
--- a/src/Development/Shake/Internal/History/Shared.hs
+++ b/src/Development/Shake/Internal/History/Shared.hs
@@ -150,7 +150,7 @@
         -- if any key matches, clean them all out
         b <- flip anyM files $ \file -> handleSynchronous (\e -> putStrLn ("Warning: " ++ show e) >> return False) $
             evaluate . test . entryKey . getEntry keyOp =<< BS.readFile file
-        when b $ removeDirectoryRecursive dir
+        when b $ removePathForcibly dir
         return b
     liftIO $ putStrLn $ "Deleted " ++ show (length (filter id deleted)) ++ " entries"
 
diff --git a/src/Development/Shake/Internal/History/Symlink.hs b/src/Development/Shake/Internal/History/Symlink.hs
--- a/src/Development/Shake/Internal/History/Symlink.hs
+++ b/src/Development/Shake/Internal/History/Symlink.hs
@@ -47,8 +47,7 @@
     b <- createLinkBool from to
     whenJust b $ \_ ->
         copyFile from to
-    -- making files read only stops them from easily deleting
-    when False $
-        forM_ [from, to] $ \x -> do
-            perm <- getPermissions x
-            setPermissions x perm{writable=False}
+    -- making files read only stops them from inadvertantly mutating the cache
+    forM_ [from, to] $ \x -> do
+        perm <- getPermissions x
+        setPermissions x perm{writable=False}
diff --git a/src/General/Extra.hs b/src/General/Extra.hs
--- a/src/General/Extra.hs
+++ b/src/General/Extra.hs
@@ -9,6 +9,7 @@
     wrapQuote, showBracket,
     withs, forNothingM,
     maximum', maximumBy',
+    unconcat,
     fastAt,
     zipExact, zipWithExact,
     isAsyncException,
@@ -32,6 +33,7 @@
 import Control.DeepSeq
 import General.Cleanup
 import Data.Typeable
+import System.IO.Error
 import System.IO.Extra
 import System.Time.Extra
 import System.IO.Unsafe
@@ -66,7 +68,12 @@
 newtype NoShow a = NoShow a
 instance Show (NoShow a) where show _ = "NoShow"
 
+unconcat :: [[a]] -> [b] -> [[b]]
+unconcat [] _ = []
+unconcat (a:as) bs = b1 : unconcat as b2
+    where (b1,b2) = splitAt (length a) bs
 
+
 ---------------------------------------------------------------------
 -- Data.List
 
@@ -235,7 +242,13 @@
 
 -- | Remove a file, but don't worry if it fails
 removeFile_ :: FilePath -> IO ()
-removeFile_ x = removeFile x `catchIO` \_ -> return ()
+removeFile_ x =
+    removeFile x `catchIO` \e ->
+        when (isPermissionError e) $ handleIO (\_ -> return ()) $ do
+            perms <- getPermissions x
+            setPermissions x perms{readable = True, searchable = True, writable = True}
+            removeFile x
+
 
 -- | Like @createDirectoryIfMissing True@ but faster, as it avoids
 --   any work in the common case the directory already exists.
diff --git a/src/General/ListBuilder.hs b/src/General/ListBuilder.hs
--- a/src/General/ListBuilder.hs
+++ b/src/General/ListBuilder.hs
@@ -1,34 +1,50 @@
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
 
 module General.ListBuilder(
-    ListBuilder, runListBuilder, newListBuilder
+    ListBuilder, runListBuilder, newListBuilder,
+    Tree(..), flattenTree, unflattenTree
     ) where
 
 import Data.Semigroup (Semigroup (..))
 
+-- ListBuilder is opaque outside this module
+newtype ListBuilder a = ListBuilder (Tree a)
+    deriving (Semigroup, Monoid, Functor)
 
-data ListBuilder a
-    = Zero
-    | One a
-    | Add (ListBuilder a) (ListBuilder a)
-      deriving Functor
+data Tree a
+    = Empty
+    | Leaf a
+    | Branch (Tree a) (Tree a)
+      deriving (Functor,Eq,Ord,Show)
 
 
-instance Semigroup (ListBuilder a) where
-    Zero <> x = x
-    x <> Zero = x
-    x <> y = Add x y
+instance Semigroup (Tree a) where
+    Empty <> x = x
+    x <> Empty = x
+    x <> y = Branch x y
 
-instance Monoid (ListBuilder a) where
-    mempty = Zero
+instance Monoid (Tree a) where
+    mempty = Empty
     mappend = (<>)
 
+flattenTree :: Tree a -> [a]
+flattenTree x = f x []
+    where
+        f Empty acc = acc
+        f (Leaf x) acc = x : acc
+        f (Branch x y) acc = f x (f y acc)
+
+unflattenTree :: Tree a -> [b] -> Tree b
+unflattenTree t xs = fst $ f t xs
+    where
+        f Empty xs = (Empty, xs)
+        f Leaf{} (x:xs) = (Leaf x, xs)
+        f (Branch a b) xs = (Branch a2 b2, xs3)
+            where (a2, xs2) = f a xs
+                  (b2, xs3) = f b xs2
+
 newListBuilder :: a -> ListBuilder a
-newListBuilder = One
+newListBuilder = ListBuilder . Leaf
 
 runListBuilder :: ListBuilder a -> [a]
-runListBuilder x = f x []
-    where
-        f Zero acc = acc
-        f (One x) acc = x : acc
-        f (Add x y) acc = f x (f y acc)
+runListBuilder (ListBuilder x) = flattenTree x
diff --git a/src/Test/Docs.hs b/src/Test/Docs.hs
--- a/src/Test/Docs.hs
+++ b/src/Test/Docs.hs
@@ -4,6 +4,7 @@
 
 import Development.Shake
 import Development.Shake.FilePath
+import qualified System.FilePattern.Directory as IO
 import System.Directory
 import Test.Type
 import Control.Monad
@@ -143,7 +144,7 @@
     "Files.lst" %> \out -> do
         need [shakeRoot </> "src/Test/Docs.hs"] -- so much of the generator is in this module
         need [index]
-        filesHs <- getDirectoryFiles "dist/doc/html/shake" ["Development-*.html"]
+        filesHs <- liftIO $ IO.getDirectoryFiles "dist/doc/html/shake" ["Development-*.html"]
         -- filesMd on Travis will only include Manual.md, since it's the only one listed in the .cabal
         -- On AppVeyor, where we build from source, it will check the rest of the website
         filesMd <- getDirectoryFiles (shakeRoot </> "docs") ["*.md"]
@@ -334,7 +335,7 @@
 whitelist x | elem x $ words $
     "newtype do a q m c x value key os contents clean _make " ++
     ".. /. // \\ //* dir/*/* dir [ " ++
-    "ConstraintKinds TemplateHaskell OverloadedLists OverloadedStrings GeneralizedNewtypeDeriving DeriveDataTypeable TypeFamilies SetConsoleTitle " ++
+    "ConstraintKinds TemplateHaskell ApplicativeDo OverloadedLists OverloadedStrings GeneralizedNewtypeDeriving DeriveDataTypeable TypeFamilies SetConsoleTitle " ++
     "Data.List System.Directory Development.Shake.FilePath run " ++
     "NoProgress Error src about://tracing " ++
     ".make/i586-linux-gcc/output build " ++
diff --git a/src/Test/History.hs b/src/Test/History.hs
--- a/src/Test/History.hs
+++ b/src/Test/History.hs
@@ -4,6 +4,7 @@
 
 import Development.Shake
 import Test.Type
+import General.Extra
 import General.GetOpt
 import System.Directory
 
@@ -51,7 +52,7 @@
     checkOut "1"
 
     setIn "2"
-    mapM_ removeFile outs
+    mapM_ removeFile_ outs
     build $ ["--die","--share"] ++ outs
     checkOut "2"
 
diff --git a/src/Test/Monad.hs b/src/Test/Monad.hs
--- a/src/Test/Monad.hs
+++ b/src/Test/Monad.hs
@@ -14,10 +14,10 @@
 
 
 
-run :: ro -> rw -> RAW ro rw a -> IO a
+run :: ro -> rw -> RAW () () ro rw a -> IO a
 run ro rw m = do
     res <- newEmptyMVar
-    runRAW ro rw m $ void . tryPutMVar res
+    runRAW return ro rw m $ void . tryPutMVar res
     either throwIO return =<< readMVar res
 
 
@@ -74,7 +74,7 @@
         return "x"
     res === Left Overflow
     -- test for GHC bug 11555
-    runRAW 1 "test" (throw Overflow :: RAW Int String ()) $ \res ->
+    runRAW return 1 "test" (throw Overflow :: RAW () () Int String ()) $ \res ->
         mapLeft fromException res === Left (Just Overflow)
 
     -- catch works properly if continuation called multiple times
@@ -92,7 +92,7 @@
 
     -- what if we throw an exception inside the continuation of run
     ref <- newIORef 0
-    res <- try $ runRAW 1 "test" (return 1) $ \_ -> do
+    res <- try $ runRAW return 1 "test" (return 1) $ \_ -> do
         modifyIORef ref (+1)
         throwIO Overflow
     res === Left Overflow
diff --git a/src/Test/Parallel.hs b/src/Test/Parallel.hs
--- a/src/Test/Parallel.hs
+++ b/src/Test/Parallel.hs
@@ -3,6 +3,7 @@
 
 import Development.Shake
 import Test.Type
+import Data.Foldable
 import Data.Tuple.Extra
 import Control.Monad
 import Control.Concurrent.Extra
@@ -15,6 +16,46 @@
         (text1,text2) <- readFile' "A.txt" `par` readFile' "B.txt"
         writeFile' out $ text1 ++ text2
 
+
+    sem <- liftIO $ newQSemN 0
+    "papplicative_*" %> \out -> do
+        -- wait for both to do the initial start before continuing
+        liftIO $ assertWithin 1 $ do
+            signalQSemN sem 1
+            waitQSemN sem 3
+            signalQSemN sem 3
+        writeFile' out ""
+
+    phony "papplicative" $ do
+        need ["papplicative_1"]
+        need ["papplicative_2"]
+        let ensureReturn = return ()
+        ensureReturn -- should work even though we have a return
+        need ["papplicative_3"]
+
+    "pseparate_*" %> \out -> do
+        liftIO $ appendFile "pseparate.log" "["
+        liftIO $ sleep 0.1
+        liftIO $ appendFile "pseparate.log" "]"
+        writeFile' out ""
+
+    phony "pseparate" $ do
+        need ["pseparate_1"]
+        liftIO $ return ()
+        need ["pseparate_2"]
+
+    sem <- liftIO $ newQSemN 0
+    "ptraverse_*" %> \out -> do
+        -- wait for all to do the initial start before continuing
+        liftIO $ assertWithin 1 $ do
+            signalQSemN sem 1
+            waitQSemN sem 8
+            signalQSemN sem 8
+        writeFile' out ""
+
+    phony "ptraverse" $
+        traverse_ (need . pure) ["ptraverse_" ++ show i | i <- [1..8]]
+
     phony "cancel" $ do
         writeFile' "cancel" ""
         done <- liftIO $ newIORef 0
@@ -59,3 +100,9 @@
 
     build ["parallels"]
     assertContents "parallels" $ show $ replicate 5 [1..5]
+
+    writeFile "pseparate.log" ""
+    build ["pseparate","-j2"]
+    assertContents "pseparate.log" "[][]"
+    build ["papplicative","-j3"]
+    build ["ptraverse","-j8"]
diff --git a/src/Test/Type.hs b/src/Test/Type.hs
--- a/src/Test/Type.hs
+++ b/src/Test/Type.hs
@@ -80,7 +80,7 @@
             when (takeBaseName now /= name) $
                 fail $ "Clean went horribly wrong! Dangerous deleting: " ++ show now
             withCurrentDirectory (now </> "..") $ do
-                removeDirectoryRecursive now
+                removePathForcibly now
                 createDirectoryRecursive now
     unless reenter $ createDirectoryRecursive out
     case args of