packages feed

shake 0.4 → 0.5

raw patch · 15 files changed

+268/−131 lines, 15 filesdep ~basedep ~filepath

Dependency ranges changed: base, filepath

Files

Development/Shake.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-}  -- | This module is used for defining Shake build systems. As a simple example of a Shake build system, --   let us build the file @result.tar@ from the files listed by @result.txt@:@@ -66,6 +67,9 @@     shake,     -- * Core of Shake     ShakeOptions(..), shakeOptions, Assume(..), Progress(..),+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue,+#endif     Rule(..), Rules, defaultRule, rule, action, withoutActions,     Action, apply, apply1, traced,     Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet,@@ -79,7 +83,7 @@     -- * Directory rules     doesFileExist, getDirectoryContents, getDirectoryFiles, getDirectoryDirs,     -- * Additional rules-    addOracle, addOracles, askOracle,+    addOracle, askOracle, askOracleWith,     alwaysRerun,     -- * Finite resources     Resource, newResource, withResource@@ -92,6 +96,9 @@ import Development.Shake.Types import Development.Shake.Core import Development.Shake.Derived+#if __GLASGOW_HASKELL__ >= 704+import Development.Shake.Classes+#endif  import Development.Shake.Directory import Development.Shake.File
+ Development/Shake/Classes.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#endif++-- | This module reexports the six necessary type classes that every 'Rule' type must support.+--   You can use this module to define new rules without depending on the @binary@, @deepseq@ and @hashable@ packages.+module Development.Shake.Classes(+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue,+#endif+    Show,Typeable,Eq,Hashable,Binary,NFData+    ) where++import Data.Hashable+import Data.Typeable+import Data.Binary+import Control.DeepSeq+++#if __GLASGOW_HASKELL__ >= 704+-- | Define an alias for the six type classes required for things involved in Shake 'Development.Shake.Rule's.+--   This alias is only available in GHC 7.4 and above, and requires the @ConstraintKinds@ extension.+--+--   To define your own values meeting the necessary constraints it is convenient to use the extensions+--   @GeneralizedNewtypeDeriving@ and @DeriveDataTypeable@ to write:+--+-- > newtype MyType = MyType (String, Bool) deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)+#endif
Development/Shake/Core.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#endif+ module Development.Shake.Core(     run,     Rule(..), Rules, defaultRule, rule, action, withoutActions,@@ -14,9 +19,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.State-import Data.Binary(Binary)-import Data.Data-import Data.Hashable+import Data.Typeable import Data.Function import Data.List import qualified Data.HashMap.Strict as Map@@ -24,6 +27,7 @@ import Data.Monoid import Data.IORef +import Development.Shake.Classes import Development.Shake.Pool import Development.Shake.Database import Development.Shake.Locks@@ -36,16 +40,21 @@ -- RULES  -- | Define a pair of types that can be used by Shake rules.+--   To import all the type classes required see "Development.Shake.Classes". class (+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue key, ShakeValue value+#else     Show key, Typeable key, Eq key, Hashable key, Binary key, NFData key,     Show value, Typeable value, Eq value, Hashable value, Binary value, NFData value+#endif     ) => Rule key value | key -> value where      -- | Retrieve the @value@ associated with a @key@, if available.     --     --   As an example for filenames/timestamps, if the file exists you should return 'Just'     --   the timestamp, but otherwise return 'Nothing'. For rules whose values are not-    --   stored externally, 'storedValue' should always return 'Nothing'.+    --   stored externally, 'storedValue' should return 'Nothing'.     storedValue :: key -> IO (Maybe value)  {-@@ -237,8 +246,9 @@     let (tk,tv) = (typeKey k, typeValue v) in     case Map.lookup tk mp of         Nothing -> error $-            "Error: couldn't find instance Rule " ++ show tk ++ " " ++ show tv ++-            ", perhaps you are missing a call to defaultRule/rule?"+            "Error: couldn't find instance Rule " ++ showTypeRepBracket tk ++ " " ++ showTypeRepBracket tv +++            ", perhaps you are missing a call to " +++            (if isOracleTypes tk tv then "addOracle" else "defaultRule/rule") ++ "?"         Just (tv2,_) | tv2 /= tv -> error $             "Error: couldn't find instance Rule " ++ show tk ++ " " ++ show tv ++             ", but did find an instance Rule " ++ show tk ++ " " ++ show tv2 ++@@ -253,6 +263,17 @@         ruleStored _ = if assume == Just AssumeDirty                        then \k v -> return False                        else \k v -> fmap (== Just v) $ storedValue k+++isOracleTypes :: TypeRep -> TypeRep -> Bool+isOracleTypes tk tv = f tk "OracleQ" && f tv "OracleA"+    where f t s = show (fst $ splitTyConApp t) == s++showTypeRepBracket :: TypeRep -> String+showTypeRepBracket ty = ['(' | not safe] ++ show ty ++ [')' | not safe]+    where (t1,args) = splitTyConApp ty+          st1 = show t1+          safe = null args || st1 == "[]" || "(" `isPrefixOf` st1   createExecute :: Maybe Assume -> Rules () -> (Key -> Action Value)
Development/Shake/Database.hs view
@@ -408,7 +408,7 @@      where         -- special case for these things, since the purpose is to break the invariant-        special k = s == "AlwaysRun" || "Oracle " `isPrefixOf` s+        special k = s == "AlwaysRun" || "OracleQ " `isPrefixOf` s             where s = show k
Development/Shake/Directory.hs view
@@ -20,38 +20,44 @@ import Development.Shake.FilePattern  -newtype Exist = Exist FilePath+newtype DoesFileExistQ = DoesFileExistQ FilePath     deriving (Typeable,Eq,Hashable,Binary,NFData) -instance Show Exist where-    show (Exist a) = "Exists? " ++ a+instance Show DoesFileExistQ where+    show (DoesFileExistQ a) = "Exists? " ++ a +newtype DoesFileExistA = DoesFileExistA Bool+    deriving (Typeable,Eq,Hashable,Binary,NFData) -data GetDir+instance Show DoesFileExistA where+    show (DoesFileExistA a) = show a+++data GetDirectoryQ     = GetDir {dir :: FilePath}     | GetDirFiles {dir :: FilePath, pat :: FilePattern}     | GetDirDirs {dir :: FilePath}     deriving (Typeable,Eq)-newtype GetDir_ = GetDir_ [FilePath]+newtype GetDirectoryA = GetDirectoryA [FilePath]     deriving (Typeable,Show,Eq,Hashable,Binary,NFData) -instance Show GetDir where+instance Show GetDirectoryQ where     show (GetDir x) = "Listing " ++ x     show (GetDirFiles a b) = "Files " ++ a </> b     show (GetDirDirs x) = "Dirs " ++ x -instance NFData GetDir where+instance NFData GetDirectoryQ where     rnf (GetDir a) = rnf a     rnf (GetDirFiles a b) = rnf a `seq` rnf b     rnf (GetDirDirs a) = rnf a -instance Hashable GetDir where+instance Hashable GetDirectoryQ where     hashWithSalt salt = hashWithSalt salt . f         where f (GetDir x) = (0 :: Int, x, "")               f (GetDirFiles x y) = (1, x, y)               f (GetDirDirs x) = (2, x, "") -instance Binary GetDir where+instance Binary GetDirectoryQ where     get = do         i <- getWord8         case i of@@ -64,11 +70,11 @@     put (GetDirDirs x) = putWord8 2 >> put x  -instance Rule Exist Bool where-    storedValue (Exist x) = fmap Just $ IO.doesFileExist x+instance Rule DoesFileExistQ DoesFileExistA where+    storedValue (DoesFileExistQ x) = fmap (Just . DoesFileExistA) $ IO.doesFileExist x     -- invariant _ = True -instance Rule GetDir GetDir_ where+instance Rule GetDirectoryQ GetDirectoryA where     storedValue x = fmap Just $ getDir x     -- invariant _ = True @@ -76,15 +82,17 @@ -- | This function is not actually exported, but Haddock is buggy. Please ignore. defaultRuleDirectory :: Rules () defaultRuleDirectory = do-    defaultRule $ \(Exist x) -> Just $-        liftIO $ IO.doesFileExist x-    defaultRule $ \(x :: GetDir) -> Just $+    defaultRule $ \(DoesFileExistQ x) -> Just $+        liftIO $ fmap DoesFileExistA $ IO.doesFileExist x+    defaultRule $ \(x :: GetDirectoryQ) -> Just $         liftIO $ getDir x   -- | Returns 'True' if the file exists. doesFileExist :: FilePath -> Action Bool-doesFileExist = apply1 . Exist+doesFileExist file = do+    DoesFileExistA res <- apply1 $ DoesFileExistQ file+    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@@ -102,11 +110,11 @@ getDirectoryDirs :: FilePath -> Action [FilePath] getDirectoryDirs x = getDirAction $ GetDirDirs x -getDirAction x = do GetDir_ y <- apply1 x; return y+getDirAction x = do GetDirectoryA y <- apply1 x; return y  -getDir :: GetDir -> IO GetDir_-getDir x = fmap (GetDir_ . sort) $ f x . filter validName =<< IO.getDirectoryContents (dir x)+getDir :: GetDirectoryQ -> IO GetDirectoryA+getDir x = fmap (GetDirectoryA . sort) $ f x . filter validName =<< IO.getDirectoryContents (dir x)     where         validName = not . all (== '.')
Development/Shake/File.hs view
@@ -22,17 +22,19 @@ infix 1 *>, ?>, **>  -newtype File = File BS.ByteString+newtype FileQ = FileQ BS.ByteString     deriving (Typeable,Eq,Hashable,Binary) -instance NFData File where-    rnf (File x) = x `seq` () -- since ByteString is strict+instance NFData FileQ where+    rnf (FileQ x) = x `seq` () -- since ByteString is strict -instance Show File where show (File x) = BS.unpack x+instance Show FileQ where show (FileQ x) = BS.unpack x +newtype FileA = FileA FileTime+    deriving (Typeable,Eq,Hashable,Binary,Show,NFData) -instance Rule File FileTime where-    storedValue (File x) = getModTimeMaybe x+instance Rule FileQ FileA where+    storedValue (FileQ x) = fmap (fmap FileA) $ getModTimeMaybe x  {-     observed act = do@@ -91,8 +93,8 @@  -- | This function is not actually exported, but Haddock is buggy. Please ignore. defaultRuleFile :: Rules ()-defaultRuleFile = defaultRule $ \(File x) -> Just $-    liftIO $ getModTimeError "Error, file does not exist and no rule available:" x+defaultRuleFile = defaultRule $ \(FileQ x) -> Just $+    liftIO $ fmap FileA $ getModTimeError "Error, file does not exist and no rule available:" x   -- | Require that the following files are built before continuing. Particularly@@ -105,7 +107,7 @@ --     'Development.Shake.system'' [\"rot13\",src,\"-o\",out] -- @ need :: [FilePath] -> Action ()-need xs = (apply $ map (File . BS.pack) xs :: Action [FileTime]) >> return ()+need xs = (apply $ map (FileQ . BS.pack) xs :: Action [FileA]) >> return ()  -- | Require that the following are built by the rules, used to specify the target. --@@ -121,11 +123,11 @@   root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()-root help test act = rule $ \(File x_) -> let x = BS.unpack x_ in+root help test act = rule $ \(FileQ x_) -> let x = BS.unpack x_ in     if not $ test x then Nothing else Just $ do         liftIO $ createDirectoryIfMissing True $ takeDirectory x         act x-        liftIO $ getModTimeError ("Error, rule " ++ help ++ " failed to build file:") x_+        liftIO $ fmap FileA $ getModTimeError ("Error, rule " ++ help ++ " failed to build file:") x_
Development/Shake/FilePattern.hs view
@@ -67,16 +67,25 @@ -- --   Some examples that match: ----- > "//*.c" ?== "foo/bar/baz.c"--- > "*.c" ?== "baz.c"--- > "//*.c" ?== "baz.c"--- > "test.c" ?== "test.c"+-- @+-- \"//*.c\" '?==' \"foo\/bar\/baz.c\"+-- \"*.c\" '?==' \"baz.c\"+-- \"//*.c\" '?==' \"baz.c\"+-- \"test.c\" '?==' \"test.c\"+-- @ -- --   Examples that /don't/ match: ----- > "*.c" ?== "foo/bar.c"--- > "*/*.c" ?== "foo/bar/baz.c"+-- @+-- \"*.c\" '?==' \"foo\/bar.c\"+-- \"*\/*.c\" '?==' \"foo\/bar\/baz.c\"+-- @ --+--   An example that only matches on Windows:+--+-- @+-- \"foo/bar\" '?==' \"foo\\\\bar\"+-- @ (?==) :: FilePattern -> FilePath -> Bool (?==) p x = not $ null $ match (pattern $ lexer p) (True, x)
Development/Shake/Files.hs view
@@ -21,22 +21,22 @@ infix 1 ?>>, *>>  -newtype Files = Files [BS.ByteString]+newtype FilesQ = FilesQ [BS.ByteString]     deriving (Typeable,Eq,Hashable,Binary) -instance NFData Files where+instance NFData FilesQ where     -- some versions of ByteString do not have NFData instances, but seq is equivalent     -- for a strict bytestring. Therefore, we write our own instance.-    rnf (Files xs) = rnf $ map (`seq` ()) xs+    rnf (FilesQ xs) = rnf $ map (`seq` ()) xs -newtype FileTimes = FileTimes [FileTime]+newtype FilesA = FilesA [FileTime]     deriving (Typeable,Show,Eq,Hashable,Binary,NFData) -instance Show Files where show (Files xs) = unwords $ map BS.unpack xs+instance Show FilesQ where show (FilesQ xs) = unwords $ map BS.unpack xs  -instance Rule Files FileTimes where-    storedValue (Files xs) = fmap (fmap FileTimes . sequence) $ mapM getModTimeMaybe xs+instance Rule FilesQ FilesA where+    storedValue (FilesQ xs) = fmap (fmap FilesA . sequence) $ mapM getModTimeMaybe xs   -- | Define a rule for building multiple files at the same time.@@ -60,9 +60,9 @@     | otherwise = do         forM_ ps $ \p ->             p *> \file -> do-                _ :: FileTimes <- apply1 $ Files $ map (BS.pack . substitute (extract p file)) ps+                _ :: FilesA <- apply1 $ FilesQ $ map (BS.pack . substitute (extract p file)) ps                 return ()-        rule $ \(Files xs_) -> let xs = map BS.unpack xs_ in+        rule $ \(FilesQ xs_) -> let xs = map BS.unpack xs_ in             if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do                 act xs                 liftIO $ getFileTimes "*>>" xs_@@ -75,13 +75,17 @@ --   return the list of files that will be produced. This list /must/ include the file passed as an argument and should --   obey the invariant: ----- > test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys+-- @+--test x == Just ys ==> x \`elem\` ys && all ((== Just ys) . test) ys+-- @ -- --   As an example of a function satisfying the invariaint: ----- > test x | takeExtension x `elem` [".hi",".o"]--- >        = Just [dropExtension x <.> "hi", dropExtension x <.> "o"]--- > test _ = Nothing+-- @+--test x | 'Development.Shake.FilePath.takeExtension' x \`elem\` [\".hi\",\".o\"]+--        = Just ['Development.Shake.FilePath.dropExtension' x 'Development.Shake.FilePath.<.>' \"hi\", 'Development.Shake.FilePath.dropExtension' x 'Development.Shake.FilePath.<.>' \"o\"]+--test _ = Nothing+-- @ -- --   Regardless of whether @Foo.hi@ or @Foo.o@ is passed, the function always returns @[Foo.hi, Foo.o]@. (?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()@@ -92,10 +96,10 @@                     | otherwise -> error $ "Invariant broken in ?>> when trying on " ++ x      isJust . checkedTest ?> \x -> do-        _ :: FileTimes <- apply1 $ Files $ map BS.pack $ fromJust $ test x+        _ :: FilesA <- apply1 $ FilesQ $ map BS.pack $ fromJust $ test x         return () -    rule $ \(Files xs_) -> let xs@(x:_) = map BS.unpack xs_ in+    rule $ \(FilesQ xs_) -> let xs@(x:_) = map BS.unpack xs_ in         case checkedTest x of             Just ys | ys == xs -> Just $ do                 act xs@@ -104,11 +108,11 @@             Nothing -> Nothing  -getFileTimes :: String -> [BS.ByteString] -> IO FileTimes+getFileTimes :: String -> [BS.ByteString] -> IO FilesA getFileTimes name xs = do     ys <- mapM getModTimeMaybe xs     case sequence ys of-        Just ys -> return $ FileTimes ys+        Just ys -> return $ FilesA ys         Nothing -> do             let missing = length $ filter isNothing ys             error $ "Error, " ++ name ++ " rule failed to build " ++ show missing ++
Development/Shake/Locks.hs view
@@ -82,7 +82,7 @@ --        \"*.xls\" 'Development.Shake.*>' \\out -> --            'Development.Shake.withResource' excel 1 $ --                'Development.Shake.system'' \"excel\" [out,...]---  @+-- @ -- --   Now the two calls to @excel@ will not happen in parallel. Using 'Resource' --   is better than 'MVar' as it will not block any other threads from executing. Be careful that the
Development/Shake/Oracle.hs view
@@ -1,61 +1,109 @@ {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}+-- Allows the user to violate the functional dependency, but it has a runtime check so still safe+{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#endif+ module Development.Shake.Oracle(-    addOracle, addOracles, askOracle+    addOracle, askOracle, askOracleWith     ) where -import Control.DeepSeq-import Data.Binary-import Data.Hashable-import Data.List-import Data.Typeable- import Development.Shake.Core+import Development.Shake.Classes  -newtype Question = Question [String]-    deriving (Typeable,Eq,Hashable,Binary,NFData)-newtype Answer = Answer [String]+-- Use should type names, since the names appear in the Haddock, and are too long if they are in full+newtype OracleQ question = OracleQ question     deriving (Show,Typeable,Eq,Hashable,Binary,NFData)--instance Show Question where-    show (Question xs) = "Oracle " ++ unwords xs+newtype OracleA answer = OracleA answer+    deriving (Show,Typeable,Eq,Hashable,Binary,NFData) -instance Rule Question Answer where+instance (+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue q, ShakeValue a+#else+    Show q, Typeable q, Eq q, Hashable q, Binary q, NFData q,+    Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a+#endif+    ) => Rule (OracleQ q) (OracleA a) where     storedValue _ = return Nothing   -- | Add extra information which your build should depend on. For example: ----- > addOracle ["ghc"] $ return ["7.2.1"]--- > addOracle ["ghc-pkg","shake"] $ return ["1.0"]+-- @+-- newtype GhcVersion = GhcVersion () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+-- 'addOracle' $ \GhcVersion -> return \"7.2.1\"+-- @ -----   If a rule depends on the GHC version, it can then use @'askOracle' [\"ghc\"]@, and---   if the GHC version changes, the rule will rebuild. It is common for the value returned---   by 'askOracle' to be ignored.+--   If a rule depends on the GHC version, it can then 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.+--   To import all the type classes required see "Development.Shake.Classes". -----   The Oracle maps questions of @[String]@ to answers of @[String]@. This type is a---   compromise. Questions will often be the singleton list, but allowing a list of strings---   allows hierarchical schemes such as @ghc-pkg shake@, @ghc-pkg base@ etc.---   The answers are often singleton lists, but sometimes are used as sets - for example---   the list of packages returned by @ghc-pkg@.+--   We require that each type of @question@ map to exactly one type of @answer@,+--   otherwise a runtime error will be raised. -----   Actions passed to 'addOracle' will be run in every Shake execution they are required,---   their value will not be kept between runs. To get a similar behaviour using files, see---   'Development.Shake.alwaysRerun'.-addOracle :: [String] -> Action [String] -> Rules ()-addOracle question act = rule $ \(Question q) ->-    if q == question then Just $ fmap Answer act else Nothing----- | Add a function to generate an oracle, matching a prefix.+--   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'. ----- > addOracles ["reverse"] $ \xs -> return $ reverse xs-addOracles :: [String] -> ([String] -> Action [String]) -> Rules ()-addOracles pre act = rule $ \(Question q) ->-    fmap (fmap Answer . act) $ stripPrefix pre q+--   As an example, consider tracking package versions installed with GHC:+--+-- @+--newtype GhcPkgList = GhcPkgList () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+--newtype GhcPkgVersion = GhcPkgVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+--+--do+--    'addOracle' $ \\GhcPkgList{} -> do+--        (out,_) <- 'systemOutput' \"ghc-pkg\" [\"list\",\"--simple-output\"]+--        return [(reverse b, reverse a) | x <- words out, let (a,_:b) = break (== \'-\') $ reverse x]+--    let getPkgList = 'askOracleWith' (GhcPkgList ()) [(\"\",\"\")] +--    --+--    'addOracle' $ \\(GhcPkgVersion pkg) -> do+--        pkgs <- getPkgList+--        return $ lookup pkg pkgs+--    let getPkgVersion pkg = 'askOracleWith' (GhcPkgVersion pkg) (Just \"\")+-- @+--+--   Using these definitions, any rule depending on the version of @shake@+--   should call @getPkgVersion "shake"@ to rebuild when @shake@ is upgraded.+addOracle :: (+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue q, ShakeValue a+#else+    Show q, Typeable q, Eq q, Hashable q, Binary q, NFData q,+    Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a+#endif+    ) => (q -> Action a) -> Rules ()+addOracle act = rule $ \(OracleQ q) -> Just $ fmap OracleA $ act q  --- | Get information previously added with 'addOracle'.-askOracle :: [String] -> Action [String]-askOracle question = do Answer answer <- apply1 $ Question question; return answer+-- | Get information previously added with 'addOracle', the @question@/@answer@ types must match those provided+--   to 'addOracle'.+askOracle :: (+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue q, ShakeValue a+#else+    Show q, Typeable q, Eq q, Hashable q, Binary q, NFData q,+    Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a+#endif+    ) => 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.+askOracleWith :: (+#if __GLASGOW_HASKELL__ >= 704+    ShakeValue q, ShakeValue a+#else+    Show q, Typeable q, Eq q, Hashable q, Binary q, NFData q,+    Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a+#endif+    ) => q -> a -> Action a+askOracleWith question _ = askOracle question
Development/Shake/Rerun.hs view
@@ -12,16 +12,16 @@ import Development.Shake.Core  -newtype AlwaysRerun = AlwaysRerun ()+newtype AlwaysRerunQ = AlwaysRerunQ ()     deriving (Typeable,Eq,Hashable,Binary,NFData)-instance Show AlwaysRerun where show _ = "AlwaysRerun"+instance Show AlwaysRerunQ where show _ = "AlwaysRerunQ" -newtype Dirty = Dirty ()+newtype AlwaysRerunA = AlwaysRerunA ()     deriving (Typeable,Hashable,Binary,NFData)-instance Show Dirty where show _ = "Dirty"-instance Eq Dirty where a == b = False+instance Show AlwaysRerunA where show _ = "AlwaysRerunA"+instance Eq AlwaysRerunA where a == b = False -instance Rule AlwaysRerun Dirty where+instance Rule AlwaysRerunQ AlwaysRerunA where     storedValue _ = return Nothing  @@ -35,7 +35,7 @@ --     'Development.Shake.writeFileChanged' out stdout -- @ alwaysRerun :: Action ()-alwaysRerun = do Dirty _ <- apply1 $ AlwaysRerun (); return ()+alwaysRerun = do AlwaysRerunA _ <- apply1 $ AlwaysRerunQ (); return ()  defaultRuleRerun :: Rules ()-defaultRuleRerun = defaultRule $ \AlwaysRerun{} -> Just $ return $ Dirty ()+defaultRuleRerun = defaultRule $ \AlwaysRerunQ{} -> Just $ return $ AlwaysRerunA()
Development/Shake/Storage.hs view
@@ -35,7 +35,7 @@  -- Increment every time the on-disk format/semantics change, -- @i@ is for the users version number-databaseVersion i = "SHAKE-DATABASE-5-" ++ show (i :: Int) ++ "\r\n"+databaseVersion i = "SHAKE-DATABASE-6-" ++ show (i :: Int) ++ "\r\n"   withStorage
Development/Shake/Types.hs view
@@ -17,18 +17,20 @@ --   The following example displays the approximate single-threaded time remaining --   as the console title. ----- > showProgress :: IO Progress -> IO ()--- > showProgress progress = void $ forkIO loop--- >     where loop = do--- >             current <- progress--- >             when (isRunning current) $ do--- >                 let (s,c) = timeTodo current--- >                 setTitle $ "Todo = " ++ show (ceiling s) ++ "s (+ " ++ show c ++ " unknown)"--- >                 threadDelay $ 5 * 1000000--- >                 loop--- >--- > setTitle :: String -> IO ()--- > setTitle s = putStr $ "\ESC]0;" ++ s ++ "\BEL"+-- @+--showProgress :: IO 'Progress' -> IO ()+--showProgress progress = void $ forkIO loop+--    where loop = do+--        current <- progress+--        when ('isRunning' current) $ do+--            let (s,c) = timeTodo current+--            setTitle $ \"Todo = \" ++ show (ceiling s) ++ \"s (+ \" ++ show c ++ \" unknown)\"+--            threadDelay $ 5 * 1000000+--            loop+--+--setTitle :: String -> IO ()+--setTitle s = putStr $ \"\\ESC]0;\" ++ s ++ \"\\BEL\"+-- @ data Progress = Progress     {isRunning :: !Bool -- ^ Starts out 'True', becomes 'False' once the build has completed.     ,countSkipped :: {-# UNPACK #-} !Int -- ^ Number of rules which were required, but were already in a valid state.@@ -47,18 +49,18 @@ --   allow the end user to specify that any rules run are either to be treated as clean, or as --   dirty, regardless of what the build system thinks. -----   These assumptions only operate on files reached by the current 'action' commands. Any+--   These assumptions only operate on files reached by the current 'Development.Shake.action' commands. Any --   other files in the database are left unchanged. data Assume     = AssumeDirty-        -- ^ Assume that all rules reached are dirty and require rebuilding, equivalent to 'storedValue' always+        -- ^ Assume that all rules reached are dirty and require rebuilding, equivalent to 'Development.Shake.storedValue' always         --   returning 'Nothing'. Useful to undo the results of 'AssumeClean', for benchmarking rebuild speed and         --   for rebuilding if untracked dependencies have changed. This assumption is safe, but may cause         --   more rebuilding than necessary.     | AssumeClean         -- ^ /This assumption is unsafe, and may lead to incorrect build results/.         --   Assume that all rules reached are clean and do not require rebuilding, provided the rule-        --   has a 'storedValue' and has been built before. Useful if you have modified a file in some+        --   has a 'Development.Shake.storedValue' and has been built before. Useful if you have modified a file in some         --   inconsequential way, such as only the comments or whitespace, and wish to avoid a rebuild.     deriving (Eq,Ord,Show,Data,Typeable,Bounded,Enum)
Examples/Self/Main.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}  module Examples.Self.Main(main) where  import Development.Shake+import Development.Shake.Classes import Development.Shake.FilePath import Examples.Util @@ -11,6 +13,9 @@ import System.Info  +newtype GhcPkg = GhcPkg () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+newtype GhcFlags = GhcFlags () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+ main :: IO () main = shaken noTest $ \args obj -> do     let moduleToFile ext xs = map (\x -> if x == '.' then '/' else x) xs <.> ext@@ -21,8 +26,8 @@      let ghc args = do             -- since ghc-pkg includes the ghc package, it changes if the version does-            askOracle ["ghc-pkg"]-            flags <- askOracle ["ghc-flags"]+            askOracleWith (GhcPkg ()) [""]+            flags <- askOracle $ GhcFlags ()             system' "ghc" $ args ++ flags      obj "/*.exe" *> \out -> do@@ -57,11 +62,11 @@         src <- readFile' "shake.cabal"         writeFileLines out $ sort $ cabalBuildDepends src -    addOracle ["ghc-pkg"] $ do+    addOracle $ \GhcPkg{} -> do         (out,_) <- systemOutput "ghc-pkg" ["list","--simple-output"]         return $ words out -    addOracle ["ghc-flags"] $ do+    addOracle $ \GhcFlags{} -> do         pkgs <- readFileLines $ obj ".pkgs"         return $ map ("-package=" ++) pkgs
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.8 build-type:         Simple name:               shake-version:            0.4+version:            0.5 license:            BSD3 license-file:       LICENSE category:           Development@@ -91,6 +91,7 @@      exposed-modules:         Development.Shake+        Development.Shake.Classes         Development.Shake.FilePath      other-modules: