{-# 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
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
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
_ ->
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
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
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
(&%>) :: 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_
(&?>) :: 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]