{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns, TypeFamilies, ConstraintKinds #-}

module Development.Shake.Internal.Rules.Files(
    (&?>), (&%>), defaultRuleFiles
    ) where

import Control.Monad
import Control.Monad.IO.Class
import Data.Maybe
import Data.List.Extra
import Data.Typeable
import General.Binary

import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Types hiding (Result)
import Development.Shake.Internal.Core.Build
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Errors
import General.Extra
import Development.Shake.Internal.FileName
import Development.Shake.Classes
import Development.Shake.Internal.Rules.Rerun
import Development.Shake.Internal.Rules.File
import Development.Shake.Internal.FilePattern
import Development.Shake.FilePath
import Development.Shake.Internal.FileInfo
import Development.Shake.Internal.Options
import Data.Monoid
import Prelude


infix 1 &?>, &%>


type instance RuleResult FilesQ = FilesA

newtype FilesQ = FilesQ {FilesQ -> [FileQ]
fromFilesQ :: [FileQ]}
    deriving (Typeable,FilesQ -> FilesQ -> Bool
(FilesQ -> FilesQ -> Bool)
-> (FilesQ -> FilesQ -> Bool) -> Eq FilesQ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilesQ -> FilesQ -> Bool
$c/= :: FilesQ -> FilesQ -> Bool
== :: FilesQ -> FilesQ -> Bool
$c== :: FilesQ -> FilesQ -> Bool
Eq,Int -> FilesQ -> Int
FilesQ -> Int
(Int -> FilesQ -> Int) -> (FilesQ -> Int) -> Hashable FilesQ
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FilesQ -> Int
$chash :: FilesQ -> Int
hashWithSalt :: Int -> FilesQ -> Int
$chashWithSalt :: Int -> FilesQ -> Int
Hashable,Get FilesQ
[FilesQ] -> Put
FilesQ -> Put
(FilesQ -> Put) -> Get FilesQ -> ([FilesQ] -> Put) -> Binary FilesQ
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FilesQ] -> Put
$cputList :: [FilesQ] -> Put
get :: Get FilesQ
$cget :: Get FilesQ
put :: FilesQ -> Put
$cput :: FilesQ -> Put
Binary,ByteString -> FilesQ
FilesQ -> Builder
(FilesQ -> Builder) -> (ByteString -> FilesQ) -> BinaryEx FilesQ
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FilesQ
$cgetEx :: ByteString -> FilesQ
putEx :: FilesQ -> Builder
$cputEx :: FilesQ -> Builder
BinaryEx,FilesQ -> ()
(FilesQ -> ()) -> NFData FilesQ
forall a. (a -> ()) -> NFData a
rnf :: FilesQ -> ()
$crnf :: FilesQ -> ()
NFData)

newtype FilesA = FilesA [FileA]
    deriving (Typeable,ByteString -> FilesA
FilesA -> Builder
(FilesA -> Builder) -> (ByteString -> FilesA) -> BinaryEx FilesA
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FilesA
$cgetEx :: ByteString -> FilesA
putEx :: FilesA -> Builder
$cputEx :: FilesA -> Builder
BinaryEx,FilesA -> ()
(FilesA -> ()) -> NFData FilesA
forall a. (a -> ()) -> NFData a
rnf :: FilesA -> ()
$crnf :: FilesA -> ()
NFData)

instance Show FilesA where show :: FilesA -> String
show (FilesA [FileA]
xs) = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Files" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (FileA -> String) -> [FileA] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
5 ShowS -> (FileA -> String) -> FileA -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileA -> String
forall a. Show a => a -> String
show) [FileA]
xs

instance Show FilesQ where show :: FilesQ -> String
show (FilesQ [FileQ]
xs) = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (FileQ -> String) -> [FileQ] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
wrapQuote ShowS -> (FileQ -> String) -> FileQ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> String
forall a. Show a => a -> String
show) [FileQ]
xs

data FilesRule = FilesRule String (FilesQ -> Maybe (Action FilesA))
    deriving Typeable

data Result = Result Ver FilesA

instance BinaryEx Result where
    putEx :: Result -> Builder
putEx (Result Ver
v FilesA
x) = Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilesA -> Builder
forall a. BinaryEx a => a -> Builder
putEx FilesA
x
    getEx :: ByteString -> Result
