shake 0.7 → 0.8

raw patch · 7 files changed

+118/−56 lines, 7 files

Files

• Development/Shake/Directory.hs +42/−7
• Development/Shake/Locks.hs +1/−1
• Development/Shake/Oracle.hs +19/−17
• Development/Shake/Types.hs +1/−1
• Examples/Test/Directory.hs +48/−25
• Examples/Util.hs +2/−1
• shake.cabal +5/−4

@@ -119,18 +119,32 @@     return res  -- | Get the contents of a directory. The result will be sorted, and will not contain---   the files @.@ or @..@ (unlike the standard Haskell version). It is usually better to---   call either 'getDirectoryFiles' or 'getDirectoryDirs'. The resulting paths will be relative+--   the entries @.@ or @..@ (unlike the standard Haskell version). The resulting paths will be relative --   to the first argument.+--+--   It is usually simpler to call either 'getDirectoryFiles' or 'getDirectoryDirs'. getDirectoryContents :: FilePath -> Action [FilePath] getDirectoryContents x = getDirAction $ GetDir x --- | Get the files in a directory that match any of a set of patterns.---   For the interpretation of the pattern see '?=='.+-- | 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 'FilePath' argument. Some examples:+--+-- > getDirectoryFiles "Config" ["//*.xml"]+-- >     -- All .xml files anywhere under the Config directory+-- >     -- If Config/foo/bar.xml exists it will return ["foo/bar.xml"]+-- > getDirectoryFiles "Modules" ["*.hs","*.lhs"]+-- >     -- All .hs or .lhs in the Modules directory+-- >     -- If Modules/foo.hs and Modules/foo.lhs exist, it will return ["foo.hs","foo.lhs"] getDirectoryFiles :: FilePath -> [FilePattern] -> Action [FilePath] getDirectoryFiles x f = getDirAction $ GetDirFiles x f --- | Get the directories contained by a directory, does not include @.@ or @..@.+-- | Get the directories in a directory, not including @.@ or @..@.+--   All directories are relative to the argument directory.+--+-- > getDirectoryDirs "/Users"+-- >    -- Return all directories in the /Users directory+-- >    -- e.g. ["Emily","Henry","Neil"] getDirectoryDirs :: FilePath -> Action [FilePath] getDirectoryDirs x = getDirAction $ GetDirDirs x @@ -139,6 +153,7 @@ contents :: FilePath -> IO [FilePath] contents = fmap (filter $ not . all (== '.')) . IO.getDirectoryContents + answer :: [FilePath] -> GetDirectoryA answer = GetDirectoryA . sort @@ -148,5 +163,25 @@ getDir GetDirDirs{..} = fmap answer $ filterM f =<< contents dir     where f x = IO.doesDirectoryExist $ dir </> x -getDir GetDirFiles{..} = fmap answer $ filterM f =<< contents dir-    where f x = if not $ any (?== x) pat then return False else IO.doesFileExist $ dir </> x+getDir GetDirFiles{..} = fmap answer $ concatMapM f $ directories pat+    where+        test = let ps = map (?==) pat in \x -> any ($ x) ps++        f (dir2,False) = do+            xs <- fmap (map (dir2 </>)) $ contents $ dir </> dir2+            flip filterM xs $ \x -> if not $ test x then return False else IO.doesFileExist $ dir </> x++        f (dir2,True) = do+            xs <- fmap (map (dir2 </>)) $ contents $ dir </> dir2+            (files,dirs) <- partitionM (\x -> IO.doesFileExist $ dir </> x) xs+            rest <- concatMapM (\d -> f (d, True)) dirs+            return $ filter test files ++ rest+++concatMapM f xs = fmap concat $ mapM f xs++partitionM f [] = return ([], [])+partitionM f (x:xs) = do+    t <- f x+    (a,b) <- partitionM f xs+    return $ if t then (x:a,b) else (a,x:b)

@@ -67,7 +67,7 @@ --------------------------------------------------------------------- -- RESOURCE --- | The type representing a finite resource, which multiple build actions should respect.+-- | A type representing a finite resource, which multiple build actions should respect. --   Created with 'newResource' in the 'IO' monad before calling 'Development.Shake.shake', --   and used with 'Development.Shake.withResource' in the 'Development.Shake.Action' monad --   when defining rules.

