module Development.Shake.Files(
(?>>), (*>>)
) where
import Control.DeepSeq
import Control.Monad
import Control.Monad.IO.Class
import Data.Binary
import Data.Hashable
import Data.Maybe
import Data.Typeable
import Development.Shake.Core
import Development.Shake.File
import Development.Shake.FilePattern
import Development.Shake.FileTime
infix 1 ?>>, *>>
newtype Files = Files [FilePath]
deriving (Typeable,Eq,Hashable,Binary,NFData)
newtype FileTimes = FileTimes [FileTime]
deriving (Typeable,Show,Eq,Hashable,Binary,NFData)
instance Show Files where show (Files xs) = unwords xs
instance Rule Files FileTimes where
validStored (Files xs) (FileTimes ts) = fmap (== map Just ts) $ mapM getModTimeMaybe xs
(*>>) :: [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()
ps *>> act
| not $ compatible ps = error $
"All patterns to *>> must have the same number and position of // and * wildcards\n" ++
unwords ps
| otherwise = do
forM_ ps $ \p ->
p *> \file -> do
apply1 $ Files $ map (substitute $ extract p file) ps :: Action FileTimes
return ()
rule $ \(Files xs) -> if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do
act xs
liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, *>> failed to build the file:") xs
(?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()
(?>>) test act = do
let checkedTest x = case test x of
Nothing -> Nothing
Just ys | x `elem` ys && all ((== Just ys) . test) ys -> Just ys
| otherwise -> error $ "Invariant broken in ?>> when trying on " ++ x
isJust . checkedTest ?> \x -> do
apply1 $ Files $ fromJust $ test x :: Action FileTimes
return ()
rule $ \(Files xs@(x:_)) -> case checkedTest x of
Just ys | ys == xs -> Just $ do
act xs
liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, multi rule failed to build the file:") xs
Just ys -> error $ "Error, ?>> is incompatible with " ++ show xs ++ " vs " ++ show ys
Nothing -> Nothing