getEx ByteString
s = let (Ver
a,ByteString
b) = ByteString -> (Ver, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
binarySplit ByteString
s in Ver -> FilesA -> Result
Result Ver
a (FilesA -> Result) -> FilesA -> Result
forall a b. (a -> b) -> a -> b
$ ByteString -> FilesA
forall a. BinaryEx a => ByteString -> a
getEx ByteString
b


filesStoredValue :: ShakeOptions -> FilesQ -> IO (Maybe FilesA)
filesStoredValue :: ShakeOptions -> FilesQ -> IO (Maybe FilesA)
filesStoredValue ShakeOptions
opts (FilesQ [FileQ]
xs) = ([FileA] -> FilesA) -> Maybe [FileA] -> Maybe FilesA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FileA] -> FilesA
FilesA (Maybe [FileA] -> Maybe FilesA)
-> ([Maybe FileA] -> Maybe [FileA])
-> [Maybe FileA]
-> Maybe FilesA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe FileA] -> Maybe [FileA]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe FileA] -> Maybe FilesA)
-> IO [Maybe FileA] -> IO (Maybe FilesA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileQ -> IO (Maybe FileA)) -> [FileQ] -> IO [Maybe FileA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts) [FileQ]
xs

filesEqualValue :: ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue :: ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue ShakeOptions
opts (FilesA [FileA]
xs) (FilesA [FileA]
ys)
    | [FileA] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileA]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [FileA] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileA]
ys = EqualCost
NotEqual
    | Bool
otherwise = (EqualCost -> EqualCost -> EqualCost)
-> EqualCost -> [EqualCost] -> EqualCost
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EqualCost -> EqualCost -> EqualCost
and_ EqualCost
EqualCheap ([EqualCost] -> EqualCost) -> [EqualCost] -> EqualCost
forall a b. (a -> b) -> a -> b
$ (FileA -> FileA -> EqualCost) -> [FileA] -> [FileA] -> [EqualCost]
forall a b c. Partial => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact (ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts) [FileA]
xs [FileA]
ys
        where and_ :: EqualCost -> EqualCost -> EqualCost
and_ EqualCost
NotEqual EqualCost
_ = EqualCost
NotEqual
              and_ EqualCost
EqualCheap EqualCost
x = EqualCost
x
              and_ EqualCost
EqualExpensive EqualCost
x = if EqualCost
x EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
== EqualCost
NotEqual then EqualCost
NotEqual else EqualCost
EqualExpensive

defaultRuleFiles :: Rules ()
defaultRuleFiles :: Rules ()
defaultRuleFiles = do
    ShakeOptions
opts <- Rules ShakeOptions
getShakeOptionsRules
    -- A rule from FilesQ to FilesA. The result value is only useful for linting.
    BuiltinLint FilesQ FilesA
-> BuiltinIdentity FilesQ FilesA
-> BuiltinRun FilesQ FilesA
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, BinaryEx key,
 Typeable value, NFData value, Show value, Partial) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx (ShakeOptions -> BuiltinLint FilesQ FilesA
ruleLint ShakeOptions
opts) (ShakeOptions -> BuiltinIdentity FilesQ FilesA
ruleIdentity ShakeOptions
opts) (ShakeOptions -> (String -> Rebuild) -> BuiltinRun FilesQ FilesA
ruleRun ShakeOptions
opts ((String -> Rebuild) -> BuiltinRun FilesQ FilesA)
-> (String -> Rebuild) -> BuiltinRun FilesQ FilesA
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> String -> Rebuild
shakeRebuildApply ShakeOptions
opts)

ruleLint :: ShakeOptions -> BuiltinLint FilesQ FilesA
ruleLint :: ShakeOptions -> BuiltinLint FilesQ FilesA
ruleLint ShakeOptions
_ FilesQ
_ (FilesA []) = Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing -- in the case of disabling lint
ruleLint ShakeOptions
opts FilesQ
k FilesA
v = do
    Maybe FilesA
now <- ShakeOptions -> FilesQ -> IO (Maybe FilesA)
filesStoredValue ShakeOptions
opts FilesQ
k
    Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case Maybe FilesA
now of
        Maybe FilesA
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just String
"<missing>"
        Just FilesA
now | ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue ShakeOptions
opts FilesA
v FilesA
now EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
== EqualCost
EqualCheap -> Maybe String
forall a. Maybe a
Nothing
                 | Bool
otherwise -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FilesA -> String
forall a. Show a => a -> String
show FilesA
now

