packages feed

shake 0.3.4 → 0.3.5

raw patch · 7 files changed

+124/−58 lines, 7 files

Files

Development/Shake/Core.hs view
@@ -45,7 +45,7 @@     ,shakeStaunch :: Bool -- ^ Operate in staunch mode, where building continues even after errors (defaults to 'False').     ,shakeReport :: Maybe FilePath -- ^ Produce an HTML profiling report (defaults to 'Nothing').     ,shakeLint :: Bool -- ^ Perform basic sanity checks after building (defaults to 'False').-    ,shakeDeterministic :: Bool -- ^ Build files in a detereminstic order, as far as possbile+    ,shakeDeterministic :: Bool -- ^ Build files in a deterministic order, as far as possible     }     deriving (Show,Eq,Ord,Typeable,Data) @@ -54,7 +54,7 @@ shakeOptions = ShakeOptions ".shake" 1 1 Normal False Nothing False False  --- | All forseen exception conditions thrown by Shake, such problems with the rules or errors when executing+-- | All foreseen exception conditions thrown by Shake, such problems with the rules or errors when executing --   rules, will be raised using this exception type. data ShakeException = ShakeException         [String] -- Entries on the stack, starting at the top of the stack.@@ -170,18 +170,20 @@ -- | Like 'rule', but lower priority, if no 'rule' exists then 'defaultRule' is checked. --   All default rules must be disjoint. defaultRule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()-defaultRule = ruleWith 0+defaultRule = rulePriority 0   -- | Add a rule to build a key, returning an appropriate 'Action'. All rules must be disjoint. --   To define lower priority rules use 'defaultRule'. rule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()-rule = ruleWith 1+rule = rulePriority 1  --- | Add a rule at a given priority.-ruleWith :: Rule key value => Int -> (key -> Maybe (Action value)) -> Rules ()-ruleWith i r = mempty{rules = Map.singleton k (k, v, [(i,ARule r)])}+-- | Add a rule at a given priority, higher numbers correspond to higher-priority rules.+--   The function 'defaultRule' is priority 0 and 'rule' is priority 1. All rules of the same+--   priority must be disjoint.+rulePriority :: Rule key value => Int -> (key -> Maybe (Action value)) -> Rules ()+rulePriority i r = mempty{rules = Map.singleton k (k, v, [(i,ARule r)])}     where k = typeOf $ ruleKey r; v = typeOf $ ruleValue r  @@ -217,7 +219,7 @@     deriving (Functor, Monad, MonadIO)  --- | This function is not actually exported, but Haddock is buggy. Please ignore.+-- | Internal main function (not exported publicly) run :: ShakeOptions -> Rules () -> IO () run opts@ShakeOptions{..} rs = do     start <- startTime
Development/Shake/FilePattern.hs view
@@ -1,11 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}  module Development.Shake.FilePattern(     FilePattern, (?==),     compatible, extract, substitute     ) where -import Data.List+import System.FilePath(pathSeparators)   -- | A type synonym for file patterns, containing @\/\/@ and @*@. For the syntax@@ -13,11 +12,57 @@ type FilePattern = String  +data Lexeme = Star | SlashSlash | Char Char deriving (Show, Eq)++isChar (Char _) = True; isChar _ = False++data Regex = Lit [Char] | Not [Char] | Any+           | Start | End+           | Bracket Regex+           | Or Regex Regex | Concat Regex Regex+           | Repeat Regex | Empty+             deriving Show++type SString = (Bool, String) -- fst is True if at the start of the string+++lexer :: FilePattern -> [Lexeme]+lexer ('*':xs) = Star : lexer xs+lexer ('/':'/':xs) = SlashSlash : lexer xs+lexer (x:xs) = Char x : lexer xs+lexer [] = []+++pattern :: [Lexeme] -> Regex+pattern = Concat Start . foldr Concat End . map f+    where+        f Star = Bracket $ Repeat $ Not pathSeparators+        f SlashSlash = let s = Start `Or` End `Or` Lit pathSeparators in Bracket $ s `Concat` Repeat Any `Concat` s+        f (Char x) = Lit $ if x == '/' then pathSeparators else [x]+++-- | Return is (brackets, matched, rest)+match :: Regex -> SString -> [([String], String, SString)]+match (Lit l) (_, x:xs) | x `elem` l = [([], [x], (False, xs))]+match (Not l) (_, x:xs) | x `notElem` l = [([], [x], (False, xs))]+match Any (_, x:xs) = [([], [x], (False, xs))]+match Start (True, xs) = [([], [], (True, xs))]+match End (s, []) = [([], [], (s, []))]+match (Bracket r) xs = [(a ++ [b], b, c) | (a,b,c) <- match r xs]+match (Or r1 r2) xs = match r1 xs ++ match r2 xs+match (Concat r1 r2) xs = [(a1++a2,b1++b2,c2) | (a1,b1,c1) <- match r1 xs, (a2,b2,c2) <- match r2 c1]+match (Repeat r) xs = match (Empty `Or` Concat r (Repeat r)) xs+match Empty xs = [([], "", xs)]+match _ _ = []++++ -- | Match a 'FilePattern' against a 'FilePath', There are only two special forms: -- -- * @*@ matches an entire path component, excluding any separators. ----- * @\/\/@ matches an arbitrary number of path componenets.+-- * @\/\/@ matches an arbitrary number of path components. -- --   Some examples that match: --@@ -32,46 +77,29 @@ -- > "*/*.c" ?== "foo/bar/baz.c" -- (?==) :: FilePattern -> FilePath -> Bool-(?==) ('/':'/':p) x = any (p ?==) $ x : [i | '/':i <- tails x]-(?==) ('*':p) x = any (p ?==) $ a ++ take 1 b-    where (a,b) = break ("/" `isPrefixOf`) $ tails x-(?==) (p:ps) (x:xs) | p == x = ps ?== xs-(?==) [] [] = True-(?==) _ _ = False+(?==) p x = not $ null $ match (pattern $ lexer p) (True, x)   -- | Do they have the same * and // counts in the same order compatible :: [FilePattern] -> Bool compatible [] = True compatible (x:xs) = all ((==) (f x) . f) xs-    where-        f ('*':xs) = '*':f xs-        f ('/':'/':xs) = '/':f xs-        f (x:xs) = f xs-        f [] = []+    where f = filter (not . isChar) . lexer   -- | Extract the items that match the wildcards. The pair must match with '?=='. extract :: FilePattern -> FilePath -> [String]-extract p x = head $ f p x ++ [[]]-    where-        f ('/':'/':p) x = rest p $ ("",x) : [(pre++"/",i) | (pre,'/':i) <- zip (inits x) (tails x)]-        f ('*':p) x = rest p $ a ++ take 1 b-            where (a,b) = break (isPrefixOf "/" . snd) $ zip (inits x) (tails x)-        f (p:ps) (x:xs) | p == x = f ps xs-        f [] [] = [[]]-        f _ _ = []--        rest p xs = [skip:res | (skip,keep) <- xs, res <- f p keep]+extract p x = ms+    where (ms,_,_):_ = match (pattern $ lexer p) (True,x)   -- | Given the result of 'extract', substitute it back in to a 'compatible' pattern. -- -- > p '?==' x ==> substitute (extract p x) p == x substitute :: [String] -> FilePattern -> FilePath-substitute = f+substitute ms p = f ms (lexer p)     where-        f (a:as) ('/':'/':ps) = a ++ f as ps-        f (a:as) ('*':ps) = a ++ f as ps-        f as (p:ps) = p : f as ps-        f as [] = []+        f ms (Char p:ps) = p : f ms ps+        f (m:ms) (_:ps) = m ++ f ms ps+        f [] [] = []+        f _ _ = error $ "Substitution failed into pattern " ++ show p ++ " with " ++ show (length ms) ++ " matches, namely " ++ show ms
Examples/Test/Basic.hs view
@@ -25,14 +25,6 @@   test build obj = do-    let f b pat file = assert (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b-    f True "//*.c" "foo/bar/baz.c"-    f True "*.c" "baz.c"-    f True "//*.c" "baz.c"-    f True "test.c" "test.c"-    f False "*.c" "foor/bar.c"-    f False "*/*.c" "foo/bar/baz.c"-     writeFile (obj "A.txt") "AAA"     writeFile (obj "B.txt") "BBB"     build ["AB.txt"]
+ Examples/Test/FilePattern.hs view
@@ -0,0 +1,51 @@++module Examples.Test.FilePattern(main) where++import Development.Shake.FilePattern+import Examples.Util++main = shaken test $ \args obj -> return ()+++test build obj = do+    let f b pat file = assert (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b+    f True "//*.c" "foo/bar/baz.c"+    f True "*.c" "baz.c"+    f True "//*.c" "baz.c"+    f True "test.c" "test.c"+    f False "*.c" "foor/bar.c"+    f False "*/*.c" "foo/bar/baz.c"+    f False "foo//bar" "foobar"+    f False "foo//bar" "foobar/bar"+    f False "foo//bar" "foo/foobar"++    assert (compatible []) "compatible"+    assert (compatible ["//*a.txt","foo//a*.txt"]) "compatible"+    assert (not $ compatible ["//*a.txt","foo//a*.*txt"]) "compatible"+    extract "//*a.txt" "foo/bar/testa.txt" === ["foo/bar/","test"]+    extract "//*a.txt" "testa.txt" === ["","test"]+    extract "//*a*.txt" "testada.txt" === ["","test","da"]+    substitute ["","test","da"] "//*a*.txt" === "testada.txt"+    substitute  ["foo/bar/","test"] "//*a.txt" === "foo/bar/testa.txt"+++---------------------------------------------------------------------+-- LAZY SMALLCHECK PROPERTIES++{-+newtype Pattern = Pattern FilePattern deriving (Show,Eq)+newtype Path    = Path    FilePath    deriving (Show,Eq)++-- Since / and * are the only "interesting" elements, just add ab to round out the set++instance Serial Pattern where+    series = cons Pattern >< f+        where f = cons [] \/ cons (:) >< const (drawnFrom "/*ab") >< f++instance Serial Path where+    series = cons Path >< f+        where f = cons [] \/ cons (:) >< const (drawnFrom "/ab") >< f++testSmallCheck = do+    smallCheck 10 $ \(Pattern p) (Path x) -> p ?== x ==> substitute (extract p x) p == x+-}
Examples/Test/Files.hs view
@@ -2,7 +2,6 @@ module Examples.Test.Files(main) where  import Development.Shake-import Development.Shake.FilePattern import Examples.Util import Control.Monad import Data.List@@ -23,15 +22,6 @@   test build obj = do-    assert (compatible []) "compatible"-    assert (compatible ["//*a.txt","foo//a*.txt"]) "compatible"-    assert (not $ compatible ["//*a.txt","foo//a*.*txt"]) "compatible"-    extract "//*a.txt" "foo/bar/testa.txt" === ["foo/bar/","test"]-    extract "//*a.txt" "testa.txt" === ["","test"]-    extract "//*a*.txt" "testada.txt" === ["","test","da"]-    substitute ["","test","da"] "//*a*.txt" === "testada.txt"-    substitute  ["foo/bar/","test"] "//*a.txt" === "foo/bar/testa.txt"-     forM_ [[],["fun"]] $ \args -> do         sleepFileTime         let nums = unlines . map show
Main.hs view
@@ -12,6 +12,7 @@ import qualified Examples.Test.Errors as Errors import qualified Examples.Test.Files as Files import qualified Examples.Test.FilePath as FilePath+import qualified Examples.Test.FilePattern as FilePattern import qualified Examples.Test.Journal as Journal import qualified Examples.Test.Pool as Pool import qualified Examples.Test.Random as Random@@ -23,8 +24,9 @@  mains = ["tar" * Tar.main, "self" * Self.main, "c" * C.main         ,"basic" * Basic.main, "directory" * Directory.main, "errors" * Errors.main-        ,"filepath" * FilePath.main, "files" * Files.main, "journal" * Journal.main-        ,"pool" * Pool.main, "random" * Random.main,"resources" * Resources.main]+        ,"filepath" * FilePath.main, "filepattern" * FilePattern.main, "files" * Files.main+        ,"journal" * Journal.main, "pool" * Pool.main, "random" * Random.main+        ,"resources" * Resources.main]     where (*) = (,)
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.8 build-type:         Simple name:               shake-version:            0.3.4+version:            0.3.5 license:            BSD3 license-file:       LICENSE category:           Development@@ -137,6 +137,7 @@         Examples.Test.Directory         Examples.Test.Errors         Examples.Test.FilePath+        Examples.Test.FilePattern         Examples.Test.Files         Examples.Test.Journal         Examples.Test.Pool