shake 0.19.1 → 0.19.2
raw patch · 8 files changed
+106/−45 lines, 8 files
Files
- CHANGES.txt +6/−0
- shake.cabal +7/−5
- src/Development/Shake/Command.hs +5/−2
- src/Development/Shake/Internal/Args.hs +1/−1
- src/Development/Shake/Internal/Core/Action.hs +7/−8
- src/Development/Shake/Internal/Core/Build.hs +5/−5
- src/Development/Shake/Internal/Core/Run.hs +2/−2
- src/Development/Shake/Internal/Core/Types.hs +73/−22
CHANGES.txt view
@@ -1,5 +1,11 @@ Changelog for Shake (* = breaking change) +0.19.2, released 2020-11-15+ #780, Autodeps should consider a rename as a write to the destination+ #778, AutoDeps shouldn't trigger for files read and written+ #779, merge dependencies in O(n and a bit)+ #779, merge local traces in O(n)+ #768, the embed-files flag work on the executable too 0.19.1, released 2020-06-06 #757, make sure shared cache writes are atomic Remove a small space leak if using the Database module
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: shake-version: 0.19.1+version: 0.19.2 license: BSD3 license-file: LICENSE category: Development, Shake@@ -30,7 +30,7 @@ (e.g. compiler version). homepage: https://shakebuild.com bug-reports: https://github.com/ndmitchell/shake/issues-tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+tested-with: GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 extra-doc-files: CHANGES.txt README.md@@ -219,7 +219,6 @@ extra >= 1.6.19, filepath, filepattern,- file-embed >= 0.0.11, hashable >= 1.1.2.3, heaps >= 0.3.6.1, js-dgtable,@@ -228,13 +227,16 @@ primitive, process >= 1.1, random,- template-haskell, time, transformers >= 0.2, unordered-containers >= 0.2.7, utf8-string >= 0.3 - cpp-options: -DFILE_EMBED+ if flag(embed-files)+ cpp-options: -DFILE_EMBED+ build-depends:+ file-embed >= 0.0.11,+ template-haskell if flag(portable) cpp-options: -DPORTABLE
src/Development/Shake/Command.hs view
@@ -29,6 +29,7 @@ import Data.Foldable (toList) import Data.List.Extra import Data.List.NonEmpty (NonEmpty)+import qualified Data.HashSet as Set import Data.Maybe import Data.Data import Data.Semigroup@@ -311,8 +312,10 @@ | otherwise = act params autodeps act = do- ResultFSATrace pxs : res <- act params{opts = addFSAOptions "r" opts, results = ResultFSATrace [] : results}- xs <- liftIO $ filterM doesFileExist [x | FSARead x <- pxs]+ ResultFSATrace pxs : res <- act params{opts = addFSAOptions "rwm" opts, results = ResultFSATrace [] : results}+ let written = Set.fromList $ [x | FSAMove x _ <- pxs] ++ [x | FSAWrite x <- pxs]+ -- If something both reads and writes to a file, it isn't eligible to be an autodeps+ xs <- liftIO $ filterM doesFileExist [x | FSARead x <- pxs, not $ x `Set.member` written] cwd <- liftIO getCurrentDirectory temp <- fixPaths cwd xs unsafeAllowApply $ need temp
src/Development/Shake/Internal/Args.hs view
@@ -254,7 +254,7 @@ if not ran || shakeVerbosity shakeOpts < Info || NoTime `elem` flagsExtra then either throwIO pure res else- let esc = if shakeColor shakeOpts then escape else flip const+ let esc = if shakeColor shakeOpts then escape else \_ x -> x in case res of Left err -> if Exception `elem` flagsExtra then
src/Development/Shake/Internal/Core/Action.hs view
@@ -257,7 +257,7 @@ stop <- liftIO globalTimestamp let trace = newTrace msg start stop liftIO $ evaluate $ rnf trace- Action $ modifyRW $ \s -> s{localTraces = trace : localTraces s}+ Action $ modifyRW $ \s -> s{localTraces = addTrace (localTraces s) trace} pure res @@ -275,7 +275,7 @@ Global{..} <- Action getRO when (isJust $ shakeLint globalOptions) $ do l@Local{..} <- Action getRW- deps <- liftIO $ concatMapM (listDepends globalDatabase) localDepends+ deps <- liftIO $ concatMapM (listDepends globalDatabase) $ enumerateDepends localDepends let top = topStack localStack let condition1 k = top == Just k@@ -317,7 +317,7 @@ let ignore k = any ($ k) localTrackAllows -- Read stuff- deps <- concatMapM (listDepends globalDatabase) localDepends+ deps <- concatMapM (listDepends globalDatabase) $ enumerateDepends localDepends let used = Set.filter (not . ignore) $ Set.fromList localTrackRead -- check Read 4a@@ -436,25 +436,24 @@ -- Most people should use 'Development.Shake.newCache' instead. newCacheIO :: (Eq k, Hashable k) => (k -> Action v) -> IO (k -> Action v) newCacheIO (act :: k -> Action v) = do- var :: Var (Map.HashMap k (Fence IO (Either SomeException ([Depends],v)))) <- newVar Map.empty+ var :: Var (Map.HashMap k (Fence IO (Either SomeException (DependsList,v)))) <- newVar Map.empty pure $ \key -> join $ liftIO $ modifyVar var $ \mp -> case Map.lookup key mp of Just bar -> pure $ (,) mp $ do (offset, (deps, v)) <- actionFenceRequeue bar- Action $ modifyRW $ \s -> addDiscount offset $ s{localDepends = deps ++ localDepends s}+ Action $ modifyRW $ \s -> addDiscount offset $ s{localDepends = addDepends (localDepends s) deps} pure v Nothing -> do bar <- newFence pure $ (Map.insert key bar mp,) $ do- Local{localDepends=pre} <- Action getRW+ Action $ modifyRW $ \s -> s{localDepends = newDepends []} res <- Action $ tryRAW $ fromAction $ act key case res of Left err -> do liftIO $ signalFence bar $ Left err Action $ throwRAW err Right v -> do- Local{localDepends=post} <- Action getRW- let deps = dropEnd (length pre) post+ Local{localDepends=deps} <- Action getRW liftIO $ signalFence bar $ Right (deps, v) pure v
src/Development/Shake/Internal/Core/Build.hs view
@@ -164,7 +164,7 @@ Just e -> pure $ Left e Nothing -> quickly $ Right <$> mapM (fmap (\(Just (_, Ready r)) -> fst $ result r) . liftIO . getKeyValueFromId database) is pure (is, wait)- Action $ modifyRW $ \s -> s{localDepends = Depends is : localDepends s}+ Action $ modifyRW $ \s -> s{localDepends = addDepends1 (localDepends s) $ Depends is} case wait of Now vs -> either throwM pure vs@@ -218,9 +218,9 @@ {result = mkResult runValue runStore ,changed = c ,built = globalStep- ,depends = nubDepends $ reverse localDepends+ ,depends = flattenDepends localDepends ,execution = doubleToFloat $ dur - localDiscount- ,traces = reverse localTraces}+ ,traces = flattenTraces localTraces} where mkResult value store = (value, if globalOneShot then BS.empty else store) @@ -292,7 +292,7 @@ Just (res, deps, restore) -> do liftIO $ globalDiagnostic $ pure $ "History hit for " ++ show key liftIO restore- Action $ modifyRW $ \s -> s{localDepends = reverse $ map Depends deps}+ Action $ modifyRW $ \s -> s{localDepends = newDepends $ map Depends deps} pure (Just res) @@ -325,7 +325,7 @@ let produced = reverse $ map snd localProduces deps <- -- can do this without the DB lock, since it reads things that are stable- forNothingM (reverse localDepends) $ \(Depends is) -> forNothingM is $ \i -> do+ forNothingM (flattenDepends localDepends) $ \(Depends is) -> forNothingM is $ \i -> do Just (k, Ready r) <- getKeyValueFromId globalDatabase i pure $ (k,) <$> runIdentify globalRules k (fst $ result r) let k = topStack localStack
src/Development/Shake/Internal/Core/Run.hs view
@@ -354,9 +354,9 @@ {result = (newValue (), BS.empty) ,changed = step ,built = step- ,depends = nubDepends $ reverse $ localDepends local+ ,depends = flattenDepends $ localDepends local ,execution = 0- ,traces = reverse $ Trace BS.empty end end : localTraces local}+ ,traces = flattenTraces $ addTrace (localTraces local) $ Trace BS.empty end end} setMem db rootId rootKey $ Ready rootRes liftIO $ setDisk db rootId rootKey $ Loaded $ fmap snd rootRes
src/Development/Shake/Internal/Core/Types.hs view
@@ -7,9 +7,11 @@ UserRule(..), UserRuleVersioned(..), userRuleSize, BuiltinRule(..), Global(..), Local(..), Action(..), runAction, addDiscount, newLocal, localClearMutable, localMergeMutable,+ Traces, newTrace, addTrace, flattenTraces,+ DependsList, flattenDepends, enumerateDepends, addDepends, addDepends1, newDepends, Stack, Step(..), Result(..), Database, DatabasePoly(..), Depends(..), Status(..), Trace(..), BS_Store, getResult, exceptionStack, statusType, addStack, addCallStack,- incStep, newTrace, nubDepends, emptyStack, topStack, showTopStack,+ incStep, emptyStack, topStack, showTopStack, stepKey, StepKey(..), rootKey, Root(..) ) where@@ -271,10 +273,39 @@ putEx = putExList . map putEx getEx = map getEx . getExList --- | Afterwards each Id must occur at most once and there are no empty Depends-nubDepends :: [Depends] -> [Depends]-nubDepends = fMany Set.empty+data DependsList+ = DependsNone+ | DependsDirect [Depends]+ | DependsSequence DependsList DependsList+ | DependsSequence1 DependsList Depends+ | DependsParallel [DependsList]++-- Create a new set of depends, from a list in the right order+newDepends :: [Depends] -> DependsList+newDepends = DependsDirect++-- Add two sequences of dependencies in order+addDepends :: DependsList -> DependsList -> DependsList+addDepends = DependsSequence++addDepends1 :: DependsList -> Depends -> DependsList+addDepends1 = DependsSequence1++-- Two goals here, merge parallel lists so they retain as much leading parallelism as possible+-- Afterwards each Id must occur at most once and there are no empty Depends+flattenDepends :: DependsList -> [Depends]+flattenDepends d = fMany Set.empty $ flat d [] where+ flat :: DependsList -> [Depends] -> [Depends]+ flat DependsNone rest = rest+ flat (DependsDirect xs) rest = xs ++ rest+ flat (DependsSequence xs ys) rest = flat xs $ flat ys rest+ flat (DependsSequence1 xs y) rest = flat xs $ y:rest+ -- for each element of xs, we want to pull off the things that must be done first+ -- and then the stuff that can be done later+ flat (DependsParallel xs) rest = map mconcat xss ++ rest+ where xss = transpose $ map (`flat` []) xs+ fMany _ [] = [] fMany seen (Depends d:ds) = [Depends d2 | d2 /= []] ++ fMany seen2 ds where (d2,seen2) = fOne seen d@@ -284,6 +315,20 @@ fOne seen (x:xs) = first (x:) $ fOne (Set.insert x seen) xs +++-- List all the dependencies in whatever order you wish, used for linting+enumerateDepends :: DependsList -> [Depends]+enumerateDepends d = f d []+ where+ f DependsNone rest = rest+ f (DependsDirect xs) rest = xs ++ rest+ f (DependsSequence xs ys) rest = f xs $ f ys rest+ f (DependsSequence1 xs y) rest = f xs (y:rest)+ f (DependsParallel []) rest = rest+ f (DependsParallel (x:xs)) rest = f x $ f (DependsParallel xs) rest++ -- | Define a rule between @key@ and @value@. As an example, a typical 'BuiltinRun' will look like: -- -- > run key oldStore mode = do@@ -415,9 +460,9 @@ ,localVerbosity :: Verbosity -- ^ Verbosity, may be changed locally ,localBlockApply :: Maybe String -- ^ Reason to block apply, or Nothing to allow -- mutable local variables- ,localDepends :: [Depends] -- ^ Dependencies, built up in reverse+ ,localDepends :: DependsList -- ^ Dependencies that we rely on, morally a list of sets ,localDiscount :: !Seconds -- ^ Time spend building dependencies (may be negative for parallel)- ,localTraces :: [Trace] -- ^ Traces, built in reverse+ ,localTraces :: Traces -- ^ Traces that have occurred ,localTrackAllows :: [Key -> Bool] -- ^ Things that are allowed to be used ,localTrackRead :: [Key] -- ^ Calls to 'lintTrackRead' ,localTrackWrite :: [Key] -- ^ Calls to 'lintTrackWrite'@@ -425,11 +470,30 @@ ,localHistory :: !Bool -- ^ Is it valid to cache the result } +data Traces+ = TracesNone -- no traces+ | TracesSequence1 Traces Trace -- Like TracesSequence but with 1 element+ | TracesSequence Traces Traces -- first the Traces happened, then Traces that happened after+ | TracesParallel [Traces] -- these traces happened in parallel with each other++flattenTraces :: Traces -> [Trace]+flattenTraces t = f t []+ where+ f TracesNone rest = rest+ f (TracesSequence1 a b) rest = f a (b:rest)+ f (TracesSequence a b) rest = f a $ f b rest+ f (TracesParallel []) rest = rest+ -- Might want to resort them by time started?+ f (TracesParallel (x:xs)) rest = f x $ f (TracesParallel xs) rest++addTrace :: Traces -> Trace -> Traces+addTrace ts t = ts `TracesSequence1` t+ addDiscount :: Seconds -> Local -> Local addDiscount s l = l{localDiscount = s + localDiscount l} newLocal :: Stack -> Verbosity -> Local-newLocal stack verb = Local stack (Ver 0) verb Nothing [] 0 [] [] [] [] [] True+newLocal stack verb = Local stack (Ver 0) verb Nothing DependsNone 0 TracesNone [] [] [] [] True -- Clear all the local mutable variables localClearMutable :: Local -> Local@@ -447,25 +511,12 @@ ,localBlockApply = localBlockApply root -- mutable locals that need integrating -- note that a lot of the lists are stored in reverse, assume root happened first- ,localDepends = mergeDependsRev (map localDepends xs) ++ localDepends root+ ,localDepends = DependsParallel (map localDepends xs) `DependsSequence` localDepends root ,localDiscount = sum $ map localDiscount $ root : xs- ,localTraces = mergeTracesRev (map localTraces xs) ++ localTraces root+ ,localTraces = TracesParallel (map localTraces xs) `TracesSequence` localTraces root ,localTrackAllows = localTrackAllows root ++ concatMap localTrackAllows xs ,localTrackRead = localTrackRead root ++ concatMap localTrackRead xs ,localTrackWrite = localTrackWrite root ++ concatMap localTrackWrite xs ,localProduces = concatMap localProduces xs ++ localProduces root ,localHistory = all localHistory $ root:xs }---- ignoring reversing, want to merge the first set of dependencies and so on--- so we increase parallelism when rechecking builds-mergeDependsRev :: [[Depends]] -> [Depends]-mergeDependsRev = reverse . f . map reverse- where- f [] = []- f xs = mconcat now : f next- where (now, next) = unzip $ mapMaybe uncons xs--mergeTracesRev :: [[Trace]] -> [Trace]--- might want to resort them?-mergeTracesRev = concat