ruleIdentity :: ShakeOptions -> BuiltinIdentity FilesQ FilesA
ruleIdentity :: ShakeOptions -> BuiltinIdentity FilesQ FilesA
ruleIdentity ShakeOptions
opts | ShakeOptions -> Change
shakeChange ShakeOptions
opts Change -> Change -> Bool
forall a. Eq a => a -> a -> Bool
== Change
ChangeModtime = SomeException -> BuiltinIdentity FilesQ FilesA
forall a. SomeException -> a
throwImpure (SomeException -> BuiltinIdentity FilesQ FilesA)
-> SomeException -> BuiltinIdentity FilesQ FilesA
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    String
"Cannot use shakeChange=ChangeModTime with shakeShare" [] String
""
ruleIdentity ShakeOptions
_ = \FilesQ
_ (FilesA [FileA]
files) ->
    ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
putExList [FileSize -> Builder
forall a. Storable a => a -> Builder
putExStorable FileSize
size Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FileHash -> Builder
forall a. Storable a => a -> Builder
putExStorable FileHash
hash | FileA ModTime
_ FileSize
size FileHash
hash <- [FileA]
files]



ruleRun :: ShakeOptions -> (FilePath -> Rebuild) -> BuiltinRun FilesQ FilesA
ruleRun :: ShakeOptions -> (String -> Rebuild) -> BuiltinRun FilesQ FilesA
ruleRun ShakeOptions
opts String -> Rebuild
rebuildFlags FilesQ
k o :: Maybe ByteString
o@((ByteString -> Result) -> Maybe ByteString -> Maybe Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Result
forall a. BinaryEx a => ByteString -> a
getEx -> Maybe Result
old :: Maybe Result) RunMode
mode = do
    let r :: [Rebuild]
r = (FileQ -> Rebuild) -> [FileQ] -> [Rebuild]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Rebuild
rebuildFlags (String -> Rebuild) -> (FileQ -> String) -> FileQ -> Rebuild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> String
fileNameToString (FileName -> String) -> (FileQ -> FileName) -> FileQ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) ([FileQ] -> [Rebuild]) -> [FileQ] -> [Rebuild]
forall a b. (a -> b) -> a -> b
$ FilesQ -> [FileQ]
fromFilesQ FilesQ
k

    (Maybe Ver
ruleVer, [(Int, Action FilesA)]
ruleAct, SomeException
ruleErr) <- FilesQ
-> (FilesRule -> Maybe String)
-> (FilesRule -> Maybe (Action FilesA))
-> Action (Maybe Ver, [(Int, Action FilesA)], SomeException)
forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal FilesQ
k (\(FilesRule String
s FilesQ -> Maybe (Action FilesA)
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
s) ((FilesRule -> Maybe (Action FilesA))
 -> Action (Maybe Ver, [(Int, Action FilesA)], SomeException))
-> (FilesRule -> Maybe (Action FilesA))
-> Action (Maybe Ver, [(Int, Action FilesA)], SomeException)
forall a b. (a -> b) -> a -> b
$ \(FilesRule String
_ FilesQ -> Maybe (Action FilesA)
f) -> FilesQ -> Maybe (Action FilesA)
f FilesQ
k
    let verEq :: Ver -> Bool
verEq Ver
v = Ver -> Maybe Ver
forall a. a -> Maybe a
Just Ver
v Maybe Ver -> Maybe Ver -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Ver
ruleVer Bool -> Bool -> Bool
|| ((Int, Action FilesA) -> Ver) -> [(Int, Action FilesA)] -> [Ver]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Ver
Ver (Int -> Ver)
-> ((Int, Action FilesA) -> Int) -> (Int, Action FilesA) -> Ver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Action FilesA) -> Int
forall a b. (a, b) -> a
fst) [(Int, Action FilesA)]
ruleAct [Ver] -> [Ver] -> Bool
forall a. Eq a => a -> a -> Bool
== [Ver
v]
    let rebuild :: Action (RunResult FilesA)
rebuild = do
            Verbosity -> String -> Action ()
putWhen Verbosity
Verbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FilesQ -> String
forall a. Show a => a -> String
show FilesQ
k
            case [(Int, Action FilesA)]
ruleAct of
                [(Int, Action FilesA)
x] -> (Int, Action FilesA) -> Action (RunResult FilesA)
rebuildWith (Int, Action FilesA)
x
                [(Int, Action FilesA)]