@@ -32,30 +32,32 @@     storedValue _ = return Nothing  --- | Add extra information which your build should depend on. For example:+-- | 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: -- -- @ -- newtype GhcVersion = GhcVersion () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)--- 'addOracle' $ \\(GhcVersion _) -> return \"7.2.1\"+-- 'addOracle' $ \\(GhcVersion _) -> fmap (last . words . fst) $ 'Development.Shake.systemOutput' \"ghc\" [\"--version\"] -- @ -----   If a rule depends on the GHC version, it can use @'askOracle' (GhcVersion ())@, and---   if the GHC version changes, the rule will rebuild. We use a @newtype@ around @()@ to---   allow the use of @GeneralizedNewtypeDeriving@. It is common for the value returned---   by 'askOracle' to be ignored, in which case 'askOracleWith' may help avoid ambiguous type---   messages -- although a wrapper function with an explicit type is encouraged.---   The result of 'addOracle' is simply 'askOracle' restricted to the specific type of the added oracle.---   To import all the type classes required see "Development.Shake.Classes".+--   If a rule calls @'askOracle' (GhcVersion ())@, that rule will be rerun whenever the GHC version changes.+--   Some notes: -----   We require that each call to 'addOracle' uses a different type of @question@ from any---   other calls in a given set of 'Rule's, otherwise a runtime error will be raised.+-- * We define @GhcVersion@ with a @newtype@ around @()@, allowing the use of @GeneralizedNewtypeDeriving@.+--   All the necessary type classes are exported from "Development.Shake.Classes". -----   Actions passed to 'addOracle' will be run in every build they are required,+-- * Each call to 'addOracle' must use a different type of question.+--+-- * Actions passed to 'addOracle' will be run in every build they are required, --   but if their value does not change they will not invalidate any rules depending on them.---   To get a similar behaviour using files, see 'Development.Shake.alwaysRerun'.+--   To get a similar behaviour using data stored in files, see 'Development.Shake.alwaysRerun'. -----   As an example, consider tracking package versions installed with GHC:+-- * If the value returned by 'askOracle' is ignored then 'askOracleWith' may help avoid ambiguous type messages.+--   Alternatively, use the result of 'addOracle', which is 'askOracle' restricted to the correct type. --+--   As a more complex example, consider tracking Haskell package versions:+-- -- @ --newtype GhcPkgList = GhcPkgList () deriving (Show,Typeable,Eq,Hashable,Binary,NFData) --newtype GhcPkgVersion = GhcPkgVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)@@ -85,7 +87,7 @@     return askOracle  --- | Get information previously added with 'addOracle', the @question@/@answer@ types must match those provided+-- | Get information previously added with 'addOracle'. The question/answer types must match those provided --   to 'addOracle'. askOracle :: ( #if __GLASGOW_HASKELL__ >= 704@@ -97,8 +99,8 @@     ) => q -> Action a askOracle question = do OracleA answer <- apply1 $ OracleQ question; return answer --- | Get information previously added with 'addOracle'. The second argument is unused, but can---   be useful to avoid ambiguous type error messages.+-- | Get information previously added with 'addOracle'. The second argument is not used, but can+--   be useful to fix the answer type, avoiding ambiguous type error messages. askOracleWith :: ( #if __GLASGOW_HASKELL__ >= 704     ShakeValue q, ShakeValue a

@@ -79,7 +79,7 @@         --   Can be used to implement @make --touch@.     ,shakeAbbreviations :: [(String,String)]         -- ^ Defaults to @[]@. A list of substrings that should be abbreviated in status messages, and their corresponding abbreviation.-        --   Commonly used to replace the long paths (e.g. @.make/i586-linux-gcc/output@) with an abbreviation (e.g. @$OUT@).+        --   Commonly used to replace the long paths (e.g. @.make\/i586-linux-gcc\/output@) with an abbreviation (e.g. @$OUT@).     ,shakeProgress :: IO Progress -> IO ()         -- ^ Defaults to no action. A function called on a separate thread when the build starts, allowing progress to be reported.         --   For applications that want to display progress messages, 'progressSimple' is often sufficient, but more advanced

