{-# 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
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,Eq FilesQ
Int -> FilesQ -> Int
FilesQ -> Int
forall a. Eq 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
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
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FilesQ
$cgetEx :: ByteString -> FilesQ
putEx :: FilesQ -> Builder
$cputEx :: FilesQ -> Builder
BinaryEx,FilesQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: FilesQ -> ()
$crnf :: FilesQ -> ()
NFData)

newtype FilesA = FilesA [FileA]
    deriving (Typeable,ByteString -> FilesA
FilesA -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FilesA
$cgetEx :: ByteString -> FilesA
putEx :: FilesA -> Builder
$cputEx :: FilesA -> Builder
BinaryEx,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 forall a b. (a -> b) -> a -> b
$ String
"Files" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [FileA]
xs

instance Show FilesQ where show :: FilesQ -> String
show (FilesQ [FileQ]
xs) = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ShowS
wrapQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. Storable a => a -> Builder
putExStorable Ver
v forall a. Semigroup a => a -> a -> a
<> forall a. BinaryEx a => a -> Builder
putEx FilesA
x
    getEx :: ByteString -> Result
getEx ByteString
s = let (Ver
a,ByteString
b) = forall a. Storable a => ByteString -> (a, ByteString)
binarySplit ByteString
s in Ver -> FilesA -> Result
Result Ver
a forall a b. (a -> b) -> a -> b
$ 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FileA] -> FilesA
FilesA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileA]
xs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileA]
ys = EqualCost
NotEqual
    | Bool
otherwise = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EqualCost -> EqualCost -> EqualCost
and_ EqualCost
EqualCheap forall a b. (a -> b) -> a -> b
$ forall a b c. HasCallStack => (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 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.
    forall key value.
(RuleResult key ~ value, ShakeValue key, BinaryEx key,
 Typeable value, NFData value, Show value, HasCallStack) =>
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 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 []) = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe FilesA
now of
        Maybe FilesA
Nothing -> forall a. a -> Maybe a
Just String
"<missing>"
        Just FilesA
now | ShakeOptions -> FilesA -> FilesA -> EqualCost
filesEqualValue ShakeOptions
opts FilesA
v FilesA
now forall a. Eq a => a -> a -> Bool
== EqualCost
EqualCheap -> forall a. Maybe a
Nothing
                 | Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== Change
ChangeModtime = forall a. SomeException -> a
throwImpure 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) ->
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
putExList [forall a. Storable a => a -> Builder
putExStorable FileSize
size forall a. Semigroup a => a -> a -> a
<> 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@(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. BinaryEx a => ByteString -> a
getEx -> Maybe Result
old :: Maybe Result) RunMode
mode = do
    let r :: [Rebuild]
r = forall a b. (a -> b) -> [a] -> [b]
map (String -> Rebuild
rebuildFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> String
fileNameToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) forall a b. (a -> b) -> a -> b
$ FilesQ -> [FileQ]
fromFilesQ FilesQ
k

    (Maybe Ver
ruleVer, [(Int, Action FilesA)]
ruleAct, SomeException
ruleErr) <- 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)
_) -> forall a. a -> Maybe a
Just String
s) 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 = forall a. a -> Maybe a
Just Ver
v forall a. Eq a => a -> a -> Bool
== Maybe Ver
ruleVer Bool -> Bool -> Bool
|| forall a b. (a -> b) -> [a] -> [b]
map (Int -> Ver
Ver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Int, Action FilesA)]
ruleAct forall a. Eq a => a -> a -> Bool
== [Ver
v]
    let rebuild :: Action (RunResult FilesA)
rebuild = do
            Verbosity -> String -> Action ()
putWhen Verbosity
Verbose forall a b. (a -> b) -> a -> b
$ String
"# " forall a. [a] -> [a] -> [a]
++ 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)]
_ -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
ruleErr

    case Maybe Result
old of
        Maybe Result
_ | Rebuild
RebuildNow forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rebuild]
r -> Action (RunResult FilesA)
rebuild
        Maybe Result