_ -> SomeException -> Action (RunResult FilesA)
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
ruleErr

    case Maybe Result
old of
        Maybe Result
_ | Rebuild
RebuildNow Rebuild -> [Rebuild] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rebuild]
r -> Action (RunResult FilesA)
rebuild
        Maybe Result
_ | Rebuild
RebuildLater Rebuild -> [Rebuild] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rebuild]
r -> case Maybe Result
old of
            Just Result
_ ->
                -- ignoring the currently stored value, which may trigger lint has changed
                -- so disable lint on this file
                RunResult FilesA -> Action (RunResult FilesA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FilesA -> Action (RunResult FilesA))
-> RunResult FilesA -> Action (RunResult FilesA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FilesA -> RunResult FilesA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing (Maybe ByteString -> ByteString
forall a. Partial => Maybe a -> a
fromJust Maybe ByteString
o) (FilesA -> RunResult FilesA) -> FilesA -> RunResult FilesA
forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA []
            Maybe Result
Nothing -> do
                -- i don't have a previous value, so assume this is a source node, and mark rebuild in future
                Maybe FilesA
now <- IO (Maybe FilesA) -> Action (Maybe FilesA)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilesA) -> Action (Maybe FilesA))
-> IO (Maybe FilesA) -> Action (Maybe FilesA)
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> FilesQ -> IO (Maybe FilesA)
filesStoredValue ShakeOptions
opts FilesQ
k
                case Maybe FilesA
now of
                    Maybe FilesA
Nothing -> Action (RunResult FilesA)
rebuild
                    Just FilesA
now -> do Action ()
alwaysRerun; RunResult FilesA -> Action (RunResult FilesA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FilesA -> Action (RunResult FilesA))
-> RunResult FilesA -> Action (RunResult FilesA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FilesA -> RunResult FilesA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedStore (Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Result -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Result -> Builder) -> Result -> Builder
forall a b. (a -> b) -> a -> b
$ Ver -> FilesA -> Result
Result (Int -> Ver
Ver Int
0) FilesA
now) FilesA
now
        Just (Result Ver
ver FilesA
old) | RunMode
mode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame, Ver -> Bool
verEq Ver
ver -> do
            Maybe FilesA
v <- IO (Maybe FilesA) -> Action (Maybe FilesA)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilesA) -> Action (Maybe FilesA))
-> IO (Maybe FilesA) -> Action (Maybe FilesA)
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> FilesQ -> IO (Maybe FilesA)
filesStoredValue ShakeOptions
opts FilesQ
k
            case Maybe FilesA
v of
                Just FilesA
v -> case ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue ShakeOptions
opts FilesA
old FilesA
v of
                    EqualCost
NotEqual -> Action (RunResult FilesA)
rebuild
                    EqualCost
EqualCheap -> RunResult FilesA -> Action (RunResult FilesA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FilesA -> Action (RunResult FilesA))
-> RunResult FilesA -> Action (RunResult FilesA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FilesA -> RunResult FilesA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing (Maybe ByteString -> ByteString
forall a. Partial => Maybe a -> a
fromJust Maybe ByteString
o) FilesA
v
                    EqualCost
EqualExpensive -> RunResult FilesA -> Action (RunResult FilesA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FilesA -> Action (RunResult FilesA))
-> RunResult FilesA -> Action (RunResult FilesA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FilesA -> RunResult FilesA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedStore (Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Result -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Result -> Builder) -> Result -> Builder
forall a b. (a -> b) -> a -> b
$ Ver -> FilesA -> Result
Result Ver
ver FilesA
v) FilesA
v
                Maybe FilesA
Nothing -> Action (RunResult FilesA)
rebuild
        Maybe Result
_ -> Action (RunResult FilesA)
rebuild
    where
        rebuildWith :: (Int, Action FilesA) -> Action (RunResult FilesA)
rebuildWith (Int
ver, Action FilesA
act) = do
            Maybe ByteString
cache <- Int -> Action (Maybe ByteString)
historyLoad Int
ver
            FilesA
v <- case Maybe ByteString
cache of
                Just ByteString
res ->
                    ([FileA] -> FilesA) -> Action [FileA] -> Action FilesA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FileA] -> FilesA
