shake 0.16.2 → 0.16.3

raw patch · 17 files changed

+187/−94 lines, 17 files

Files

• CHANGES.txt +5/−0
• shake.cabal +8/−6
• src/Development/Shake/Internal/Args.hs +9/−12
• src/Development/Shake/Internal/Demo.hs +11/−24
• src/Development/Shake/Internal/Paths.hs +72/−0
• src/Development/Shake/Internal/Profile.hs +4/−6
• src/Development/Shake/Internal/Progress.hs +4/−6
• src/Development/Shake/Internal/Rules/Directory.hs +11/−7
• src/Development/Shake/Internal/Rules/File.hs +9/−4
• src/Development/Shake/Internal/Rules/Files.hs +2/−2
• src/Development/Shake/Util.hs +5/−5
• src/General/Extra.hs +26/−0
• src/Paths.hs +4/−15
• src/Test/Manual.hs +7/−3
• src/Test/Ninja.hs +2/−0
• src/Test/Ninja/test7.ninja +6/−0
• src/Test/Type.hs +2/−4

@@ -1,5 +1,10 @@ Changelog for Shake +0.16.3, released 2018-02-23+    Allow reading data files from next to the executable+    #566, require extra-1.6.1+    #565, deal with multi-file rules that don't create their contents+    Improve the documentation of getDirectoryContents 0.16.2, released 2018-02-13     Set the correct lower bound on unordered-containers of 0.2.7 0.16.1, released 2018-02-11

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               shake-version:            0.16.2+version:            0.16.3 license:            BSD3 license-file:       LICENSE category:           Development, Shake@@ -35,9 +35,9 @@ extra-doc-files:     CHANGES.txt     README.md-extra-source-files:     docs/Manual.md     docs/shake-progress.png+extra-source-files:     src/Paths.hs     src/Test/C/constants.c     src/Test/C/constants.h@@ -52,7 +52,6 @@     src/Test/Tup/newmath/square.c     src/Test/Tup/newmath/square.h     src/Test/Tup/root.cfg- data-files:     docs/manual/build.bat     docs/manual/Build.hs@@ -83,7 +82,7 @@         bytestring,         deepseq >= 1.1,         directory,-        extra >= 1.5.3,+        extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,         js-flot,@@ -142,6 +141,7 @@         Development.Shake.Internal.FileName         Development.Shake.Internal.FilePattern         Development.Shake.Internal.Options+        Development.Shake.Internal.Paths         Development.Shake.Internal.Profile         Development.Shake.Internal.Progress         Development.Shake.Internal.Resource@@ -187,7 +187,7 @@         bytestring,         deepseq >= 1.1,         directory,-        extra >= 1.5.3,+        extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,         js-flot,@@ -241,6 +241,7 @@         Development.Shake.Internal.FileName         Development.Shake.Internal.FilePattern         Development.Shake.Internal.Options+        Development.Shake.Internal.Paths         Development.Shake.Internal.Profile         Development.Shake.Internal.Progress         Development.Shake.Internal.Resource@@ -291,7 +292,7 @@         bytestring,         deepseq >= 1.1,         directory,-        extra >= 1.5.3,+        extra >= 1.6.1,         filepath,         hashable >= 1.1.2.3,         js-flot,@@ -348,6 +349,7 @@         Development.Shake.Internal.FileName         Development.Shake.Internal.FilePattern         Development.Shake.Internal.Options+        Development.Shake.Internal.Paths         Development.Shake.Internal.Profile         Development.Shake.Internal.Progress         Development.Shake.Internal.Resource