_ | Rebuild
RebuildLater 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
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing (forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
o) 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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; forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedStore (Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx 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 forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame, Ver -> Bool
verEq Ver
ver -> do
            Maybe FilesA
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
                    -- See #810, important we pass old (which can be cheaply evaluated)
                    -- and not v, which might have some lazily-evaluated file hashes in
                    EqualCost
EqualCheap -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing (forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
o) FilesA
old
                    EqualCost
EqualExpensive -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedStore (Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx 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 ->
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FileA] -> FilesA
FilesA forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipExact (ByteString -> [ByteString]
getExList ByteString
res) (FilesQ -> [FileQ]
fromFilesQ FilesQ
k)) forall a b. (a -> b) -> a -> b
$ \(ByteString
bin, FileQ
file) -> do
                        Just (FileA ModTime
mod FileSize
size FileHash
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts FileQ
file
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModTime -> FileSize -> FileHash -> FileA
FileA ModTime
mod FileSize
size forall a b. (a -> b) -> a -> b
$ forall a. Storable a => ByteString -> a
getExStorable ByteString
bin
                Maybe ByteString
Nothing -> do
                    FilesA [FileA]
v <- Action FilesA
act
                    [String] -> Action ()
producesUnchecked forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) forall a b. (a -> b) -> a -> b
$ FilesQ -> [FileQ]
fromFilesQ FilesQ
k
                    Int -> ByteString -> Action ()
historySave Int
ver forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
putExList
                        [if FileHash -> Bool
isNoFileHash FileHash
hash then forall a. SomeException -> a
throwImpure SomeException
errorNoHash else forall a. Storable a => a -> Builder
putExStorable FileHash
hash | FileA ModTime
_ FileSize
_ FileHash
hash <- [FileA]
v]
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a. Eq a => a -> a -> Bool
/= EqualCost
NotEqual = RunChanged
ChangedRecomputeSame
                  | Bool
otherwise = RunChanged
ChangedRecomputeDiff
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
c (Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx 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] &%> :: HasCallStack => [String] -> ([String] -> Action ()) -> Rules ()
&%> [String] -> Action ()
act = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ String
p HasCallStack => String -> (String -> Action ()) -> Rules ()
%> [String] -> Action ()
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
[String]
ps &%> [String] -> Action ()
act
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [String] -> Bool
compatible [String]
ps = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
        String
"All patterns to &%> must have the same number and position of ** and * wildcards" forall a. a -> [a] -> [a]
:
        [String
"* " forall a. [a] -> [a] -> [a]
++ String
p forall a. [a] -> [a] -> [a]
++ (if [String] -> Bool
compatible [String
p, forall a. [a] -> a
head [String]
ps] then String
"" else String
" (incompatible)") | String
p <- [String]
ps]
    | Bool
otherwise = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [String]
ps) forall a b. (a -> b) -> a -> b
$ \(Int
i,String
p) ->
            (if String -> Bool
simple String
p then forall a. a -> a
id else forall a. Double -> Rules a -> Rules a
priority Double
0.5) forall a b. (a -> b) -> a -> b
$
                String -> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
fileForward (forall a. Show a => a -> String
show [String]
ps forall a. [a] -> [a] -> [a]
++ String
" &%> at " forall a. [a] -> [a] -> [a]
++ HasCallStack => String
callStackTop) forall a b. (a -> b) -> a -> b
$ let op :: String -> Bool
op = (String
p String -> String -> Bool
?==) in \String
file -> if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> Bool
op String
file then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                    FilesA [FileA]
res <- forall key value.
(HasCallStack, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall a b. (a -> b) -> a -> b
$ [FileQ] -> FilesQ
FilesQ forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileQ
FileQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FileName
fileNameFromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ShowS
substitute (String -> String -> [String]
extract String
p String
file)) [String]
ps
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileA]
res then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [FileA]
res forall a. [a] -> Int -> a
!! Int
i
        (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
simple [String]
ps then forall a. a -> a
id else forall a. Double -> Rules a -> Rules a
priority Double
0.5) forall a b. (a -> b) -> a -> b
$ do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Rules ()
addTarget [String]
ps
            forall a. Typeable a => a -> Rules ()
addUserRule forall a b. (a -> b) -> a -> b
$ String -> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
FilesRule (forall a. Show a => a -> String
show [String]
ps forall a. [a] -> [a] -> [a]
++ String
" &%> " forall a. [a] -> [a] -> [a]
++ HasCallStack => String
callStackTop) forall a b. (a -> b) -> a -> b
$ \(FilesQ [FileQ]
xs_) -> let xs :: [String]
xs = forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileQ -> FileName
fromFileQ) [FileQ]
xs_ in
                if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. HasCallStack => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithExact String -> String -> Bool