FilesA (Action [FileA] -> Action FilesA)
-> Action [FileA] -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [(ByteString, FileQ)]
-> ((ByteString, FileQ) -> Action FileA) -> Action [FileA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([ByteString] -> [FileQ] -> [(ByteString, FileQ)]
forall a b. Partial => [a] -> [b] -> [(a, b)]
zipExact (ByteString -> [ByteString]
getExList ByteString
res) (FilesQ -> [FileQ]
fromFilesQ FilesQ
k)) (((ByteString, FileQ) -> Action FileA) -> Action [FileA])
-> ((ByteString, FileQ) -> Action FileA) -> Action [FileA]
forall a b. (a -> b) -> a -> b
$ \(ByteString
bin, FileQ
file) -> do
                        Just (FileA ModTime
mod FileSize
size FileHash
_) <- IO (Maybe FileA) -> Action (Maybe FileA)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileA) -> Action (Maybe FileA))
-> IO (Maybe FileA) -> Action (Maybe FileA)
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts FileQ
file
                        FileA -> Action FileA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileA -> Action FileA) -> FileA -> Action FileA
forall a b. (a -> b) -> a -> b
$ ModTime -> FileSize -> FileHash -> FileA
FileA ModTime
mod FileSize
size (FileHash -> FileA) -> FileHash -> FileA
forall a b. (a -> b) -> a -> b
$ ByteString -> FileHash
forall a. Storable a => ByteString -> a
getExStorable ByteString
bin
                Maybe ByteString
Nothing -> do
                    FilesA [FileA]
v <- Action FilesA
act
                    [String] -> Action ()
producesUnchecked ([String] -> Action ()) -> [String] -> Action ()
forall a b. (a -> b) -> a -> b
$ (FileQ -> String) -> [FileQ] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString (FileName -> String) -> (FileQ -> FileName) -> FileQ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) ([FileQ] -> [String]) -> [FileQ] -> [String]
forall a b. (a -> b) -> a -> b
$ FilesQ -> [FileQ]
fromFilesQ FilesQ
k
                    Int -> ByteString -> Action ()
historySave Int
ver (ByteString -> Action ()) -> ByteString -> Action ()
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
putExList
                        [if FileHash -> Bool
isNoFileHash FileHash
hash then SomeException -> Builder
forall a. SomeException -> a
throwImpure SomeException
errorNoHash else FileHash -> Builder
forall a. Storable a => a -> Builder
putExStorable FileHash
hash | FileA ModTime
_ FileSize
_ FileHash
hash <- [FileA]
v]
                    FilesA -> Action FilesA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilesA -> Action FilesA) -> FilesA -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA [FileA]
v
            let c :: RunChanged
c | Just (Result Ver
_ FilesA
old) <- Maybe Result
old, ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue ShakeOptions
opts FilesA
old FilesA
v EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
/= EqualCost
NotEqual = RunChanged
ChangedRecomputeSame
                  | Bool
otherwise = RunChanged
ChangedRecomputeDiff
            RunResult FilesA -> Action (RunResult FilesA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FilesA -> Action (RunResult FilesA))
-> RunResult FilesA -> Action (RunResult FilesA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FilesA -> RunResult FilesA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
c (Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Result -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Result -> Builder) -> Result -> Builder
forall a b. (a -> b) -> a -> b
$ Ver -> FilesA -> Result
Result (Int -> Ver
Ver Int
ver) FilesA
v) FilesA
v



-- | Define a rule for building multiple files at the same time.
--   Think of it as the AND (@&&@) equivalent of '%>'.
--   As an example, a single invocation of GHC produces both @.hi@ and @.o@ files:
--
-- @
-- [\"*.o\",\"*.hi\"] '&%>' \\[o,hi] -> do
--     let hs = o 'Development.Shake.FilePath.-<.>' \"hs\"
--     'Development.Shake.need' ... -- all files the .hs import
--     'Development.Shake.cmd' \"ghc -c\" [hs]
-- @
--
--   However, in practice, it's usually easier to define rules with '%>' and make the @.hi@ depend
--   on the @.o@. When defining rules that build multiple files, all the 'FilePattern' values must
--   have the same sequence of @\/\/@ and @*@ wildcards in the same order.
--   This function will create directories for the result files, if necessary.
(&%>) :: Located => [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()
[String
p] &%> :: [String] -> ([String] -> Action ()) -> Rules ()
&%> [String] -> Action ()
act = (Partial => Rules ()) -> Rules ()
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Rules ()) -> Rules ())
-> (Partial => Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ String
p Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> [String] -> Action ()
act ([String] -> Action ())
-> (String -> [String]) -> String -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[String]
ps &%> [String] -> Action ()
act
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
compatible [String]
ps = String -> Rules ()
forall a. Partial => String -> a
error (String -> Rules ()) -> String -> Rules ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        String
"All patterns to &%> must have the same number and position of ** and * wildcards" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
        [String
"* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if [String] -> Bool
compatible [String
p, [String] -> String
forall a. [a] -> a
head [String]
ps] then String
"" else String
" (incompatible)") | String
p <- [String]
ps]
    | Bool