@@ -6,7 +6,7 @@     shakeArgs, shakeArgsWith, shakeArgsOptionsWith     ) where -import Paths_shake+import Development.Shake.Internal.Paths import Development.Shake.Internal.Options import Development.Shake.Internal.Core.Rules import Development.Shake.Internal.Demo@@ -26,8 +26,7 @@ import Data.Functor import Data.List import Data.Maybe-import Data.Version(showVersion)-import System.Directory+import System.Directory.Extra import System.Environment import System.Exit import System.Time.Extra@@ -149,9 +148,9 @@     if Help `elem` flagsExtra then         showHelp      else if Version `elem` flagsExtra then-        putWhenLn Normal $ "Shake build system, version " ++ showVersion version+        putWhenLn Normal $ "Shake build system, version " ++ shakeVersionString      else if NumericVersion `elem` flagsExtra then-        putWhenLn Normal $ showVersion version+        putWhenLn Normal shakeVersionString      else if Demo `elem` flagsExtra then         demo $ shakeStaunch shakeOpts      else if not $ null progressReplays then do@@ -164,12 +163,8 @@      else do         when (Sleep `elem` flagsExtra) $ threadDelay 1000000         start <- offsetTime-        curdir <- getCurrentDirectory-        let redir = case changeDirectory of-                Nothing -> id-                -- get the "html" directory so it caches with the current directory-                -- required only for debug code-                Just d -> bracket_ (getDataFileName "html" >> setCurrentDirectory d) (setCurrentDirectory curdir)+        initDataDirectory -- must be done before we start changing directory+        let redir = maybe id withCurrentDirectory changeDirectory         shakeOpts <- if null progressRecords then return shakeOpts else do             t <- offsetTime             return shakeOpts{shakeProgress = \p ->@@ -184,7 +179,9 @@                         return p             }         (ran,shakeOpts,res) <- redir $ do-            when printDirectory $ putWhenLn Normal $ "shake: In directory `" ++ curdir ++ "'"+            when printDirectory $ do+                curdir <- getCurrentDirectory+                putWhenLn Normal $ "shake: In directory `" ++ curdir ++ "'"             rules <- rules shakeOpts user files             case rules of                 Nothing -> return (False, shakeOpts, Right ())

@@ -2,20 +2,19 @@ -- | Demo tutorial, accessed with --demo module Development.Shake.Internal.Demo(demo) where -import Paths_shake+import Development.Shake.Internal.Paths import Development.Shake.Command  import Control.Applicative import Control.Exception.Extra import Control.Monad-import General.Extra import Data.Char import Data.List import Data.Maybe-import Data.Version(showVersion) import System.Directory import System.Exit import System.FilePath+import General.Extra import Development.Shake.FilePath(exe) import System.IO import System.Info.Extra@@ -25,29 +24,19 @@ demo :: Bool -> IO () demo auto = do     hSetBuffering stdout NoBuffering-    putStrLn $ "% Welcome to the Shake v" ++ showVersion version ++ " demo mode!"-    putStr "% Detecting machine configuration... "--    -- CONFIGURE+    putStrLn $ "% Welcome to the Shake v" ++ shakeVersionString ++ " demo mode!" -    manual <- getDataFileName "docs/manual"-    hasManual <- wrap $ doesDirectoryExist manual-    ghc <- findExecutable "ghc"-    gcc <- do-        v <- findExecutable "gcc"-        case v of-            Nothing | isWindows, Just ghc <- ghc -> do-                let dir = takeDirectory (takeDirectory ghc) </> "bin/mingw/gcc.exe"-                b <- wrap $ doesFileExist dir-                return $ if b then Just dir else Nothing-            _ -> return v+    putStr "% Detecting machine configuration... "+    hasManual <- hasManualData+    ghc <- isJust <$> findExecutable "ghc"+    (gcc, gccPath) <- findGcc     shakeLib <- wrap $ fmap (not . null . words . fromStdout) (cmd "ghc-pkg list --simple-output shake")     ninja <- findExecutable "ninja"     putStrLn "done\n"      let path = if isWindows then "%PATH%" else "$PATH"-    require (isJust ghc) $ "% You don't have 'ghc' on your " ++ path ++ ", which is required to run the demo."-    require (isJust gcc) $ "% You don't have 'gcc' on your " ++ path ++ ", which is required to run the demo."+    require ghc $ "% You don't have 'ghc' on your " ++ path ++ ", which is required to run the demo."+    require gcc $ "% You don't have 'gcc' on your " ++ path ++ ", which is required to run the demo."     require shakeLib "% You don't have the 'shake' library installed with GHC, which is required to run the demo."     require hasManual "% You don't have the Shake data files installed, which are required to run the demo." @@ -63,9 +52,7 @@     require b "% Please create an empty directory to run the demo from, then run 'shake --demo' again."      putStr "% Copying files... "-    createDirectoryRecursive dir-    forM_ ["Build.hs","main.c","constants.c","constants.h","build" <.> if isWindows then "bat" else "sh"] $ \file ->-        copyFile (manual </> file) (dir </> file)+    copyManualData dir     unless isWindows $ do          p <- getPermissions $ dir </> "build.sh"          setPermissions (dir </> "build.sh") p{executable=True}@@ -76,7 +63,7 @@             if auto then putLine "" else getLine     let execute x = do             putStrLn $ "% RUNNING: " ++ x-            cmd (Cwd dir) Shell x :: IO ()+            cmd (Cwd dir) (AddPath [] (maybeToList gccPath)) Shell x :: IO ()     let build = if isWindows then "build" else "./build.sh"      putStrLn "\n% [1/5] Building an example project with Shake."