(?==) [String]
ps [String]
xs) then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ 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 invariant:
--
-- @
-- 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 ()
&?> :: HasCallStack =>
(String -> Maybe [String]) -> ([String] -> Action ()) -> Rules ()
(&?>) String -> Maybe [String]
test [String] -> Action ()
act = forall a. Double -> Rules a -> Rules a
priority Double
0.5 forall a b. (a -> b) -> a -> b
$ do
    let inputOutput :: String -> String -> [String] -> [String]
inputOutput String
suf String
inp [String]
out =
            [String
"Input" forall a. [a] -> [a] -> [a]
++ String
suf forall a. [a] -> [a] -> [a]
++ String
":", String
"  " forall a. [a] -> [a] -> [a]
++ String
inp] forall a. [a] -> [a] -> [a]
++
            [String
"Output" forall a. [a] -> [a] -> [a]
++ String
suf forall a. [a] -> [a] -> [a]
++ String
":"] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
"  "forall a. [a] -> [a] -> [a]
++) [String]
out
    let normTest :: String -> Maybe [String]
normTest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ ShowS
toStandard forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normaliseEx) 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 -> forall a. Maybe a
Nothing
            Just [String]
ys | String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
ys -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
                String
"Invariant broken in &?>, did not pure the input (after normalisation)." forall a. a -> [a] -> [a]
:
                String -> String -> [String] -> [String]
inputOutput String
"" String
x [String]
ys
            Just [String]
ys | String
bad:[String]
_ <- forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just [String]
ys) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [String]
normTest) [String]
ys -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
                [String
"Invariant broken in &?>, not equalValue for all arguments (after normalisation)."] forall a. [a] -> [a] -> [a]
++
                String -> String -> [String] -> [String]
inputOutput String
"1" String
x [String]
ys forall a. [a] -> [a] -> [a]
++
                String -> String -> [String] -> [String]
inputOutput String
"2" String
bad (forall a. a -> Maybe a -> a
fromMaybe [String
"Nothing"] forall a b. (a -> b) -> a -> b
$ String -> Maybe [String]
normTest String
bad)
            Just [String]
ys -> forall a. a -> Maybe a
Just [String]
ys

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

    forall a. Typeable a => a -> Rules ()
addUserRule forall a b. (a -> b) -> a -> b
$ String -> (FilesQ -> Maybe (Action FilesA)) -> FilesRule
FilesRule (String
"&?> " forall a. [a] -> [a] -> [a]
++ HasCallStack => String
callStackTop) forall a b. (a -> b) -> a -> b
$ \(FilesQ [FileQ]
xs_) -> let xs :: [String]
xs@(String
x:[String]
_) = forall a b. (a -> b) -> [a] -> [b]
map (FileName -> String
fileNameToString 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 forall a. Eq a => a -> a -> Bool
== [String]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ 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 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error, &?> is incompatible with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
xs forall a. [a] -> [a] -> [a]
++ String
" vs " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
ys
            Maybe [String]
Nothing -> 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 forall a. Eq a => a -> a -> Bool
== Change
ChangeModtimeAndDigestInput then ShakeOptions
opts{shakeChange :: Change
shakeChange=Change
ChangeModtime} else ShakeOptions
opts
    [Maybe FileA]
ys <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe FileA]
ys of
        Just [FileA]
ys -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA [FileA]
ys
        Maybe [FileA]
Nothing | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Bool
shakeCreationCheck ShakeOptions
opts -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FileA] -> FilesA
FilesA []
        Maybe [FileA]
Nothing -> do
            let missing :: Int
missing = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Maybe a -> Bool
isNothing [Maybe FileA]
ys
            forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error, " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" rule failed to produce " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
missing forall a. [a] -> [a] -> [a]
++
                    String
" file" forall a. [a] -> [a] -> [a]
++ (if Int
missing forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s") forall a. [a] -> [a] -> [a]
++ String
" (out of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileQ]
xs) forall a. [a] -> [a] -> [a]
++ String
")" forall a. [a] -> [a] -> [a]
++
                    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"\n  " forall a. [a] -> [a] -> [a]
++ FileName -> String
fileNameToString FileName
x forall a. [a] -> [a] -> [a]
++ if forall a. Maybe a -> Bool
isNothing Maybe FileA
y then String
" - MISSING" else String
"" | (FileQ FileName
x,Maybe FileA
y) <- forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipExact [FileQ]
xs [Maybe FileA]
ys]