module Development.Shake.Rules.File(
need, needBS, needed, neededBS, want,
trackRead, trackWrite, trackAllow,
defaultRuleFile,
(%>), (|%>), (?>), phony, (~>), phonys,
FileQ(..), FileA
) where
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.IO.Class
import System.Directory
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashSet as Set
import Development.Shake.Core hiding (trackAllow)
import qualified Development.Shake.Core as S
import General.String
import Development.Shake.ByteString
import Development.Shake.Classes
import Development.Shake.FilePath(toStandard)
import Development.Shake.FilePattern
import Development.Shake.FileInfo
import Development.Shake.Types
import Development.Shake.Errors
import Data.Bits
import Data.List
import Data.Maybe
import System.FilePath(takeDirectory)
import System.IO.Unsafe(unsafeInterleaveIO)
infix 1 %>, ?>, |%>, ~>
newtype FileQ = FileQ {fromFileQ :: BSU}
deriving (Typeable,Eq,Hashable,Binary,NFData)
instance Show FileQ where show (FileQ x) = unpackU x
data FileA = FileA !ModTime !FileSize FileHash
deriving (Typeable,Eq)
instance Hashable FileA where
hashWithSalt salt (FileA a b c) = hashWithSalt salt a `xor` hashWithSalt salt b `xor` hashWithSalt salt c
instance NFData FileA where
rnf (FileA a b c) = rnf a `seq` rnf b `seq` rnf c
instance Binary FileA where
put (FileA a b c) = put a >> put b >> put c
get = liftA3 FileA get get get
instance Show FileA where
show (FileA m s h) = "File {mod=" ++ show m ++ ",size=" ++ show s ++ ",digest=" ++ show h ++ "}"
instance Rule FileQ FileA where
storedValue ShakeOptions{shakeChange=c} (FileQ x) = do
res <- getFileInfo x
case res of
Nothing -> return Nothing
Just (time,size) | c == ChangeModtime -> return $ Just $ FileA time size fileInfoNeq
Just (time,size) -> do
hash <- unsafeInterleaveIO $ getFileHash x
return $ Just $ FileA (if c == ChangeDigest then fileInfoNeq else time) size hash
equalValue ShakeOptions{shakeChange=c} q (FileA x1 x2 x3) (FileA y1 y2 y3) = case c of
ChangeModtime -> bool $ x1 == y1
ChangeDigest -> bool $ x2 == y2 && x3 == y3
ChangeModtimeOrDigest -> bool $ x1 == y1 && x2 == y2 && x3 == y3
_ -> if x1 == y1 then EqualCheap
else if x2 == y2 && x3 == y3 then EqualExpensive
else NotEqual
where bool b = if b then EqualCheap else NotEqual
storedValueError :: ShakeOptions -> Bool -> String -> FileQ -> IO FileA
storedValueError opts input msg x = fromMaybe def <$> storedValue opts2 x
where def = if shakeCreationCheck opts || input then error err else FileA fileInfoNeq fileInfoNeq fileInfoNeq
err = msg ++ "\n " ++ unpackU (fromFileQ x)
opts2 = if not input && shakeChange opts == ChangeModtimeAndDigestInput then opts{shakeChange=ChangeModtime} else opts
defaultRuleFile :: Rules ()
defaultRuleFile = priority 0 $ rule $ \x -> Just $ do
opts <- getShakeOptions
liftIO $ storedValueError opts True "Error, file does not exist and no rule available:" x
need :: [FilePath] -> Action ()
need xs = (apply $ map (FileQ . packU_ . filepathNormalise . unpackU_ . packU) xs :: Action [FileA]) >> return ()
needBS :: [BS.ByteString] -> Action ()
needBS xs = (apply $ map (FileQ . packU_ . filepathNormalise) xs :: Action [FileA]) >> return ()
needed :: [FilePath] -> Action ()
needed xs = do
opts <- getShakeOptions
if isNothing $ shakeLint opts then need xs else neededCheck $ map packU xs
neededBS :: [BS.ByteString] -> Action ()
neededBS xs = do
opts <- getShakeOptions
if isNothing $ shakeLint opts then needBS xs else neededCheck $ map packU_ xs
neededCheck :: [BSU] -> Action ()
neededCheck (map (packU_ . filepathNormalise . unpackU_) -> xs) = do
opts <- getShakeOptions
pre <- liftIO $ mapM (storedValue opts . FileQ) xs
post <- apply $ map FileQ xs :: Action [FileA]
let bad = [ (x, if isJust a then "File change" else "File created")
| (x, a, b) <- zip3 xs pre post, maybe NotEqual (\a -> equalValue opts (FileQ x) a b) a == NotEqual]
case bad of
[] -> return ()
(file,msg):_ -> liftIO $ errorStructured
"Lint checking error - 'needed' file required rebuilding"
[("File", Just $ unpackU file)
,("Error",Just msg)]
""
trackRead :: [FilePath] -> Action ()
trackRead = mapM_ (trackUse . FileQ . packU)
trackWrite :: [FilePath] -> Action ()
trackWrite = mapM_ (trackChange . FileQ . packU)
trackAllow :: [FilePattern] -> Action ()
trackAllow ps = do
opts <- getShakeOptions
when (isJust $ shakeLint opts) $
S.trackAllow $ \(FileQ x) -> any (?== unpackU x) ps
want :: [FilePath] -> Rules ()
want [] = return ()
want xs = action $ need xs
root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
root help test act = rule $ \(FileQ x_) -> let x = unpackU x_ in
if not $ test x then Nothing else Just $ do
liftIO $ createDirectoryIfMissing True $ takeDirectory x
act x
opts <- getShakeOptions
liftIO $ storedValueError opts False ("Error, rule " ++ help ++ " failed to build file:") $ FileQ x_
phony :: String -> Action () -> Rules ()
phony name act = phonys $ \s -> if s == name then Just act else Nothing
phonys :: (String -> Maybe (Action ())) -> Rules ()
phonys act = rule $ \(FileQ x_) -> case act $ unpackU x_ of
Nothing -> Nothing
Just act -> Just $ do
act
return $ FileA fileInfoNeq fileInfoNeq fileInfoNeq
(~>) :: String -> Action () -> Rules ()
(~>) = phony
(?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
(?>) test act = priority 0.5 $ root "with ?>" test act
(|%>) :: [FilePattern] -> (FilePath -> Action ()) -> Rules ()
(|%>) pats act = do
let (simp,other) = partition simple pats
case simp of
[] -> return ()
[p] -> root "with |%>" (\x -> toStandard x == p) act
ps -> let ps = Set.fromList pats in root "with |%>" (flip Set.member ps . toStandard) act
unless (null other) $
let ps = map (?==) other in priority 0.5 $ root "with |%>" (\x -> any ($ x) ps) act
(%>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()
(%>) test act = (if simple test then id else priority 0.5) $ root (show test) (test ?==) act