shake 0.16.3 → 0.16.4
raw patch · 20 files changed
+261/−186 lines, 20 files
Files
- CHANGES.txt +4/−0
- README.md +9/−9
- docs/Manual.md +5/−5
- html/shake.js +3/−3
- shake.cabal +5/−6
- src/Development/Shake.hs +7/−7
- src/Development/Shake/Internal/Args.hs +1/−1
- src/Development/Shake/Internal/Core/Action.hs +24/−13
- src/Development/Shake/Internal/Core/Monad.hs +79/−71
- src/Development/Shake/Internal/Core/Rules.hs +2/−2
- src/Development/Shake/Internal/Core/Run.hs +10/−10
- src/Development/Shake/Internal/Demo.hs +2/−2
- src/Development/Shake/Internal/Derived.hs +4/−3
- src/Development/Shake/Internal/FileInfo.hs +1/−1
- src/Development/Shake/Internal/Progress.hs +1/−1
- src/Development/Shake/Internal/Rules/Oracle.hs +43/−23
- src/General/Ids.hs +1/−1
- src/Test/Docs.hs +13/−10
- src/Test/Monad.hs +17/−18
- src/Test/Oracle.hs +30/−0
CHANGES.txt view
@@ -1,5 +1,9 @@ Changelog for Shake +0.16.4, released 2018-04-04+ #185, add addOracleCache which doesn't always rerun+ #576, remove incorrect Cabal description+ #575, print --help message at Quiet verbosity or above 0.16.3, released 2018-02-23 Allow reading data files from next to the executable #566, require extra-1.6.1
README.md view
@@ -1,19 +1,19 @@ # Shake [](https://hackage.haskell.org/package/shake) [](https://www.stackage.org/package/shake) [](https://travis-ci.org/ndmitchell/shake) [](https://ci.appveyor.com/project/ndmitchell/shake) -Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day. The website for Shake users is at [shakebuild.com](http://shakebuild.com).+Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day. The website for Shake users is at [shakebuild.com](https://shakebuild.com). #### Documentation -* **Why use Shake?** Shake lets you write large robust build systems, which deal properly with generated source files and run quickly. If you are writing a custom build system of any moderate size (more than a few rules) you should use Shake. The advantages over other build systems are detailed in the document [Why choose Shake?](http://shakebuild.com/why).-* **How do I use Shake?** Shake is a Haskell library that you use to define your rules. The [Shake manual](http://shakebuild.com/manual) provides a walk through of a small but realistic example, assuming no Haskell knowledge.-* [Generated documentation](http://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html) for all functions, includes lots of examples.-* [Blog posts](http://neilmitchell.blogspot.co.uk/search/label/shake) detailing ongoing development work.-* [Academic paper](http://ndmitchell.com/downloads/paper-shake_before_building-10_sep_2012.pdf) on the underlying principles behind Shake.+* **Why use Shake?** Shake lets you write large robust build systems, which deal properly with generated source files and run quickly. If you are writing a custom build system of any moderate size (more than a few rules) you should use Shake. The advantages over other build systems are detailed in the document [Why choose Shake?](https://shakebuild.com/why).+* **How do I use Shake?** Shake is a Haskell library that you use to define your rules. The [Shake manual](https://shakebuild.com/manual) provides a walk through of a small but realistic example, assuming no Haskell knowledge.+* [Generated documentation](https://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html) for all functions, includes lots of examples.+* [Blog posts](https://neilmitchell.blogspot.co.uk/search/label/shake) detailing ongoing development work.+* [Academic paper](https://ndmitchell.com/downloads/paper-shake_before_building-10_sep_2012.pdf) on the underlying principles behind Shake. #### Other links -* [Download the Haskell package](http://hackage.haskell.org/package/shake) from Hackage and install it using Cabal.+* [Download the Haskell package](https://hackage.haskell.org/package/shake) from Hackage and install it using Cabal. * [Mailing list](https://groups.google.com/forum/?fromgroups#!forum/shake-build-system) for any questions/bugs/thoughts on Shake. If you need more information and aren't sure where to start, use the mailing list.-* [Questions](http://stackoverflow.com/questions/tagged/shake-build-system) can be asked on StackOverflow with the tag `shake-build-system`.+* [Questions](https://stackoverflow.com/questions/tagged/shake-build-system) can be asked on StackOverflow with the tag `shake-build-system`. -Is your company using Shake? Write something public (even just a [tweet to `@ndm_haskell`](https://twitter.com/ndm_haskell)) and I'll include a link [on the website](http://shakebuild.com/#who-uses-shake).+Is your company using Shake? Write something public (even just a [tweet to `@ndm_haskell`](https://twitter.com/ndm_haskell)) and I'll include a link [on the website](https://shakebuild.com/#who-uses-shake).
docs/Manual.md view
@@ -35,9 +35,9 @@ To run the example above: -1. Install the [Haskell Stack](http://haskellstack.org/), which provides a Haskell compiler and package manager.-3. Type `stack install shake`, to build and install Shake and all its dependencies.-4. Type `stack exec -- shake --demo`, which will create a directory containing a sample project, the above Shake script (named `Build.hs`), and execute it (which can be done by `runhaskell Build.hs`). For more details see a [trace of `shake --demo`](Demo.md).+1. Install the [Haskell Stack](https://haskellstack.org/), which provides a Haskell compiler and package manager.+2. Type `stack install shake`, to build and install Shake and all its dependencies.+3. Type `stack exec -- shake --demo`, which will create a directory containing a sample project, the above Shake script (named `Build.hs`), and execute it (which can be done by `runhaskell Build.hs`). For more details see a [trace of `shake --demo`](Demo.md). ## Basic syntax @@ -284,7 +284,7 @@ mkdir -p _shake ghc --make Build.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@" -This script creates a folder named `_shake` for the build system objects to live in, then runs `ghc --make Build.hs` to produce `_shake/build`, then executes `_shake/build` with all arguments it was given. The `-with-rtsopts` flag instructs the Haskell compiler to disable "idle garbage collection", making more CPU available for the commands you are running, as [explained here](http://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/).+This script creates a folder named `_shake` for the build system objects to live in, then runs `ghc --make Build.hs` to produce `_shake/build`, then executes `_shake/build` with all arguments it was given. The `-with-rtsopts` flag instructs the Haskell compiler to disable "idle garbage collection", making more CPU available for the commands you are running, as [explained here](https://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/). Now you can run a build by simply typing `stack exec ./build.sh` on Linux, or `stack exec build.bat` on Windows. On Linux you may want to alias `build` to `stack exec ./build.sh`. For the rest of this document we will assume `build` runs the build system. @@ -420,7 +420,7 @@ _Depend on the build source:_ One approach is to depend on the build system source in each of the rules, then if _any_ rules change, _everything_ will rebuild. While this option is safe, it may cause a significant number of redundant rebuilds. As a restricted version of this technique, for a generated file you can include a dependency on the generator source and use `writeFileChanged`. If the generator changes it will rerun, but typically only a few generated files will change, so little is rebuilt. -_Use a version stamp:_ There is a field named `shakeVersion` in the `ShakeOptions` record. If the build system changes in a significant and incompatible way, you can change this field to force a full rebuild. If you want all rules to depend on all rules, you can put a hash of the build system source in the version field, as [described here](http://stackoverflow.com/questions/18532552/shake-how-to-reliably-automatically-force-rebuild-when-my-rules-change-becomi/18532553#18532553).+_Use a version stamp:_ There is a field named `shakeVersion` in the `ShakeOptions` record. If the build system changes in a significant and incompatible way, you can change this field to force a full rebuild. If you want all rules to depend on all rules, you can put a hash of the build system source in the version field, as [described here](https://stackoverflow.com/questions/18532552/shake-how-to-reliably-automatically-force-rebuild-when-my-rules-change-becomi/18532553#18532553). ## The Haskell Zone
html/shake.js view
@@ -465,7 +465,7 @@ "use strict"; function initProgress() { $(function () {- $(".version").html("Generated by <a href='http://shakebuild.com'>Shake " + version + "</a>.");+ $(".version").html("Generated by <a href='https://shakebuild.com'>Shake " + version + "</a>."); $("#output").html(""); for (var _i = 0; _i < progress.length; _i++) { var x = progress[_i];@@ -731,7 +731,7 @@ for (var i = 0; i < res.length; i++) s_2 += "<li>" + res[i] + "</li>"; s_2 += "</ul>";- s_2 += "<p class='version'>Generated by <a href='http://shakebuild.com'>Shake " + version + "</a>.</p>";+ s_2 += "<p class='version'>Generated by <a href='https://shakebuild.com'>Shake " + version + "</a>.</p>"; $("#output").html(s_2); break; case "cmd-plot":@@ -849,7 +849,7 @@ $(this).attr("href", href).attr("target", "_blank")[0].setAttribute("onclick", onclick); }); $("a.shake").each(function () {- var href = "http://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html#v:" ++ var href = "https://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html#v:" + $(this).text().replace("'", "-39-"); $(this).attr("href", href).attr("target", "_blank"); });
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: shake-version: 0.16.3+version: 0.16.4 license: BSD3 license-file: LICENSE category: Development, Shake@@ -12,10 +12,9 @@ description: Shake is a Haskell library for writing build systems - designed as a replacement for @make@. See "Development.Shake" for an introduction,- including an example. Further examples are included in the Cabal tarball,- under the @Examples@ directory. The homepage contains links to a user+ including an example. The homepage contains links to a user manual, an academic paper and further information:- <http://shakebuild.com>+ <https://shakebuild.com> . To use Shake the user writes a Haskell program that imports "Development.Shake", defines some build rules, and calls@@ -29,9 +28,9 @@ Shake also provides more accurate dependency tracking, including seamless support for generated files, and dependencies on system information (e.g. compiler version).-homepage: http://shakebuild.com+homepage: https://shakebuild.com bug-reports: https://github.com/ndmitchell/shake/issues-tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with: GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 extra-doc-files: CHANGES.txt README.md
src/Development/Shake.hs view
@@ -31,14 +31,14 @@ -- To find out more: -- -- * The user manual contains a longer example and background information on how to use Shake--- <http://www.shakebuild.com/manual>.+-- <https://www.shakebuild.com/manual>. ----- * The home page has links to additional information <http://www.shakebuild.com/>, including+-- * The home page has links to additional information <https://www.shakebuild.com/>, including -- a mailing list. -- -- * The theory behind Shake is described in an ICFP 2012 paper,--- <http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf Shake Before Building -- Replacing Make with Haskell>.--- The <http://www.youtube.com/watch?v=xYCPpXVlqFM associated talk> forms a short overview of Shake .+-- <https://ndmitchell.com/downloads/paper-shake_before_building-10_sep_2012.pdf Shake Before Building -- Replacing Make with Haskell>.+-- The <https://www.youtube.com/watch?v=xYCPpXVlqFM associated talk> forms a short overview of Shake . module Development.Shake( -- * Writing a build system -- $writing@@ -89,7 +89,7 @@ -- * Environment rules getEnv, getEnvWithDefault, -- * Oracle rules- ShakeValue, RuleResult, addOracle, askOracle,+ ShakeValue, RuleResult, addOracle, addOracleCache, askOracle, -- * Special rules alwaysRerun, -- * Resources@@ -168,9 +168,9 @@ -- * @-rtsopts@: Allow the setting of further GHC options at runtime. -- -- * @-I0@: Disable idle garbage collection, to avoid frequent unnecessary garbage collection, see--- <http://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/ a full explanation>.+-- <https://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/ a full explanation>. ----- * With GHC 7.6 and before, omit @-threaded@: <http://ghc.haskell.org/trac/ghc/ticket/7646 GHC bug 7646>+-- * With GHC 7.6 and before, omit @-threaded@: <https://ghc.haskell.org/trac/ghc/ticket/7646 GHC bug 7646> -- can cause a race condition in build systems that write files then read them. Omitting @-threaded@ will -- still allow your 'cmd' actions to run in parallel, so most build systems will still run in parallel. --
src/Development/Shake/Internal/Args.hs view
@@ -138,7 +138,7 @@ let putWhenLn v msg = putWhen v $ msg ++ "\n" let showHelp = do progName <- getProgName- putWhen Normal $ unlines $ ("Usage: " ++ progName ++ " [options] [target] ...") : "Options:" : showOptDescr opts+ putWhen Quiet $ unlines $ ("Usage: " ++ progName ++ " [options] [target] ...") : "Options:" : showOptDescr opts when (errs /= []) $ do putWhen Quiet $ unlines $ map ("shake: " ++) $ filter (not . null) $ lines $ unlines errs
src/Development/Shake/Internal/Core/Action.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ConstraintKinds #-}+{-# LANGUAGE RecordWildCards, NamedFieldPuns, ScopedTypeVariables, ConstraintKinds #-} module Development.Shake.Internal.Core.Action( runAction, actionOnException, actionFinally,@@ -38,14 +38,25 @@ runAction :: Global -> Local -> Action a -> Capture (Either SomeException a) runAction g l (Action x) = runRAW g l x +-- | Apply a modification, run an action, then run an undo action after.+-- Doesn't actually require exception handling because we don't have the ability to catch exceptions to the user.+actionBracket :: (Local -> (Local, Local -> Local)) -> Action a -> Action a+actionBracket f m = Action $ do+ s <- getRW+ let (s2,undo) = f s+ putRW s2+ res <- fromAction m+ modifyRW undo+ return res + --------------------------------------------------------------------- -- EXCEPTION HANDLING actionBoom :: Bool -> Action a -> IO b -> Action a actionBoom runOnSuccess act clean = do- cleanup <- Action $ getsRO globalCleanup- undo <- liftIO $ addCleanup cleanup $ void clean+ Global{..} <- Action getRO+ undo <- liftIO $ addCleanup globalCleanup $ void clean -- important to mask_ the undo/clean combo so either both happen or neither res <- Action $ catchRAW (fromAction act) $ \e -> liftIO (mask_ $ undo >> clean) >> throwRAW e liftIO $ mask_ $ undo >> when runOnSuccess (void clean)@@ -65,14 +76,14 @@ -- | Get the initial 'ShakeOptions', these will not change during the build process. getShakeOptions :: Action ShakeOptions-getShakeOptions = Action $ getsRO globalOptions+getShakeOptions = Action $ globalOptions <$> getRO -- | Get the current 'Progress' structure, as would be returned by 'shakeProgress'. getProgress :: Action Progress getProgress = do- res <- Action $ getsRO globalProgress- liftIO res+ Global{..} <- Action getRO+ liftIO globalProgress -- | Specify an action to be run after the database has been closed, if building completes successfully. runAfter :: IO () -> Action ()@@ -113,15 +124,15 @@ -- 'putLoud' \/ 'putNormal' \/ 'putQuiet', which ensures multiple messages are -- not interleaved. The verbosity can be modified locally by 'withVerbosity'. getVerbosity :: Action Verbosity-getVerbosity = Action $ getsRW localVerbosity+getVerbosity = Action $ localVerbosity <$> getRW -- | Run an action with a particular verbosity level. -- Will not update the 'shakeVerbosity' returned by 'getShakeOptions' and will -- not have any impact on 'Diagnostic' tracing. withVerbosity :: Verbosity -> Action a -> Action a-withVerbosity new = Action . unmodifyRW f . fromAction- where f s0 = (s0{localVerbosity=new}, \s -> s{localVerbosity=localVerbosity s0})+withVerbosity new = actionBracket $ \s0 ->+ (s0{localVerbosity=new}, \s -> s{localVerbosity=localVerbosity s0}) -- | Run an action with 'Quiet' verbosity, in particular messages produced by 'traced'@@ -142,8 +153,8 @@ blockApply = applyBlockedBy . Just applyBlockedBy :: Maybe String -> Action a -> Action a-applyBlockedBy reason = Action . unmodifyRW f . fromAction- where f s0 = (s0{localBlockApply=reason}, \s -> s{localBlockApply=localBlockApply s0})+applyBlockedBy reason = actionBracket $ \s0 ->+ (s0{localBlockApply=reason}, \s -> s{localBlockApply=localBlockApply s0}) ---------------------------------------------------------------------@@ -163,9 +174,9 @@ traced :: String -> IO a -> Action a traced msg act = do Global{..} <- Action getRO- stack <- Action $ getsRW localStack+ Local{localStack} <- Action getRW start <- liftIO globalTimestamp- putNormal $ "# " ++ msg ++ " (for " ++ showTopStack stack ++ ")"+ putNormal $ "# " ++ msg ++ " (for " ++ showTopStack localStack ++ ")" res <- liftIO act stop <- liftIO globalTimestamp let trace = newTrace msg start stop
src/Development/Shake/Internal/Core/Monad.hs view
@@ -1,19 +1,16 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GADTs, ScopedTypeVariables #-} module Development.Shake.Internal.Core.Monad( RAW, Capture, runRAW,- getRO, getRW, getsRO, getsRW, putRW, modifyRW,- withRO, withRW,+ getRO, getRW, putRW, modifyRW, catchRAW, tryRAW, throwRAW,- unmodifyRW, captureRAW,+ captureRAW, ) where import Control.Exception.Extra import Control.Monad.IO.Class-import Control.Monad.Trans.Cont-import Control.Monad.Trans.Reader-import Data.IORef+import Data.IORef.Extra import Control.Applicative import Control.Monad import Prelude@@ -23,18 +20,40 @@ #endif -data S ro rw = S- {handler :: IORef (SomeException -> IO ())- ,ro :: ro- ,rww :: IORef rw -- Read/Write Writeable var (rww)- }+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 -newtype RAW ro rw a = RAW {fromRAW :: ReaderT (S ro rw) (ContT () IO) a}- deriving (Functor, Applicative, Monad, MonadIO+instance Functor (RAW ro rw) where+ fmap = Fmap++instance Applicative (RAW ro rw) where+ pure = Pure+ (*>) = Next+ (<*>) = Ap++instance Monad (RAW ro rw) where+ return = pure+ (>>) = (*>)+ (>>=) = Bind++instance MonadIO (RAW ro rw) where+ liftIO = LiftIO+ #if __GLASGOW_HASKELL__ >= 800- , MonadFail+instance MonadFail (RAW ro rw) where+ fail = liftIO . Control.Monad.Fail.fail #endif- ) type Capture a = (a -> IO ()) -> IO () @@ -42,62 +61,69 @@ -- | Run and then call a continuation. runRAW :: ro -> rw -> RAW ro rw a -> Capture (Either SomeException a) runRAW ro rw m k = do- rww <- newIORef rw+ rw <- newIORef rw handler <- newIORef $ k . Left- -- see https://ghc.haskell.org/trac/ghc/ticket/11555- fromRAW m `runReaderT` S handler ro rww `runContT` (k . Right)+ goRAW handler ro rw m (k . Right) `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+ where+ go :: RAW ro rw b -> Capture 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 + GetRO -> k ro+ GetRW -> k =<< readIORef rw+ PutRW x -> writeIORef rw x >> k ()+ ModifyRW f -> modifyIORef' rw f >> k ()++ CatchRAW m hdl -> do+ old <- readIORef handler+ writeIORef handler $ \e -> do+ writeIORef handler old+ go (hdl e) k `catch_`+ \e -> ($ e) =<< readIORef handler+ go m $ \x -> writeIORef handler old >> k x++ CaptureRAW f -> do+ old <- readIORef handler+ writeIORef handler throwIO+ f $ \x -> case x of+ Left e -> old e+ Right v -> do+ writeIORef handler old+ k v `catch_` \e -> ($ e) =<< readIORef handler+ writeIORef handler throwIO++ --------------------------------------------------------------------- -- STANDARD getRO :: RAW ro rw ro-getRO = RAW $ asks ro+getRO = GetRO getRW :: RAW ro rw rw-getRW = RAW $ liftIO . readIORef =<< asks rww--getsRO :: (ro -> a) -> RAW ro rw a-getsRO f = fmap f getRO--getsRW :: (rw -> a) -> RAW ro rw a-getsRW f = fmap f getRW+getRW = GetRW -- | Strict version putRW :: rw -> RAW ro rw ()-putRW rw = rw `seq` RAW $ liftIO . flip writeIORef rw =<< asks rww--withRAW :: (S ro rw -> S ro2 rw2) -> RAW ro2 rw2 a -> RAW ro rw a-withRAW f m = RAW $ withReaderT f $ fromRAW m+putRW = PutRW modifyRW :: (rw -> rw) -> RAW ro rw ()-modifyRW f = do x <- getRW; putRW $ f x--withRO :: (ro -> ro2) -> RAW ro2 rw a -> RAW ro rw a-withRO f = withRAW $ \s -> s{ro=f $ ro s}--withRW :: (rw -> rw2) -> RAW ro rw2 a -> RAW ro rw a-withRW f m = do- rw <- getRW- rww <- liftIO $ newIORef $ f rw- withRAW (\s -> s{rww=rww}) m+modifyRW = ModifyRW --------------------------------------------------------------------- -- EXCEPTIONS catchRAW :: RAW ro rw a -> (SomeException -> RAW ro rw a) -> RAW ro rw a-catchRAW m hdl = RAW $ ReaderT $ \s -> ContT $ \k -> do- old <- readIORef $ handler s- writeIORef (handler s) $ \e -> do- writeIORef (handler s) old- fromRAW (hdl e) `runReaderT` s `runContT` k `catch_`- \e -> ($ e) =<< readIORef (handler s)- fromRAW m `runReaderT` s `runContT` \v -> do- writeIORef (handler s) old- k v-+catchRAW = CatchRAW tryRAW :: RAW ro rw a -> RAW ro rw (Either SomeException a) tryRAW m = catchRAW (fmap Right m) (return . Left)@@ -107,27 +133,9 @@ ------------------------------------------------------------------------ WEIRD STUFF---- | Apply a modification, run an action, then undo the changes after.-unmodifyRW :: (rw -> (rw, rw -> rw)) -> RAW ro rw a -> RAW ro rw a-unmodifyRW f m = do- (s2,undo) <- fmap f getRW- putRW s2- res <- m- modifyRW undo- return res-+-- CONTINUATIONS -- | 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 f = RAW $ ReaderT $ \s -> ContT $ \k -> do- old <- readIORef (handler s)- writeIORef (handler s) throwIO- f $ \x -> case x of- Left e -> old e- Right v -> do- writeIORef (handler s) old- k v `catch_` \e -> ($ e) =<< readIORef (handler s)- writeIORef (handler s) throwIO+captureRAW = CaptureRAW
src/Development/Shake/Internal/Core/Rules.hs view
@@ -53,8 +53,8 @@ getUserRules = f where f :: forall a . Typeable a => Action (UserRule a) f = do- userRules <- Action $ getsRO globalUserRules- return $ case Map.lookup (typeRep (Proxy :: Proxy a)) userRules of+ Global{..} <- Action getRO+ return $ case Map.lookup (typeRep (Proxy :: Proxy a)) globalUserRules of Nothing -> Unordered [] Just (UserRule_ r) -> fromJust $ cast r
src/Development/Shake/Internal/Core/Run.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE RecordWildCards, NamedFieldPuns, ScopedTypeVariables, PatternGuards #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} @@ -202,8 +202,8 @@ let tk = typeRep (Proxy :: Proxy key) tv = typeRep (Proxy :: Proxy value) Global{..} <- Action getRO- block <- Action $ getsRW localBlockApply- whenJust block $ liftIO . errorNoApply tk (show <$> listToMaybe ks)+ Local{localBlockApply} <- Action getRW+ whenJust localBlockApply $ liftIO . errorNoApply tk (show <$> listToMaybe ks) case Map.lookup tk globalRules of Nothing -> liftIO $ errorNoRuleToBuildType tk (show <$> listToMaybe ks) (Just tv) Just BuiltinRule{builtinResult=tv2} | tv /= tv2 -> errorInternal $ "result type does not match, " ++ show tv ++ " vs " ++ show tv2@@ -214,8 +214,8 @@ applyKeyValue [] = return [] applyKeyValue ks = do global@Global{..} <- Action getRO- stack <- Action $ getsRW localStack- (dur, dep, vs) <- Action $ captureRAW $ build globalPool globalDatabase (BuildKey $ runKey global) stack ks+ Local{localStack} <- Action getRW+ (dur, dep, vs) <- Action $ captureRAW $ build globalPool globalDatabase (BuildKey $ runKey global) localStack ks Action $ modifyRW $ \s -> s{localDiscount=localDiscount s + dur, localDepends=dep : localDepends s} return vs @@ -312,10 +312,10 @@ (res,offset) <- case res of Just res -> return (res, 0) Nothing -> do- pool <- Action $ getsRO globalPool+ Global{..} <- Action getRO offset <- liftIO offsetTime Action $ captureRAW $ \k -> waitFence bar $ \v ->- addPoolResume pool $ do offset <- liftIO offset; k $ Right (v,offset)+ addPoolResume globalPool $ do offset <- liftIO offset; k $ Right (v,offset) case res of Left err -> Action $ throwRAW err Right (deps,v) -> do@@ -324,14 +324,14 @@ Nothing -> do bar <- newFence return $ (,) (Map.insert key bar mp) $ do- pre <- Action $ getsRW localDepends+ Local{localDepends=pre} <- Action getRW res <- Action $ tryRAW $ fromAction $ act key case res of Left err -> do liftIO $ signalFence bar $ Left err Action $ throwRAW err Right v -> do- post <- Action $ getsRW localDepends+ Local{localDepends=post} <- Action getRW let deps = take (length post - length pre) post liftIO $ signalFence bar $ Right (deps, v) return v@@ -392,7 +392,7 @@ -- A more general version of 'orderOnly'. orderOnlyAction :: Action a -> Action a orderOnlyAction act = Action $ do- pre <- getsRW localDepends+ Local{localDepends=pre} <- getRW res <- fromAction act modifyRW $ \s -> s{localDepends=pre} return res
src/Development/Shake/Internal/Demo.hs view
@@ -91,10 +91,10 @@ putStrLn "\n% Demo complete - all the examples can be run from:" putStrLn $ "% " ++ dir- putStrLn "% For more info see http://shakebuild.com"+ putStrLn "% For more info see https://shakebuild.com" when (isJust ninja) $ do putStrLn "\n% PS. Shake can also execute Ninja build files"- putStrLn "% For more info see http://shakebuild.com/ninja"+ putStrLn "% For more info see https://shakebuild.com/ninja"
src/Development/Shake/Internal/Derived.hs view
@@ -234,7 +234,7 @@ -- google <- 'Development.Shake.newThrottle' \"Google\" 1 5 -- \"*.url\" 'Development.Shake.%>' \\out -> do -- 'Development.Shake.withResource' google 1 $--- 'Development.Shake.cmd' \"wget\" [\"http:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]+-- 'Development.Shake.cmd' \"wget\" [\"https:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out] -- @ -- -- Now we will wait at least 5 seconds after querying Google before performing another query. If Google change the rules to@@ -248,7 +248,7 @@ -- google <- 'Development.Shake.newThrottle' \"Google\" 1 5 -- \"*.url\" 'Development.Shake.%>' \\out -> do -- 'Development.Shake.withResource' google 1 $ return ()--- 'Development.Shake.cmd' \"wget\" [\"http:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]+-- 'Development.Shake.cmd' \"wget\" [\"https:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out] -- @ -- -- However, the rule may not continue running immediately after 'Development.Shake.withResource' completes, so while@@ -270,9 +270,10 @@ f ((r,xs):rs) = withResource r (sum xs) $ f rs --- | Given an action on a key, produce a cached version that will execute the action at most once per key.+-- | Given an action on a key, produce a cached version that will execute the action at most once per key per run. -- Using the cached result will still result include any dependencies that the action requires. -- Each call to 'newCache' creates a separate cache that is independent of all other calls to 'newCache'.+-- The operations will not be cached between runs and nothing will be persisted to the Shake database. -- -- This function is useful when creating files that store intermediate values, -- to avoid the overhead of repeatedly reading from disk, particularly if the file requires expensive parsing.
src/Development/Shake/Internal/FileInfo.hs view
@@ -74,7 +74,7 @@ -- If the result isn't strict then we are referencing a much bigger structure, -- and it causes a space leak I don't really understand on Linux when running -- the 'tar' test, followed by the 'benchmark' test.--- See this blog post: http://neilmitchell.blogspot.co.uk/2015/09/three-space-leaks.html+-- See this blog post: https://neilmitchell.blogspot.co.uk/2015/09/three-space-leaks.html result :: Word32 -> Word32 -> IO (Maybe (ModTime, FileSize)) result x y = do x <- evaluate $ fileInfo x
src/Development/Shake/Internal/Progress.hs view
@@ -88,7 +88,7 @@ --------------------------------------------------------------------- -- MEALY TYPE - for writing the progress functions--- See <http://hackage.haskell.org/package/machines-0.2.3.1/docs/Data-Machine-Mealy.html>+-- See <https://hackage.haskell.org/package/machines-0.2.3.1/docs/Data-Machine-Mealy.html> -- | A machine that takes inputs and produces outputs newtype Mealy i a = Mealy {runMealy :: i -> (a, Mealy i a)}
src/Development/Shake/Internal/Rules/Oracle.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE TypeFamilies, ConstraintKinds #-} module Development.Shake.Internal.Rules.Oracle(- addOracle, askOracle+ addOracle, addOracleCache, askOracle ) where import Development.Shake.Internal.Core.Run@@ -27,6 +27,30 @@ type instance RuleResult (OracleQ a) = OracleA (RuleResult a) +addOracleRaw :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => Bool -> (q -> Action a) -> Rules (q -> Action a)+addOracleRaw cache act = do+ -- rebuild is automatic for oracles, skip just means we don't rebuild+ opts <- getShakeOptionsRules+ let skip = shakeRebuildApply opts "" == RebuildLater++ addBuiltinRule noLint $ \(OracleQ q) old changed -> case old of+ Just old | skip || (cache && not changed) ->+ return $ RunResult ChangedNothing old $ decode' old+ _ -> do+ new <- OracleA <$> act q+ return $ RunResult+ (if fmap decode' old == Just new then ChangedRecomputeSame else ChangedRecomputeDiff)+ (encode' new)+ new+ return askOracle+ where+ encode' :: Binary a => a -> BS.ByteString+ encode' = BS.concat . LBS.toChunks . encode++ decode' :: Binary a => BS.ByteString -> a+ decode' = decode . LBS.fromChunks . return++ -- | Add extra information which rules can depend on. -- An oracle is a function from a question type @q@, to an answer type @a@. -- As an example, we can define an oracle allowing you to depend on the current version of GHC:@@ -82,30 +106,26 @@ -- Using these definitions, any rule depending on the version of @shake@ -- should call @getPkgVersion $ GhcPkgVersion \"shake\"@ to rebuild when @shake@ is upgraded. addOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)-addOracle act = do- -- rebuild is automatic for oracles, skip just means we don't rebuild- opts <- getShakeOptionsRules- let skip = shakeRebuildApply opts "" == RebuildLater-- addBuiltinRule noLint $ \(OracleQ q) old _ -> case old of- Just old | skip ->- return $ RunResult ChangedNothing old $ decode' old- _ -> do- new <- OracleA <$> act q- return $ RunResult- (if fmap decode' old == Just new then ChangedRecomputeSame else ChangedRecomputeDiff)- (encode' new)- new- return askOracle- where- encode' :: Binary a => a -> BS.ByteString- encode' = BS.concat . LBS.toChunks . encode+addOracle = addOracleRaw False - decode' :: Binary a => BS.ByteString -> a- decode' = decode . LBS.fromChunks . return+-- | A combination of 'addOracle' and 'newCache' - an action that only runs when its dependencies change,+-- whose result is stored in the database.+--+-- * Does the information need recomputing every time? e.g. looking up stuff in the environment?+-- If so, use 'addOracle' instead.+--+-- * Is the action mostly deserisalising some file? If so, use 'newCache'.+--+-- * Is the operation expensive computation from other results? If so, use 'addOracleCache'.+--+-- An alternative to using 'addOracleCache' is introducing an intermediate file containing the result,+-- which requires less storage in the Shake database and can be inspected by existing file-system viewing+-- tools.+addOracleCache ::(RuleResult q ~ a, ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)+addOracleCache = addOracleRaw True --- | Get information previously added with 'addOracle'. The question/answer types must match those provided--- to 'addOracle'.+-- | Get information previously added with 'addOracle' or 'addOracleCache'.+-- The question/answer types must match those provided previously. askOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => q -> Action a askOracle question = do OracleA answer <- apply1 $ OracleQ question; return answer
src/General/Ids.hs view
@@ -89,7 +89,7 @@ S{..} <- readIORef ref -- execute in O(1) stack- -- see http://neilmitchell.blogspot.co.uk/2015/09/making-sequencemapm-for-io-take-o1-stack.html+ -- see https://neilmitchell.blogspot.co.uk/2015/09/making-sequencemapm-for-io-take-o1-stack.html let index r i | i >= used = [] index r i | IO io <- readArray values i = case io r of (# r, Nothing #) -> index r (i+1)
src/Test/Docs.hs view
@@ -35,7 +35,13 @@ cmd_ (RemEnv "GHC_PACKAGE_PATH") (Cwd root) "runhaskell Setup.hs configure" ["--builddir=" ++ dist,"--user"] -- package-db is very sensitive, see #267- ["--package-db=" ++ x | x <- maybe [] (filter (`notElem` [".",""]) . splitSearchPath) path]+ -- note that the reverse ensures the behaviour is consistent between the flags and the env variable+ ["--package-db=" ++ x | x <- maybe [] (reverse . filter (`notElem` [".",""]) . splitSearchPath) path]+ -- Paths_shake is only created by "Setup build" (which we want to skip), and required by "Setup haddock", so we fake it+ copyFile' (root </> "src/Paths.hs") "dist/build/autogen/Paths_shake.hs"+ copyFile' (root </> "src/Paths.hs") "dist/build/shake/autogen/Paths_shake.hs"+ writeFile' "dist/build/autogen/cabal_macros.h" ""+ writeFile' "dist/build/shake/autogen/cabal_macros.h" "" trackAllow ["dist//*"] index %> \_ -> do@@ -45,9 +51,6 @@ dist <- liftIO $ canonicalizePath "dist" cmd (Cwd root) "runhaskell Setup.hs haddock" ["--builddir=" ++ dist] - "Paths_shake.hs" %> \out ->- copyFile' (root </> "src/Paths.hs") out- "Part_*.hs" %> \out -> do need [root </> "src/Test/Docs.hs"] -- so much of the generator is in this module let noR = filter (/= '\r')@@ -82,7 +85,7 @@ ,"import System.Console.GetOpt" ,"import System.Directory(setCurrentDirectory)" ,"import qualified System.Directory"- ,"import System.Environment(lookupEnv)"+ ,"import System.Environment(lookupEnv, getEnvironment)" ,"import System.Process" ,"import System.Exit" ,"import Control.Applicative"@@ -126,11 +129,10 @@ ,"var = undefined" ,"str = \"\""] ++ rest- liftIO $ putStrLn =<< readFile out "Files.lst" %> \out -> do need [root </> "src/Test/Docs.hs"] -- so much of the generator is in this module- need [index,"Paths_shake.hs"]+ need [index] filesHs <- getDirectoryFiles "dist/doc/html/shake" ["Development-*.html"] filesMd <- getDirectoryFiles (root </> "docs") ["*.md"] writeFileChanged out $ unlines $@@ -148,9 +150,10 @@ "Success.txt" %> \out -> do putNormal . ("Checking documentation for:\n" ++) =<< readFile' "Files.lst" needModules- need ["Main.hs", "Paths_shake.hs"]+ need ["Main.hs"]+ trackAllow ["dist//*"] needSource- cmd_ "ghc -fno-code -ignore-package=hashmap " ["-i.","-i" ++ root </> "src","Main.hs"]+ cmd_ "ghc -fno-code -ignore-package=hashmap " ["-idist/build/autogen","-i" ++ root </> "src","Main.hs"] writeFile' out "" @@ -306,7 +309,7 @@ isProgram :: String -> Bool isProgram (words -> x:xs) = x `elem` programs && all (\x -> isCmdFlag x || isFilePath x || all isAlpha x || x == "&&") xs- where programs = words "excel gcc cl make ghc cabal distcc build tar git fsatrace ninja touch pwd runhaskell rot13 main shake stack rm cat sed sh apt-get build-multiple"+ where programs = words "excel gcc cl make ghc ghci cabal distcc build tar git fsatrace ninja touch pwd runhaskell rot13 main shake stack rm cat sed sh apt-get build-multiple" -- | Should a fragment be whitelisted and not checked whitelist :: String -> Bool
src/Test/Monad.hs view
@@ -23,38 +23,37 @@ test build = do let conv x = either (Left . fromException) Right x :: Either (Maybe ArithException) Int- let dump ro rw = do liftIO . (=== ro) =<< getRO; liftIO . (=== rw) =<< getRW+ let dump rw = liftIO . (=== rw) =<< getRW -- test the basics plus exception handling run 1 "test" $ do- dump 1 "test"+ dump "test" putRW "more"- dump 1 "more"- res <- tryRAW $ withRO (+3) $ do- dump 4 "more"- withRW (++ "x") $- dump 4 "morex"- dump 4 "more"+ dump "more"+ res <- tryRAW $ do+ dump "more"+ modifyRW (++ "x")+ dump "morex" return 100 liftIO $ conv res === Right 100- dump 1 "more"+ dump "morex" putRW "new"- dump 1 "new"- res <- tryRAW $ withRO (+2) $ do- dump 3 "new"- withRW (++ "x") $ do- dump 3 "newx"- throwRAW Overflow+ dump "new"+ res <- tryRAW $ do+ dump "new"+ modifyRW (++ "z")+ dump "newz"+ throwRAW Overflow error "Should not have reached here" return 9 liftIO $ conv res === Left (Just Overflow)- dump 1 "new"+ dump "newz" catchRAW (catchRAW (throwRAW Overflow) $ \_ -> modifyRW (++ "x")) $ \_ -> modifyRW (++ "y")- dump 1 "newx"+ dump "newzx" catchRAW (catchRAW (throwRAW Overflow) $ \e -> modifyRW (++ "x") >> throwRAW e) $ \_ -> modifyRW (++ "y")- dump 1 "newxxy"+ dump "newzxxy" -- test capture run 1 "test" $ do
src/Test/Oracle.hs view
@@ -12,7 +12,10 @@ import Test.Type hiding (RandomType) import qualified Test.Type as T import Control.Monad+import Data.Functor+import Prelude + -- These are instances we'll compute over type instance RuleResult String = String type instance RuleResult Int = String@@ -20,6 +23,10 @@ type instance RuleResult Bool = Bool -- test results don't have to be a boolean +newtype FileLen = FileLen FilePath+ deriving (Eq,Show,NFData,Typeable,Hashable,Binary)+type instance RuleResult FileLen = Int+ newtype RandomType = RandomType (BinarySentinel String) deriving (Eq,Show,NFData,Typeable,Hashable,Binary) @@ -51,6 +58,14 @@ add "unit" () add "int" (0 :: Int) + addOracleCache $ \(FileLen file) -> do+ liftIO $ appendFile ".log" "#"+ length <$> readFile' file+ "cache_out.txt" %> \out -> do+ o <- askOracle (FileLen "cache_in.txt")+ liftIO $ appendFile ".log" "!"+ writeFile' out $ show o+ test build = do build ["clean"] @@ -73,6 +88,21 @@ build ["--def=string=test","string.txt"] assertContents "string.txt" "test" assertContents ".log" ".."++ writeFile ".log" ""+ writeFile "cache_in.txt" "aaa"+ build ["cache_out.txt","--sleep"]+ assertContents "cache_out.txt" "3"+ assertContents ".log" "#!"+ writeFile "cache_in.txt" "zzz"+ build ["cache_out.txt","--sleep"]+ build ["cache_out.txt","--sleep"]+ assertContents "cache_out.txt" "3"+ assertContents ".log" "#!#"+ writeFile "cache_in.txt" "zzzz"+ build ["cache_out.txt","--sleep"]+ assertContents "cache_out.txt" "4"+ assertContents ".log" "#!##!" -- check error messages are good let errors args err = assertException [err] $ build $ "--quiet" : args