otherwise = (Partial => Rules ()) -> Rules ()
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Rules ()) -> Rules ())
-> (Partial => Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        [(Int, String)] -> ((Int, String) -> Rules ()) -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [String] -> [(Int, String)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [String]
ps) (((Int, String) -> Rules ()) -> Rules ())
-> ((Int, String) -> Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,String
p) ->
            (if String -> Bool
simple String
p then Rules () -> Rules ()
forall a. a -> a
id else Double -> Rules () -> Rules ()
forall a. Double -> Rules a -> Rules a
priority Double
0.5) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
                String -> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
fileForward ([String] -> String
forall a. Show a => a -> String
show [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" &%> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
Partial => String
callStackTop) ((String -> Maybe (Action (Maybe FileA))) -> Rules ())
-> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
forall a b. (a -> b) -> a -> b
$ let op :: String -> Bool
op = (String
p String -> String -> Bool
?==) in \String
file -> if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
op String
file then Maybe (Action (Maybe FileA))
forall a. Maybe a
Nothing else Action (Maybe FileA) -> Maybe (Action (Maybe FileA))
forall a. a -> Maybe a
Just (Action (Maybe FileA) -> Maybe (Action (Maybe FileA)))
-> Action (Maybe FileA) -> Maybe (Action (Maybe FileA))
forall a b. (a -> b) -> a -> b
$ do
                    FilesA [FileA]
res <- FilesQ -> Action FilesA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (FilesQ -> Action FilesA) -> FilesQ -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [FileQ] -> FilesQ
FilesQ ([FileQ] -> FilesQ) -> [FileQ] -> FilesQ
forall a b. (a -> b) -> a -> b
$ (String -> FileQ) -> [String] -> [FileQ]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileQ
FileQ (FileName -> FileQ) -> (String -> FileName) -> String -> FileQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileName
fileNameFromString (String -> FileName) -> ShowS -> String -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ShowS
substitute (String -> String -> [String]
extract String
p String
file)) [String]
ps
                    Maybe FileA -> Action (Maybe FileA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileA -> Action (Maybe FileA))
-> Maybe FileA -> Action (Maybe FileA)
forall a b. (a -> b) -> a -> b
$ if [FileA] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileA]
res then Maybe FileA
forall a. Maybe a
Nothing else FileA -> Maybe FileA
forall a. a -> Maybe a
Just (FileA -> Maybe FileA) -> FileA -> Maybe FileA
forall a b. (a -> b) -> a -> b
$ [FileA]
res [FileA] -> Int -> FileA
forall a. [a] -> Int -> a
!! Int
i
        (if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
simple [String]
ps then Rules () -> Rules ()
forall a. a -> a
id else Double -> Rules () -> Rules ()
forall a. Double -> Rules a -> Rules a
priority Double
0.5) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            (String -> Rules ()) -> [String] -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Rules ()
addTarget [String]
ps
            FilesRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (FilesRule -> Rules ()) -> FilesRule -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
FilesRule ([String] -> String
forall a. Show a => a -> String
show [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" &%> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
Partial => String
callStackTop) ((FilesQ -> Maybe (Action FilesA)) -> FilesRule)
-> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
forall a b. (a -> b) -> a -> b
$ \(FilesQ [FileQ]
xs_) -> let xs :: [String]
xs = (FileQ -> String) -> [FileQ] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString (FileName -> String) -> (FileQ -> FileName) -> FileQ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) [FileQ]
xs_ in
                if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((String -> String -> Bool) -> [String] -> [String] -> [Bool]
forall a b c. Partial => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact String -> String -> Bool
(?==) [String]
ps [String]
xs) then Maybe (Action FilesA)
forall a. Maybe a
Nothing else Action FilesA -> Maybe (Action FilesA)
forall a. a -> Maybe a
Just (Action FilesA -> Maybe (Action FilesA))
-> Action FilesA -> Maybe (Action FilesA)
forall a b. (a -> b) -> a -> b
$ do
                    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