@@ -2,39 +2,62 @@ module Examples.Test.Directory(main) where  import Development.Shake+import Development.Shake.FilePath import Examples.Util import System.Directory(createDirectory)+import Data.List  +    -- Use escape characters, _o=* _l=/ __=<space>+readEsc ('_':'o':xs) = '*' : readEsc xs+readEsc ('_':'l':xs) = '/' : readEsc xs+readEsc ('_':'_':xs) = ' ' : readEsc xs+readEsc (x:xs) = x : readEsc xs+readEsc [] = []++showEsc = concatMap f+    where f '*' = "_o"+          f '/' = "_l"+          f ' ' = "__"+          f x = [x]++ main = shaken test $ \args obj -> do-    want $ map obj ["files.lst","dirs.lst","exist.lst","foodirexist.lst"]-    obj "files.lst" *> \out -> do-        x <- getDirectoryFiles (obj "") ["*.txt"]-        writeFileLines out x-    obj "dirs.lst" *> \out -> do-        x <- getDirectoryDirs (obj "")-        writeFileLines out x-    obj "exist.lst" *> \out -> do-        xs <- readFileLines $ obj "files.lst"-        ys <- mapM (doesFileExist . obj) $ xs ++ map reverse xs-        writeFileLines out $ map show ys-    obj "foodirexist.lst" *> \out -> do-        x <- doesDirectoryExist $ obj "Foo.txt"-        writeFileLines out [show x]+    want $ map obj args+    obj "*.contents" *> \out ->+        writeFileLines out =<< getDirectoryContents (obj $ readEsc $ dropExtension $ unobj out)+    obj "*.dirs" *> \out ->+        writeFileLines out =<< getDirectoryDirs (obj $ readEsc $ dropExtension $ unobj out)+    obj "*.files" *> \out -> do+        let pats = readEsc $ dropExtension $ unobj out+        let (x:xs) = ["" | " " `isPrefixOf` pats] ++ words pats+        writeFileLines out =<< getDirectoryFiles (obj x) xs +    obj "*.exist" *> \out -> do+        let xs = map obj $ words $ readEsc $ dropExtension $ unobj out+        fs <- mapM doesFileExist xs+        ds <- mapM doesDirectoryExist xs+        let bool x = if x then "1" else "0"+        writeFileLines out $ zipWith (\a b -> bool a ++ bool b) fs ds++ test build obj = do+    let demand x ys = let f = showEsc x in do build [f]; assertContents (obj f) $ unlines $ words ys     build ["clean"]-    build []-    assertContents (obj "files.lst") $ unlines []-    assertContents (obj "dirs.lst") $ unlines []-    assertContents (obj "exist.lst") $ unlines []-    assertContents (obj "foodirexist.lst") $ unlines ["False"]+    demand " *.txt.files" ""+    demand " //*.txt.files" ""+    demand ".dirs" ""+    demand "A.txt B.txt C.txt.exist" "00 00 00"      writeFile (obj "A.txt") ""     writeFile (obj "B.txt") ""-    createDirectory (obj "Foo.txt")-    build ["--sleep"]-    assertContents (obj "files.lst") $ unlines ["A.txt","B.txt"]-    assertContents (obj "dirs.lst") $ unlines ["Foo.txt"]-    assertContents (obj "exist.lst") $ unlines ["True","True","False","False"]-    assertContents (obj "foodirexist.lst") $ unlines ["True"]+    createDirectory (obj "C.txt")+    writeFile (obj "C.txt/D.txt") ""+    writeFile (obj "C.txt/E.xtx") ""+    demand " *.txt.files" "A.txt B.txt"+    demand ".dirs" "C.txt"+    demand "A.txt B.txt C.txt.exist" "10 10 01"+    demand " //*.txt.files" "A.txt B.txt C.txt/D.txt"+    demand "C.txt *.txt.files" "D.txt"+    demand " *.txt //*.xtx.files" "A.txt B.txt C.txt/E.xtx"+    demand " C.txt/*.files" "C.txt/D.txt C.txt/E.xtx"

@@ -27,7 +27,8 @@         "test":extra -> do             putStrLn $ "## TESTING " ++ name             -- if the extra arguments are not --quiet/--loud it's probably going to go wrong-            test (\args -> withArgs (name:args ++ extra) $ shaken test rules sleeper) (out++)+            let obj x = if "/" `isPrefixOf` x then init out ++ x else out ++ x+            test (\args -> withArgs (name:args ++ extra) $ shaken test rules sleeper) obj             putStrLn $ "## FINISHED TESTING " ++ name         "clean":_ -> removeDirectoryRecursive out {-

@@ -1,7 +1,7 @@ cabal-version:      >= 1.8 build-type:         Simple name:               shake-version:            0.7+version:            0.8 license:            BSD3 license-file:       LICENSE category:           Development@@ -11,13 +11,14 @@ synopsis:           Build system library, like Make, but more accurate dependencies. description:     Shake is a Haskell library for writing build systems - designed as a-    replacement for make. See "Development.Shake" for an introduction,+    replacement for @make@. See "Development.Shake" for an introduction,     including an example. Further examples are included in the Cabal tarball,     under the @Examples@ directory.     .     To use Shake the user writes a Haskell program-    that imports the Shake library, defines some build rules, and calls-    'shake'. Thanks to do notation and infix operators, a simple Shake program+    that imports "Development.Shake", defines some build rules, and calls+    the 'Development.Shake.shake' function. Thanks to do notation and infix+    operators, a simple Shake build system     is not too dissimilar from a simple Makefile. However, as build systems     get more complex, Shake is able to take advantage of the excellent     abstraction facilities offered by Haskell and easily support much larger