@@ -0,0 +1,72 @@++-- | The information from Paths_shake cleaned up+module Development.Shake.Internal.Paths(+    shakeVersionString,+    initDataDirectory,+    hasManualData, copyManualData,+    readDataFileHTML+    ) where++import Paths_shake+import Control.Exception+import Control.Monad.Extra+import Data.Version+import System.Directory+import System.FilePath+import System.Info.Extra+import System.IO.Unsafe+import System.Environment.Extra+import General.Extra+import Data.Functor+import qualified Data.ByteString.Lazy as LBS+import Prelude+++shakeVersionString :: String+shakeVersionString = showVersion version+++-- We want getDataFileName to be relative to the current directory on program startup,+-- even if we issue a change directory command. Therefore, first call caches, future ones read.+{-# NOINLINE dataDirs #-}+dataDirs :: [String]+dataDirs = unsafePerformIO $ do+    datdir <- getDataDir+    exedir <- takeDirectory <$> getExecutablePath `catchIO` \_ -> return ""+    curdir <- getCurrentDirectory+    return $ [datdir] ++ [exedir | exedir /= ""] ++ [curdir]+++-- The data files may be located relative to the current directory, if so cache it in advance+initDataDirectory :: IO ()+initDataDirectory = void $ evaluate dataDirs+++getDataFile :: FilePath -> IO FilePath+getDataFile file = do+    let poss = map (</> file) dataDirs+    res <- filterM doesFileExist_ poss+    case res of+        [] -> fail $ unlines $ ("Could not find data file " ++ file ++ ", looked in:") : map ("  " ++) poss+        x:_ -> return x++hasDataFile :: FilePath -> IO Bool+hasDataFile file = anyM (\dir -> doesFileExist_ $ dir </> file) dataDirs+++readDataFileHTML :: FilePath -> IO LBS.ByteString+readDataFileHTML file = LBS.readFile =<< getDataFile ("html" </> file)+++manualFiles :: [FilePath]+manualFiles = map ("docs/manual" </>) ["Build.hs","main.c","constants.c","constants.h","build" <.> if isWindows then "bat" else "sh"]++hasManualData :: IO Bool+hasManualData = allM hasDataFile manualFiles++copyManualData :: FilePath -> IO ()+copyManualData dest = do+    createDirectoryRecursive dest+    forM_ manualFiles $ \file -> do+        src <- getDataFile file+        copyFile src (dest </> takeFileName file)

@@ -6,11 +6,10 @@ import Data.Tuple.Extra import Data.Function import Data.List-import Data.Version import System.FilePath import Numeric.Extra import General.Extra-import Paths_shake+import Development.Shake.Internal.Paths import System.Time.Extra import qualified Data.ByteString.Lazy.Char8 as LBS @@ -55,11 +54,10 @@  generateHTML :: [ProfileEntry] -> IO LBS.ByteString generateHTML xs = do-    htmlDir <- getDataFileName "html"-    report <- LBS.readFile $ htmlDir </> "profile.html"+    report <- readDataFileHTML "profile.html"     let f name | name == "profile-data.js" = return $ LBS.pack $ "var profile =\n" ++ generateJSON xs-               | name == "version.js" = return $ LBS.pack $ "var version = " ++ show (showVersion version)-               | otherwise = LBS.readFile $ htmlDir </> name+               | name == "version.js" = return $ LBS.pack $ "var version = " ++ show shakeVersionString+               | otherwise = readDataFileHTML name     runTemplate f report  

@@ -20,13 +20,12 @@ import Data.IORef import Data.List import Data.Maybe-import Data.Version import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Numeric.Extra import General.Template import System.IO.Unsafe-import Paths_shake+import Development.Shake.Internal.Paths import System.Time.Extra import Data.Semigroup (Semigroup (..)) import Data.Monoid hiding ((<>))@@ -279,11 +278,10 @@  generateHTML :: [(FilePath, [ProgressEntry])] -> IO LBS.ByteString generateHTML xs = do-    htmlDir <- getDataFileName "html"-    report <- LBS.readFile $ htmlDir </> "progress.html"+    report <- readDataFileHTML "progress.html"     let f name | name == "progress-data.js" = return $ LBS.pack $ "var progress =\n" ++ generateJSON xs-               | name == "version.js" = return $ LBS.pack $ "var version = " ++ show (showVersion version)-               | otherwise = LBS.readFile $ htmlDir </> name+               | name == "version.js" = return $ LBS.pack $ "var version = " ++ show shakeVersionString+               | otherwise = readDataFileHTML name     runTemplate f report  generateJSON :: [(FilePath, [ProgressEntry])] -> String

@@ -182,9 +182,10 @@ getEnvWithDefault def var = fromMaybe def <$> getEnv var  -- | Get the contents of a directory. The result will be sorted, and will not contain---   the entries @.@ or @..@ (unlike the standard Haskell version). The resulting paths will be relative---   to the first argument. The result is tracked as a---   dependency, and if it changes the rule will rerun in subsequent builds.+--   the entries @.@ or @..@ (unlike the standard Haskell version).+--   The resulting paths will be relative to the first argument.+--   The result itself is tracked as a dependency, but the files in the result are not.+--   If the list of files changes in subsequent builds any rule calling it will rerun. -- --   It is usually simpler to call either 'getDirectoryFiles' or 'getDirectoryDirs'. getDirectoryContents :: FilePath -> Action [FilePath]@@ -192,8 +193,9 @@  -- | Get the files anywhere under a directory that match any of a set of patterns. --   For the interpretation of the patterns see '?=='. All results will be---   relative to the directory argument. The result is tracked as a---   dependency, and if it changes the rule will rerun in subsequent builds.+--   relative to the directory argument.+--   The result itself is tracked as a dependency, but the files in the result are not.+--   If the list of files changes in subsequent builds any rule calling it will rerun. --   Some examples: -- -- > getDirectoryFiles "Config" ["//*.xml"]@@ -229,8 +231,10 @@ getDirectoryFiles dir pat = fmap fromGetDirectoryA $ apply1 $ GetDirectoryFilesQ (dir,pat)  -- | Get the directories in a directory, not including @.@ or @..@.---   All directories are relative to the argument directory. The result is tracked as a---   dependency, and if it changes the rule will rerun in subsequent builds.+--   All directories are relative to the argument directory.+--   The result itself is tracked as a dependency, but the directories in the result are not.+--   If the list of directories changes in subsequent builds any rule calling it will rerun.+ --   The rules about creating entries described in 'getDirectoryFiles' also apply here. -- -- > getDirectoryDirs "/Users"

@@ -72,7 +72,7 @@ data Mode     = ModePhony (Action ()) -- ^ An action with no file value     | ModeDirect (Action ()) -- ^ An action that produces this file-    | ModeForward (Action FileA) -- ^ An action that looks up a file someone else produced+    | ModeForward (Action (Maybe FileA)) -- ^ An action that looks up a file someone else produced  -- | The results of the various 'Mode' rules. data Result@@ -272,8 +272,13 @@                 Nothing -> do                     new <- liftIO $ storedValueError opts True "Error, file does not exist and no rule available:" o                     answer ResultDirect $ fromJust new-                Just (ModeForward act) ->-                    answer ResultForward =<< act+                Just (ModeForward act) -> do+                    new <- act+                    case new of+                        Nothing -> do+                            alwaysRerun+                            retNew ChangedRecomputeDiff ResultPhony+                        Just new -> answer ResultForward new                 Just (ModeDirect act) -> do                     act                     new <- liftIO $ storedValueError opts False "Error, rule finished running but did not produce file:" o@@ -320,7 +325,7 @@ -- OPTIONS ON TOP  -- | Internal method for adding forwarding actions-fileForward :: (FilePath -> Maybe (Action FileA)) -> Rules ()+fileForward :: (FilePath -> Maybe (Action (Maybe FileA))) -> Rules () fileForward act = addUserRule $ FileRule $ fmap ModeForward . act  

@@ -135,7 +135,7 @@             (if simple p then id else priority 0.5) $                 fileForward $ let op = (p ?==) in \file -> if not $ op file then Nothing else Just $ do                     FilesA res <- apply1 $ FilesQ $ map (FileQ . fileNameFromString . substitute (extract p file)) ps-                    return $ res !! i+                    return $ if null res then Nothing else Just $ res !! i         (if all simple ps then id else priority 0.5) $             addUserRule $ \(FilesQ xs_) -> let xs = map (fileNameToString . fromFileQ) xs_ in                 if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do@@ -184,7 +184,7 @@         Nothing -> Nothing         Just ys -> Just $ do             FilesA res <- apply1 $ FilesQ $ map (FileQ . fileNameFromString) ys-            return $ res !! fromJust (elemIndex x ys)+            return $ if null res then Nothing else Just $ res !! fromJust (elemIndex x ys)      addUserRule $ \(FilesQ xs_) -> let xs@(x:_) = map (fileNameToString . fromFileQ) xs_ in         case checkedTest x of

@@ -79,11 +79,11 @@     let flags2 = Option "P" ["prune"] (NoArg $ Right Nothing) "Remove stale files" : map (fmapOptDescr Just) flags     pruning <- newIORef False     shakeArgsWith opts flags2 $ \opts args ->-        if any isNothing opts then do-            writeIORef pruning True-            return Nothing-        else-            act (map fromJust opts) args+        case sequence opts of+            Nothing -> do+                writeIORef pruning True+                return Nothing+            Just opts -> act opts args     whenM (readIORef pruning) $         IO.withTempFile $ \file -> do             shakeArgsWith opts{shakeLiveFiles=file : shakeLiveFiles opts} flags2 $ \opts args ->

@@ -2,6 +2,7 @@  module General.Extra(     getProcessorCount,+    findGcc,     withResultType,     whenLeft,     randomElem,@@ -11,6 +12,7 @@     fastAt,     forkFinallyUnmasked,     isAsyncException,+    doesFileExist_,     removeFile_, createDirectoryRecursive,     catchIO, tryIO, handleIO     ) where@@ -21,10 +23,13 @@ import System.Environment.Extra import System.IO.Extra import System.IO.Unsafe+import System.Info.Extra+import System.FilePath import System.Random import System.Directory import System.Exit import Control.Concurrent+import Data.Maybe import Data.Functor import Data.Primitive.Array import Control.Applicative@@ -97,11 +102,29 @@                         return $! max 1 $ length [() | x <- lines src, "processor" `isPrefixOf` x]  +-- Can you find a GCC executable? return a Bool, and optionally something to add to $PATH to run it+findGcc :: IO (Bool, Maybe FilePath)+findGcc = do+    v <- findExecutable "gcc"+    case v of+        Nothing | isWindows -> do+            ghc <- findExecutable "ghc"+            case ghc of+                Just ghc -> do+                    let gcc = takeDirectory (takeDirectory ghc) </> "mingw/bin/gcc.exe"+                    b <- doesFileExist_ gcc+                    return $ if b then (True, Just $ takeDirectory gcc) else (False, Nothing)+                _ -> return (False, Nothing)+        _ -> return (isJust v, Nothing)+++ --------------------------------------------------------------------- -- System.Random  randomElem :: [a] -> IO a randomElem xs = do+    when (null xs) $ fail "General.Extra.randomElem called with empty list, can't pick a random element"     i <- randomRIO (0, length xs - 1)     return $ xs !! i @@ -146,6 +169,9 @@  --------------------------------------------------------------------- -- System.Directory++doesFileExist_ :: FilePath -> IO Bool+doesFileExist_ x = doesFileExist x `catchIO` \_ -> return False  -- | Remove a file, but don't worry if it fails removeFile_ :: FilePath -> IO ()

@@ -1,23 +1,12 @@ -- | Fake cabal module for local building -module Paths_shake(getDataFileName, version) where+module Paths_shake(getDataDir, version) where  import Data.Version.Extra-import System.IO.Unsafe-import System.Directory-import Control.Exception ---- We want getDataFileName to be relative to the current directory even if--- we issue a change directory command. Therefore, first call caches, future ones read.-{-# NOINLINE curdir #-}-curdir :: String-curdir = unsafePerformIO getCurrentDirectory--getDataFileName :: FilePath -> IO FilePath-getDataFileName x = do-    evaluate curdir-    return $ curdir ++ "/" ++ x+-- If Shake can't find files in the data directory it tries relative to the executable+getDataDir :: IO FilePath+getDataDir = return "random_path_that_cannot_possibly_exist"  version :: Version version = makeVersion [0,0]

@@ -4,6 +4,8 @@ import Development.Shake hiding (copyFileChanged) import Development.Shake.FilePath import Test.Type+import General.Extra+import Data.Maybe import System.Info.Extra  @@ -18,9 +20,11 @@     copyDirectoryChanged (root </> "src/Development") $ dest </> "Development"     copyDirectoryChanged (root </> "src/General") $ dest </> "General"     copyFileChanged (root </> "src/Paths.hs") $ dest </> "Paths_shake.hs"+    (_, gccPath) <- findGcc+    let opts = [Cwd dest, Shell, AddPath [] (maybeToList gccPath)]     let cmdline = if isWindows then "build.bat" else "/bin/sh build.sh"-    cmd_ [Cwd dest, Shell] cmdline "-j2"+    cmd_ opts cmdline "-j2"     assertExists $ dest </> "_build/run" <.> exe-    cmd_ [Cwd dest, Shell] cmdline-    cmd_ [Cwd dest, Shell] [cmdline,"clean"]+    cmd_ opts cmdline+    cmd_ opts [cmdline,"clean"]     assertMissing $ dest </> "_build/run" <.> exe

@@ -61,6 +61,8 @@     run "-f../../src/Test/Ninja/test5.ninja"     assertExists "output file" +    run "-f../../src/Test/Ninja/test7.ninja"+     writeFile "nocreate.log" ""     writeFile "nocreate.in" ""     run "-f../../src/Test/Ninja/nocreate.ninja"

@@ -0,0 +1,6 @@+ninja_required_version = 1.5+build test : phony a b+rule CUSTOM_COMMAND+   command = $COMMAND+build a b : CUSTOM_COMMAND+  COMMAND = cd

@@ -23,7 +23,7 @@ import General.Extra import Development.Shake.Internal.FileInfo import Development.Shake.FilePath-import Paths_shake+import Development.Shake.Internal.Paths  import Control.Exception.Extra import Control.Monad.Extra@@ -65,9 +65,7 @@     -> IO ()     -> IO () shakenEx reenter options test rules sleeper = do-    -- my debug getDataFileName (in Paths) uses a cache of the Cwd-    -- make sure we force the cache before changing directory-    getDataFileName ""+    initDataDirectory      name:args <- getArgs     putStrLn $ "## BUILD " ++ unwords (name:args)