packages feed

shake 0.19.2 → 0.19.3

raw patch · 18 files changed

+139/−28 lines, 18 filesdep ~basedep ~filepath

Dependency ranges changed: base, filepath

Files

CHANGES.txt view
@@ -1,5 +1,8 @@ Changelog for Shake (* = breaking change) +0.19.3, released 2021-01-14+    #789, add overrideBuiltinRule+    #787, more documentation on doesFileExist 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
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2011-2020.+Copyright Neil Mitchell 2011-2021. All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,4 +1,4 @@-# Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?label=Hackage)](https://hackage.haskell.org/package/shake) [![Stackage version](https://www.stackage.org/package/shake/badge/nightly?label=Stackage)](https://www.stackage.org/package/shake) [![Linux build status](https://img.shields.io/travis/ndmitchell/shake/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/shake) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/shake/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/shake)+# Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?label=Hackage)](https://hackage.haskell.org/package/shake) [![Stackage version](https://www.stackage.org/package/shake/badge/nightly?label=Stackage)](https://www.stackage.org/package/shake) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/shake/ci.svg)](https://github.com/ndmitchell/shake/actions)  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). 
shake.cabal view
@@ -1,13 +1,13 @@ cabal-version:      >= 1.18 build-type:         Simple name:               shake-version:            0.19.2+version:            0.19.3 license:            BSD3 license-file:       LICENSE category:           Development, Shake author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2011-2020+copyright:          Neil Mitchell 2011-2021 synopsis:           Build system library, like Make, but more accurate dependencies. description:     Shake is a Haskell library for writing build systems - designed as a@@ -457,6 +457,7 @@         Test.Batch         Test.Benchmark         Test.Builtin+        Test.BuiltinOverride         Test.C         Test.Cache         Test.Cleanup
src/Development/Shake/Internal/Core/Rules.hs view
@@ -6,7 +6,8 @@  module Development.Shake.Internal.Core.Rules(     Rules, SRules(..), runRules,-    RuleResult, addBuiltinRule, addBuiltinRuleEx,+    RuleResult,+    addBuiltinRule, overrideBuiltinRule, addBuiltinRuleEx,     noLint, noIdentity,     getShakeOptionsRules,     getUserRuleInternal, getUserRuleOne, getUserRuleList, getUserRuleMaybe,@@ -132,7 +133,7 @@     ref <- newIORef mempty     runReaderT r (opts, ref)     SRules{..} <- readIORef ref-    pure $ SRules (runListBuilder actions) builtinRules userRules (runListBuilder targets) (runListBuilder helpSuffix)+    pure $ SRules (runListBuilder actions) builtinRules userRules (runListBuilder targets) (runListBuilder helpSuffix) override  -- | Get all targets registered in the given rules. The names in --   'Development.Shake.phony' and 'Development.Shake.~>' as well as the file patterns@@ -160,14 +161,20 @@     ,userRules :: !(TMap.Map UserRuleVersioned)     ,targets :: !(list Target)     ,helpSuffix :: !(list String)+    ,override :: Bool     }  instance Semigroup (SRules ListBuilder) where-    (SRules x1 x2 x3 x4 x5) <> (SRules y1 y2 y3 y4 y5) = SRules (mappend x1 y1) (Map.unionWithKey f x2 y2) (TMap.unionWith (<>) x3 y3) (mappend x4 y4) (mappend x5 y5)-        where f k a b = throwImpure $ errorRuleDefinedMultipleTimes k [builtinLocation a, builtinLocation b]+    (SRules x1 x2 x3 x4 x5 x6) <> (SRules y1 y2 y3 y4 y5 y6) =+      SRules (mappend x1 y1) (Map.unionWithKey f x2 y2) (TMap.unionWith (<>) x3 y3) (mappend x4 y4) (mappend x5 y5) pleaseOverwrite+      where+        pleaseOverwrite = x6 || y6+        f k a b+          | pleaseOverwrite = b+          | otherwise = throwImpure $ errorRuleDefinedMultipleTimes k [builtinLocation a, builtinLocation b]  instance Monoid (SRules ListBuilder) where-    mempty = SRules mempty Map.empty TMap.empty mempty mempty+    mempty = SRules mempty Map.empty TMap.empty mempty mempty False     mappend = (<>)  instance Semigroup a => Semigroup (Rules a) where@@ -220,6 +227,19 @@ --   See 'addBuiltinRule' and 'Development.Shake.Rule.apply'. type family RuleResult key -- = value +addBuiltinRuleCanOverride ::+  (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial) =>+  Bool ->+  BuiltinLint key value ->+  BuiltinIdentity key value ->+  BuiltinRun key value ->+  Rules ()+addBuiltinRuleCanOverride canOverride =+  withFrozenCallStack $+    addBuiltinRuleInternal canOverride $+      BinaryOp+        (putEx . Bin.toLazyByteString . execPut . put)+        (runGet get . LBS.fromChunks . pure) -- | Before looking at this function, you should read the warnings at the top of this module. --   This function is not often necessary in build systems. --@@ -234,27 +254,39 @@ addBuiltinRule     :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)     => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()-addBuiltinRule = withFrozenCallStack $ addBuiltinRuleInternal $ BinaryOp-    (putEx . Bin.toLazyByteString . execPut . put)-    (runGet get . LBS.fromChunks . pure)+addBuiltinRule = addBuiltinRuleCanOverride False +-- | Like 'addBuiltinRule' but doesn't raise an error if a rule already exists.+--   In most cases 'addBuiltinRule' should be used.+overrideBuiltinRule ::+  (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial) =>+  BuiltinLint key value ->+  BuiltinIdentity key value ->+  BuiltinRun key value ->+  Rules ()+overrideBuiltinRule = addBuiltinRuleCanOverride True+ addBuiltinRuleEx     :: (RuleResult key ~ value, ShakeValue key, BinaryEx key, Typeable value, NFData value, Show value, Partial)     => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()-addBuiltinRuleEx = addBuiltinRuleInternal $ BinaryOp putEx getEx+addBuiltinRuleEx = addBuiltinRuleInternal False $ BinaryOp putEx getEx   -- | Unexpected version of 'addBuiltinRule', which also lets me set the 'BinaryOp'. addBuiltinRuleInternal     :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)-    => BinaryOp key -> BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()-addBuiltinRuleInternal binary lint check (run :: BuiltinRun key value) = do+    => Bool -> BinaryOp key -> BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()+addBuiltinRuleInternal override binary lint check (run :: BuiltinRun key value) = do     let k = Proxy :: Proxy key     let lint_ k v = lint (fromKey k) (fromValue v)     let check_ k v = check (fromKey k) (fromValue v)     let run_ k v b = fmap newValue <$> run (fromKey k) v b     let binary_ = BinaryOp (putOp binary . fromKey) (newKey . getOp binary)-    newRules mempty{builtinRules = Map.singleton (typeRep k) $ BuiltinRule lint_ check_ run_ binary_ (Ver 0) callStackTop}+    newRules+      mempty+        { builtinRules = Map.singleton (typeRep k) $ BuiltinRule lint_ check_ run_ binary_ (Ver 0) callStackTop,+          override+        }   -- | Change the priority of a given set of rules, where higher values take precedence.
src/Development/Shake/Internal/Derived.hs view
@@ -17,7 +17,7 @@ import Control.Monad.IO.Class import System.Directory import System.FilePath (takeDirectory)-import System.IO+import System.IO (IOMode (..), hGetContents, withFile) import qualified System.IO.Extra as IO  import Development.Shake.Internal.Errors
src/Development/Shake/Internal/Rules/Directory.hs view
@@ -148,15 +148,38 @@  -- | Returns 'True' if the file exists. The existence of the file is tracked as a --   dependency, and if the file is created or deleted the rule will rerun in subsequent builds.+--   Usually used to implement include paths. For example, given a include path of @foo@ and @bar@,+--   and a file @hello.txt@, you might write: --+-- @+-- b <- 'doesFileExist' \"foo\/hello.txt\"+-- let file = if b then \"foo\/hello.txt\" else "\bar\/hello.txt\"+-- @+--+--   Now if the user had a file @bar\/hello.txt@, and then creates a file @foo\/hello.txt@, the+--   rule would correctly rerun, as while the @hello.txt@ that was used didn't change, which+--   file should be used has changed.+-- --   You should not call 'doesFileExist' on files which can be created by the build system.+--   The reason is that Shake operations such as this one are both cached for the duration of the build,+--   and may be run preemptively during a recheck. That means you can't control the time at which+--   'doesFileExist' is called. For that to be consistent, 'doesFileExist' must return the same result at the+--   start and end of the build, a property that is partially checked by the @--lint@ flag. Given a+--   file created by the build system, a build from clean will return 'False' at the beginning and 'True'+--   at the end, leading to a change, and thus rebuilds in subsequent runs.+--+--   If you do want to know whether a file exists separate to the build system, e.g. you can perfectly+--   predict the files contents and can save some meaningful work if the file already exists, you should+--   use the untracked "System.Directory" version. Such calls are not tracked by the file system, and you+--   should take care not to result in unpredictable results. doesFileExist :: FilePath -> Action Bool doesFileExist = fmap fromDoesFileExistA . apply1 . DoesFileExistQ . toStandard  -- | Returns 'True' if the directory exists. The existence of the directory is tracked as a --   dependency, and if the directory is created or delete the rule will rerun in subsequent builds. -----   You should not call 'doesDirectoryExist' on directories which can be created by the build system.+--   You should not call 'doesDirectoryExist' on directories which can be created by the build system,+--   for reasons explained in 'doesFileExist'. doesDirectoryExist :: FilePath -> Action Bool doesDirectoryExist = fmap fromDoesDirectoryExistA . apply1 . DoesDirectoryExistQ . toStandard 
src/Development/Shake/Rule.hs view
@@ -16,7 +16,7 @@      -- * Defining builtin rules     -- | Functions and types for defining new types of Shake rules.-    addBuiltinRule,+    addBuiltinRule, overrideBuiltinRule,     BuiltinLint, noLint, BuiltinIdentity, noIdentity, BuiltinRun, RunMode(..), RunChanged(..), RunResult(..),     -- * Calling builtin rules     -- | Wrappers around calling Shake rules. In general these should be specialised to a builtin rule.
src/Run.hs view
@@ -14,6 +14,7 @@ import General.GetOpt import System.Process import System.Exit+import Data.Either.Extra   main :: IO ()@@ -51,4 +52,4 @@         ]  findFile :: [FilePath] -> IO (Maybe FilePath)-findFile = findM (fmap (either (const False) id) . tryIO . IO.doesFileExist)+findFile = findM (fmap (fromRight False) . tryIO . IO.doesFileExist)
src/Test.hs view
@@ -18,6 +18,7 @@ import qualified Test.Batch import qualified Test.Benchmark import qualified Test.Builtin+import qualified Test.BuiltinOverride import qualified Test.C import qualified Test.Cache import qualified Test.Cleanup@@ -74,6 +75,7 @@     ,"batch" * Test.Batch.main     ,"benchmark" * Test.Benchmark.main     ,"builtin" * Test.Builtin.main+    ,"builtinOverride" * Test.BuiltinOverride.main     ,"c" * Test.C.main     ,"cache" * Test.Cache.main     ,"cleanup" * Test.Cleanup.main
+ src/Test/BuiltinOverride.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}++module Test.BuiltinOverride (main) where++import Control.Concurrent+import Development.Shake+import Development.Shake.Classes+import Development.Shake.Rule+import Test.Type++newtype Key = Key Int+  deriving (Show, Eq, Hashable, Binary, NFData, Typeable)++type instance RuleResult Key = ()++main sleep = do+  store <- newEmptyMVar++  testBuild (test store) (setRules store) sleep++setRules resultsStore = do+  addBuiltinRule noLint noIdentity $ \(Key n) _ _ -> do+    liftIO $ putMVar resultsStore n+    pure $ RunResult ChangedRecomputeDiff mempty ()+  overrideBuiltinRule noLint noIdentity $ \(Key n) _ _ -> do+    liftIO $ putMVar resultsStore (n + 1)+    pure $ RunResult ChangedRecomputeDiff mempty ()+  action $ apply1 $ Key 1++test store build = do+  build []++  res <- takeMVar store+  assertBool (res == 2) "Rule was not overriden"
src/Test/Command.hs view
@@ -27,9 +27,9 @@                           name ~> do need ["helper/shake_helper" <.> exe]; test      let helper_source = unlines-            ["import System.Time.Extra"-            ,"import System.Process"+            ["import System.Process"             ,"import Control.Monad"+            ,"import Control.Concurrent"             ,"import System.Directory"             ,"import System.Environment"             ,"import System.Exit"@@ -45,7 +45,7 @@             ,"            'x' -> exitFailure"             ,"            'c' -> putStrLn =<< getCurrentDirectory"             ,"            'v' -> putStrLn =<< getEnv rg"-            ,"            'w' -> sleep (read rg :: Double)"+            ,"            'w' -> threadDelay $ ceiling $ (read rg :: Double) * 1000000"             ,"            'r' -> LBS.putStr $ LBS.replicate (read rg) 'x'"             ,"            'i' -> putStr =<< getContents"             ,"            's' -> void $ readProcess exe [rg] \"\""
src/Test/Docs.hs view
@@ -18,7 +18,7 @@ -- GHC 8.0 has a segfault when linking Setup brokenHaddock = compilerVersion < makeVersion [8,2] -main = testBuild (unless brokenHaddock . defaultTest) $ do+main = testBuild (notCI . unless brokenHaddock . defaultTest) $ do     let index = "dist/doc/html/shake/index.html"     let setup = "dist/setup.exe"     let config = "dist/setup-config"
src/Test/Errors.hs view
@@ -195,7 +195,7 @@     crash ["failcreates"] ["failcreates"]     crash ["recursive_"] ["recursive_","intermediate_","recursive"]     crash ["rec1","rec2"] ["rec1","rec2","indirect recursion","recursive"]-    crash ["systemcmd"] $ ["systemcmd","random_missing_command"] ++ ["at cmd, called at" | hasLocations]+    notCI $ crash ["systemcmd"] $ ["systemcmd","random_missing_command"] ++ ["at cmd, called at" | hasLocations]     crash ["stack1"] ["stack1","stack2","stack3","crash"]      b <- IO.doesFileExist "staunch1"
src/Test/Self.hs view
@@ -35,6 +35,7 @@         map ("-package=" ++) <$> readFileLines ".pkgs"      let ghc args = do+            trackAllow ["**/package.cache", "**/.ghc.environment.*"]             -- since ghc-pkg includes the ghc package, it changes if the version does             ghcPkg $ GhcPkg ()             flags <- ghcFlags $ GhcFlags ()
src/Test/SelfMake.hs view
@@ -31,6 +31,7 @@         map ("-package=" ++) <$> readFileLines ".pkgs"      let ghc args = do+            trackAllow ["**/package.cache", "**/.ghc.environment.*"]             -- since ghc-pkg includes the ghc package, it changes if the version does             ghcPkg $ GhcPkg ()             flags <- ghcFlags $ GhcFlags ()
src/Test/Tup.hs view
@@ -7,9 +7,12 @@ import Development.Shake.Util import Test.Type import Data.Maybe+import Control.Monad+import System.Info.Extra  -main = testBuild defaultTest $ do+-- Running ar on Mac seems to break in CI - not sure why+main = testBuild (unless isMac . defaultTest) $ do     -- Example inspired by http://gittup.org/tup/ex_multiple_directories.html     usingConfigFile $ shakeRoot </> "src/Test/Tup/root.cfg" 
src/Test/Type.hs view
@@ -4,7 +4,7 @@     sleep, sleepFileTime, sleepFileTimeCalibrate,     testBuildArgs, testBuild, testSimple, testNone,     shakeRoot,-    defaultTest, hasTracker,+    defaultTest, hasTracker, notCI,     copyDirectoryChanged, copyFileChangedIO,     assertWithin,     assertBool, assertBoolIO, assertException, assertExceptionAfter,@@ -39,6 +39,7 @@ import General.GetOpt import System.IO.Extra as IO import System.Time.Extra+import System.Info.Extra   testBuildArgs@@ -153,10 +154,17 @@     fsatrace <- findExecutable $ "fsatrace" <.> exe     pure $ if isJust fsatrace then LintFSATrace else LintBasic +-- Tests that don't currently work on CI+notCI :: IO () -> IO ()+notCI act = do+    b <- lookupEnv "CI"+    when (isNothing b) act+ hasTracker :: IO Bool hasTracker = do     t <- tracker-    pure $ t == LintFSATrace+    -- Tracking on a Mac is pretty unreliable+    pure $ not isMac && t == LintFSATrace  assertFail :: String -> IO a assertFail msg = error $ "ASSERTION FAILED: " ++ msg