createDirectoryRecursive ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeDirectory [String]
xs
                    [String] -> Action ()
trackAllow [String]
xs
                    [String] -> Action ()
act [String]
xs
                    String -> [FileQ] -> Action FilesA
getFileTimes String
"&%>" [FileQ]
xs_


-- | Define a rule for building multiple files at the same time, a more powerful
--   and more dangerous version of '&%>'. Think of it as the AND (@&&@) equivalent of '?>'.
--
--   Given an application @test &?> ...@, @test@ should return @Just@ if the rule applies, and should
--   return the list of files that will be produced. This list /must/ include the file passed as an argument and should
--   obey the invariant:
--
-- > forAll $ \x ys -> test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys
--
--   Intuitively, the function defines a set partitioning, mapping each element to the partition that contains it.
--   As an example of a function satisfying the invariaint:
--
-- @
-- 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]@.
(&?>) :: Located => (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()
&?> :: (String -> Maybe [String]) -> ([String] -> Action ()) -> Rules ()
(&?>) String -> Maybe [String]
test [String] -> Action ()
act = Double -> Rules () -> Rules ()
forall a. Double -> Rules a -> Rules a
priority Double
0.5 (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    let inputOutput :: String -> String -> [String] -> [String]
inputOutput String
suf String
inp [String]
out =
            [String
"Input" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suf String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":", String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inp] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            [String
"Output" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suf String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
out
    let normTest :: String -> Maybe [String]
normTest = ([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> [String] -> [String]) -> ShowS -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ShowS
toStandard ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normaliseEx) (Maybe [String] -> Maybe [String])
-> (String -> Maybe [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [String]
test
    let checkedTest :: String -> Maybe [String]
checkedTest String
x = case String -> Maybe [String]
normTest String
x of
            Maybe [String]
Nothing -> Maybe [String]
forall a. Maybe a
Nothing
            Just [String]
ys | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
ys -> String -> Maybe [String]
forall a. Partial => String -> a
error (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                String
"Invariant broken in &?>, did not pure the input (after normalisation)." String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                String -> String -> [String] -> [String]
inputOutput String
"" String
x [String]
ys
            Just [String]
ys | String
bad:[String]
_ <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe [String] -> Maybe [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
ys) (Maybe [String] -> Bool)
-> (String -> Maybe [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [String]
normTest) [String]
ys -> String -> Maybe [String]
forall a. Partial => String -> a
error (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                [String
"Invariant broken in &?>, not equalValue for all arguments (after normalisation)."] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                String -> String -> [String] -> [String]
inputOutput String
"1" String
x [String]
ys [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                String -> String -> [String] -> [String]
inputOutput String
"2" String
bad ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String
"Nothing"] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe [String]
normTest String
bad)
            Just [String]
ys -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
ys

    String -> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
fileForward (String
"&?> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
Partial => String
callStackTop) ((String -> Maybe (Action (Maybe FileA))) -> Rules ())
-> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \String
x -> case String -> Maybe [String]
checkedTest String
x of
        Maybe [String]
Nothing -> Maybe (Action (Maybe FileA))
forall a. Maybe a
Nothing
        Just [String]
ys -> Action (Maybe FileA) -> Maybe (Action (Maybe FileA))
forall a. a -> Maybe a
Just (Action (Maybe FileA) -> Maybe (Action (Maybe FileA)))
-> Action (Maybe FileA) -> Maybe (Action (Maybe FileA))
forall a b. (a -> b) -> a -> b
$ do
            FilesA [FileA]
res <- FilesQ -> Action FilesA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (FilesQ -> Action FilesA) -> FilesQ -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [FileQ] -> FilesQ
FilesQ ([FileQ] -> FilesQ) -> [FileQ] -> FilesQ
forall a b. (a -> b) -> a -> b
$ (String -> FileQ) -> [String] -> [FileQ]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileQ
FileQ (FileName -> FileQ) -> (String -> FileName) -> String -> FileQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileName
fileNameFromString) [String]
ys
            Maybe FileA -> Action (Maybe FileA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileA -> Action (Maybe FileA))
-> Maybe FileA -> Action (Maybe FileA)
forall a b. (a -> b) -> a -> b
$ if [FileA] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileA]
res then Maybe FileA
forall a. Maybe a
Nothing else FileA -> Maybe FileA
forall a. a -> Maybe a
Just (FileA -> Maybe FileA) -> FileA -> Maybe FileA
forall a b. (a -> b) -> a -> b
$ [FileA]
res [FileA] -> Int -> FileA
forall a. [a] -> Int -> a
!! Maybe Int -> Int
forall a. Partial => Maybe a -> a
fromJust (String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
x [String]
ys)

    FilesRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (FilesRule -> Rules ()) -> FilesRule -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
FilesRule (String
"&?> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
Partial => String
callStackTop) ((FilesQ -> Maybe (Action FilesA)) -> FilesRule)
-> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
forall a b. (a -> b) -> a -> b
$ \(FilesQ [FileQ]
xs_) -> let xs :: [String]
xs@(String
x:[String]
_) = (FileQ -> String) -> [FileQ] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString (FileName -> String) -> (FileQ -> FileName) -> FileQ -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) [FileQ]
xs_ in
        case String -> Maybe [String]
checkedTest String
x of
            Just [String]
ys | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
xs -> Action FilesA -> Maybe (Action FilesA)
forall a. a -> Maybe a
Just (Action FilesA -> Maybe (Action FilesA))
-> Action FilesA -> Maybe (Action FilesA)
forall a b. (a -> b) -> a -> b
$ do
                IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
createDirectoryRecursive ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeDirectory [String]
xs
                [String] -> Action ()
act [String]
xs
                String -> [FileQ] -> Action FilesA
getFileTimes String
"&?>" [FileQ]
xs_
            Just [String]
ys -> String -> Maybe (Action FilesA)
forall a. Partial => String -> a
error (String -> Maybe (Action FilesA))
-> String -> Maybe (Action FilesA)
forall a b. (a -> b) -> a -> b
$ String
"Error, &?> is incompatible with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" vs " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
ys
            Maybe [String]
Nothing -> Maybe (Action FilesA)
forall a. Maybe a
Nothing


getFileTimes :: String -> [FileQ] -> Action FilesA
getFileTimes :: String -> [FileQ] -> Action FilesA
getFileTimes String
name [FileQ]
xs = do
    ShakeOptions
opts <- Action ShakeOptions
getShakeOptions
    let opts2 :: ShakeOptions
opts2 = if ShakeOptions -> Change
shakeChange ShakeOptions
opts Change -> Change -> Bool
forall a. Eq a => a -> a -> Bool
== Change
ChangeModtimeAndDigestInput then ShakeOptions
opts{shakeChange :: Change
shakeChange=Change
ChangeModtime} else ShakeOptions
opts
    [Maybe FileA]
ys <- IO [Maybe FileA] -> Action [Maybe FileA]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Maybe FileA] -> Action [Maybe FileA])
-> IO [Maybe FileA] -> Action [Maybe FileA]
forall a b. (a -> b) -> a -> b
$ (FileQ -> IO (Maybe FileA)) -> [FileQ] -> IO [Maybe FileA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts2) [FileQ]
xs
    case [Maybe FileA] -> Maybe [FileA]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe FileA]
ys of
        Just [FileA]
ys -> FilesA -> Action FilesA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilesA -> Action FilesA) -> FilesA -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA [FileA]
ys
        Maybe [FileA]
Nothing | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Bool
shakeCreationCheck ShakeOptions
opts -> FilesA -> Action FilesA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilesA -> Action FilesA) -> FilesA -> Action FilesA
forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA []
        Maybe [FileA]
Nothing -> do
            let missing :: Int
missing = [Maybe FileA] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe FileA] -> Int) -> [Maybe FileA] -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe FileA -> Bool) -> [Maybe FileA] -> [Maybe FileA]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe FileA -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe FileA]
ys
            String -> Action FilesA
forall a. Partial => String -> a
error (String -> Action FilesA) -> String -> Action FilesA
forall a b. (a -> b) -> a -> b
$ String
"Error, " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rule failed to produce " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
missing String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
" file" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
missing Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (out of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([FileQ] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileQ]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileName -> String
fileNameToString FileName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Maybe FileA -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FileA
y then String
" - MISSING" else String
"" | (FileQ FileName
x,Maybe FileA
y) <- [FileQ] -> [Maybe FileA] -> [(FileQ, Maybe FileA)]
forall a b. Partial => [a] -> [b] -> [(a, b)]
zipExact [FileQ]
xs [Maybe FileA]
ys]