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

module Development.Shake.Internal.Rules.File(
    need, needHasChanged, needBS, needed, neededBS, want,
    trackRead, trackWrite, trackAllow, produces,
    defaultRuleFile,
    (%>), (|%>), (?>), phony, (~>), phonys,
    resultHasChanged,
    -- * Internal only
    FileQ(..), FileA(..), fileStoredValue, fileEqualValue, EqualCost(..), fileForward
    ) where

import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.Typeable
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashSet as Set
import Foreign.Storable
import Data.Word
import Data.Monoid
import General.Binary
import General.Extra

import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Core.Build
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.FileName
import Development.Shake.Internal.Rules.Rerun
import Development.Shake.Classes
import Development.Shake.FilePath(toStandard)
import Development.Shake.Internal.FilePattern
import Development.Shake.Internal.FileInfo
import Development.Shake.Internal.Options
import Development.Shake.Internal.Errors

import System.FilePath(takeDirectory) -- important that this is the system local filepath, or wrong slashes go wrong
import System.IO.Unsafe(unsafeInterleaveIO)

import Prelude


infix 1 %>, ?>, |%>, ~>

---------------------------------------------------------------------
-- TYPES

type instance RuleResult FileQ = FileR

-- | The unique key we use to index File rules, to avoid name clashes.
newtype FileQ = FileQ {FileQ -> FileName
fromFileQ :: FileName}
    deriving (Typeable,FileQ -> FileQ -> Bool
(FileQ -> FileQ -> Bool) -> (FileQ -> FileQ -> Bool) -> Eq FileQ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileQ -> FileQ -> Bool
$c/= :: FileQ -> FileQ -> Bool
== :: FileQ -> FileQ -> Bool
$c== :: FileQ -> FileQ -> Bool
Eq,Int -> FileQ -> Int
FileQ -> Int
(Int -> FileQ -> Int) -> (FileQ -> Int) -> Hashable FileQ
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FileQ -> Int
$chash :: FileQ -> Int
hashWithSalt :: Int -> FileQ -> Int
$chashWithSalt :: Int -> FileQ -> Int
Hashable,Get FileQ
[FileQ] -> Put
FileQ -> Put
(FileQ -> Put) -> Get FileQ -> ([FileQ] -> Put) -> Binary FileQ
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FileQ] -> Put
$cputList :: [FileQ] -> Put
get :: Get FileQ
$cget :: Get FileQ
put :: FileQ -> Put
$cput :: FileQ -> Put
Binary,ByteString -> FileQ
FileQ -> Builder
(FileQ -> Builder) -> (ByteString -> FileQ) -> BinaryEx FileQ
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FileQ
$cgetEx :: ByteString -> FileQ
putEx :: FileQ -> Builder
$cputEx :: FileQ -> Builder
BinaryEx,FileQ -> ()
(FileQ -> ()) -> NFData FileQ
forall a. (a -> ()) -> NFData a
rnf :: FileQ -> ()
$crnf :: FileQ -> ()
NFData)

-- | Raw information about a file.
data FileA = FileA {-# UNPACK #-} !ModTime {-# UNPACK #-} !FileSize FileHash
    deriving (Typeable)

-- | Result of a File rule, may contain raw file information and whether the rule did run this build
data FileR = FileR { FileR -> Maybe FileA
answer :: !(Maybe FileA) -- ^ Raw information about the file built by this rule.
                                              --   Set to 'Nothing' for 'phony' files.
                   , FileR -> Bool
useLint :: !Bool       -- ^ Should we lint the resulting file
                   }
    deriving (Typeable)

-- | The types of file rule that occur.
data Mode
    = ModePhony (Action ()) -- ^ An action with no file value
    | ModeDirect (Action ()) -- ^ An action that produces this file
    | ModeForward (Action (Maybe FileA)) -- ^ An action that looks up a file someone else produced

-- | The results of the various 'Mode' rules.
data Answer
    = AnswerPhony
    | AnswerDirect Ver FileA
    | AnswerForward Ver FileA

-- | The file rules we use, first is the name (as pretty as you can get).
data FileRule = FileRule String (FilePath -> Maybe Mode)
    deriving Typeable


---------------------------------------------------------------------
-- INSTANCES

instance Show FileQ where show :: FileQ -> String
show (FileQ FileName
x) = FileName -> String
fileNameToString FileName
x

instance BinaryEx [FileQ] where
    putEx :: [FileQ] -> Builder
putEx = [FileName] -> Builder
forall a. BinaryEx a => a -> Builder
putEx ([FileName] -> Builder)
-> ([FileQ] -> [FileName]) -> [FileQ] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileQ -> FileName) -> [FileQ] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map FileQ -> FileName
fromFileQ
    getEx :: ByteString -> [FileQ]
getEx = (FileName -> FileQ) -> [FileName] -> [FileQ]
forall a b. (a -> b) -> [a] -> [b]
map FileName -> FileQ
FileQ ([FileName] -> [FileQ])
-> (ByteString -> [FileName]) -> ByteString -> [FileQ]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [FileName]
forall a. BinaryEx a => ByteString -> a
getEx

instance NFData FileA where
    rnf :: FileA -> ()
rnf (FileA ModTime
a FileSize
b FileHash
c) = ModTime -> ()
forall a. NFData a => a -> ()
rnf ModTime
a () -> () -> ()
`seq` FileSize -> ()
forall a. NFData a => a -> ()
rnf FileSize
b () -> () -> ()
`seq` FileHash -> ()
forall a. NFData a => a -> ()
rnf FileHash
c

instance NFData FileR where
    rnf :: FileR -> ()
rnf (FileR Maybe FileA
a Bool
b) = Maybe FileA -> ()
forall a. NFData a => a -> ()
rnf Maybe FileA
a () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b

instance Show FileA where
    show :: FileA -> String
show (FileA ModTime
m FileSize
s FileHash
h) = String
"File {mod=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModTime -> String
forall a. Show a => a -> String
show ModTime
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",size=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileSize -> String
forall a. Show a => a -> String
show FileSize
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",digest=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileHash -> String
forall a. Show a => a -> String
show FileHash
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

instance Show FileR where
    show :: FileR -> String
show FileR{Bool
Maybe FileA
useLint :: Bool
answer :: Maybe FileA
useLint :: FileR -> Bool
answer :: FileR -> Maybe FileA
..} = Maybe FileA -> String
forall a. Show a => a -> String
show Maybe FileA
answer

instance Storable FileA where
    sizeOf :: FileA -> Int
sizeOf FileA
_ = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 -- 4 Word32's
    alignment :: FileA -> Int
alignment FileA
_ = ModTime -> Int
forall a. Storable a => a -> Int
alignment (ModTime
forall a. HasCallStack => a
undefined :: ModTime)
    peekByteOff :: Ptr b -> Int -> IO FileA
peekByteOff Ptr b
p Int
i = ModTime -> FileSize -> FileHash -> FileA
FileA (ModTime -> FileSize -> FileHash -> FileA)
-> IO ModTime -> IO (FileSize -> FileHash -> FileA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr b -> Int -> IO ModTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
i IO (FileSize -> FileHash -> FileA)
-> IO FileSize -> IO (FileHash -> FileA)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO FileSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) IO (FileHash -> FileA) -> IO FileHash -> IO FileA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr b -> Int -> IO FileHash
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8)
    pokeByteOff :: Ptr b -> Int -> FileA -> IO ()
pokeByteOff Ptr b
p Int
i (FileA ModTime
a FileSize
b FileHash
c) = Ptr b -> Int -> ModTime -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p Int
i ModTime
a IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> Int -> FileSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) FileSize
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> Int -> FileHash -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) FileHash
c

instance BinaryEx FileA where
    putEx :: FileA -> Builder
putEx = FileA -> Builder
forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> FileA
getEx = ByteString -> FileA
forall a. Storable a => ByteString -> a
getExStorable

instance BinaryEx [FileA] where
    putEx :: [FileA] -> Builder
putEx = [FileA] -> Builder
forall a. Storable a => [a] -> Builder
putExStorableList
    getEx :: ByteString -> [FileA]
getEx = ByteString -> [FileA]
forall a. Storable a => ByteString -> [a]
getExStorableList

fromAnswer :: Answer -> Maybe FileA
fromAnswer :: Answer -> Maybe FileA
fromAnswer Answer
AnswerPhony = Maybe FileA
forall a. Maybe a
Nothing
fromAnswer (AnswerDirect Ver
_ FileA
x) = FileA -> Maybe FileA
forall a. a -> Maybe a
Just FileA
x
fromAnswer (AnswerForward Ver
_ FileA
x) = FileA -> Maybe FileA
forall a. a -> Maybe a
Just FileA
x

instance BinaryEx Answer where
    putEx :: Answer -> Builder
putEx Answer
AnswerPhony = Builder
forall a. Monoid a => a
mempty
    putEx (AnswerDirect Ver
ver FileA
x) = Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
ver Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FileA -> Builder
forall a. BinaryEx a => a -> Builder
putEx FileA
x
    putEx (AnswerForward Ver
ver FileA
x) = Word8 -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Word8
0 :: Word8) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
ver Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FileA -> Builder
forall a. BinaryEx a => a -> Builder
putEx FileA
x

    getEx :: ByteString -> Answer
getEx ByteString
x = case ByteString -> Int
BS.length ByteString
x of
        Int
0 -> Answer
AnswerPhony
        Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz then (Ver -> FileA -> Answer) -> ByteString -> Answer
forall t t t.
(Storable t, BinaryEx t) =>
(t -> t -> t) -> ByteString -> t
f Ver -> FileA -> Answer
AnswerDirect ByteString
x else (Ver -> FileA -> Answer) -> ByteString -> Answer
forall t t t.
(Storable t, BinaryEx t) =>
(t -> t -> t) -> ByteString -> t
f Ver -> FileA -> Answer
AnswerForward (ByteString -> Answer) -> ByteString -> Answer
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.tail ByteString
x
        where
            sz :: Int
sz = Ver -> Int
forall a. Storable a => a -> Int
sizeOf (Ver
forall a. HasCallStack => a
undefined :: Ver) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FileA -> Int
forall a. Storable a => a -> Int
sizeOf (FileA
forall a. HasCallStack => a
undefined :: FileA)
            f :: (t -> t -> t) -> ByteString -> t
f t -> t -> t
ctor ByteString
x = let (t
a,ByteString
b) = ByteString -> (t, ByteString)
forall a. Storable a => ByteString -> (a, ByteString)
binarySplit ByteString
x in t -> t -> t
ctor t
a (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ ByteString -> t
forall a. BinaryEx a => ByteString -> a
getEx ByteString
b


---------------------------------------------------------------------
-- FILE CHECK QUERIES

-- | An equality check and a cost.
data EqualCost
    = EqualCheap -- ^ The equality check was cheap.
    | EqualExpensive -- ^ The equality check was expensive, as the results are not trivially equal.
    | NotEqual -- ^ The values are not equal.
      deriving (EqualCost -> EqualCost -> Bool
(EqualCost -> EqualCost -> Bool)
-> (EqualCost -> EqualCost -> Bool) -> Eq EqualCost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EqualCost -> EqualCost -> Bool
$c/= :: EqualCost -> EqualCost -> Bool
== :: EqualCost -> EqualCost -> Bool
$c== :: EqualCost -> EqualCost -> Bool
Eq,Eq EqualCost
Eq EqualCost
-> (EqualCost -> EqualCost -> Ordering)
-> (EqualCost -> EqualCost -> Bool)
-> (EqualCost -> EqualCost -> Bool)
-> (EqualCost -> EqualCost -> Bool)
-> (EqualCost -> EqualCost -> Bool)
-> (EqualCost -> EqualCost -> EqualCost)
-> (EqualCost -> EqualCost -> EqualCost)
-> Ord EqualCost
EqualCost -> EqualCost -> Bool
EqualCost -> EqualCost -> Ordering
EqualCost -> EqualCost -> EqualCost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EqualCost -> EqualCost -> EqualCost
$cmin :: EqualCost -> EqualCost -> EqualCost
max :: EqualCost -> EqualCost -> EqualCost
$cmax :: EqualCost -> EqualCost -> EqualCost
>= :: EqualCost -> EqualCost -> Bool
$c>= :: EqualCost -> EqualCost -> Bool
> :: EqualCost -> EqualCost -> Bool
$c> :: EqualCost -> EqualCost -> Bool
<= :: EqualCost -> EqualCost -> Bool
$c<= :: EqualCost -> EqualCost -> Bool
< :: EqualCost -> EqualCost -> Bool
$c< :: EqualCost -> EqualCost -> Bool
compare :: EqualCost -> EqualCost -> Ordering
$ccompare :: EqualCost -> EqualCost -> Ordering
$cp1Ord :: Eq EqualCost
Ord,Int -> EqualCost -> ShowS
[EqualCost] -> ShowS
EqualCost -> String
(Int -> EqualCost -> ShowS)
-> (EqualCost -> String)
-> ([EqualCost] -> ShowS)
-> Show EqualCost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EqualCost] -> ShowS
$cshowList :: [EqualCost] -> ShowS
show :: EqualCost -> String
$cshow :: EqualCost -> String
showsPrec :: Int -> EqualCost -> ShowS
$cshowsPrec :: Int -> EqualCost -> ShowS
Show,ReadPrec [EqualCost]
ReadPrec EqualCost
Int -> ReadS EqualCost
ReadS [EqualCost]
(Int -> ReadS EqualCost)
-> ReadS [EqualCost]
-> ReadPrec EqualCost
-> ReadPrec [EqualCost]
-> Read EqualCost
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EqualCost]
$creadListPrec :: ReadPrec [EqualCost]
readPrec :: ReadPrec EqualCost
$creadPrec :: ReadPrec EqualCost
readList :: ReadS [EqualCost]
$creadList :: ReadS [EqualCost]
readsPrec :: Int -> ReadS EqualCost
$creadsPrec :: Int -> ReadS EqualCost
Read,Typeable,Int -> EqualCost
EqualCost -> Int
EqualCost -> [EqualCost]
EqualCost -> EqualCost
EqualCost -> EqualCost -> [EqualCost]
EqualCost -> EqualCost -> EqualCost -> [EqualCost]
(EqualCost -> EqualCost)
-> (EqualCost -> EqualCost)
-> (Int -> EqualCost)
-> (EqualCost -> Int)
-> (EqualCost -> [EqualCost])
-> (EqualCost -> EqualCost -> [EqualCost])
-> (EqualCost -> EqualCost -> [EqualCost])
-> (EqualCost -> EqualCost -> EqualCost -> [EqualCost])
-> Enum EqualCost
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EqualCost -> EqualCost -> EqualCost -> [EqualCost]
$cenumFromThenTo :: EqualCost -> EqualCost -> EqualCost -> [EqualCost]
enumFromTo :: EqualCost -> EqualCost -> [EqualCost]
$cenumFromTo :: EqualCost -> EqualCost -> [EqualCost]
enumFromThen :: EqualCost -> EqualCost -> [EqualCost]
$cenumFromThen :: EqualCost -> EqualCost -> [EqualCost]
enumFrom :: EqualCost -> [EqualCost]
$cenumFrom :: EqualCost -> [EqualCost]
fromEnum :: EqualCost -> Int
$cfromEnum :: EqualCost -> Int
toEnum :: Int -> EqualCost
$ctoEnum :: Int -> EqualCost
pred :: EqualCost -> EqualCost
$cpred :: EqualCost -> EqualCost
succ :: EqualCost -> EqualCost
$csucc :: EqualCost -> EqualCost
Enum,EqualCost
EqualCost -> EqualCost -> Bounded EqualCost
forall a. a -> a -> Bounded a
maxBound :: EqualCost
$cmaxBound :: EqualCost
minBound :: EqualCost
$cminBound :: EqualCost
Bounded)

fileStoredValue :: ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue :: ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions{shakeChange :: ShakeOptions -> Change
shakeChange=Change
c, shakeNeedDirectory :: ShakeOptions -> Bool
shakeNeedDirectory=Bool
allowDir} (FileQ FileName
x) = do
    Maybe (ModTime, FileSize)
res <- Bool -> FileName -> IO (Maybe (ModTime, FileSize))
getFileInfo Bool
allowDir FileName
x
    case Maybe (ModTime, FileSize)
res of
        Maybe (ModTime, FileSize)
Nothing -> Maybe FileA -> IO (Maybe FileA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileA
forall a. Maybe a
Nothing
        Just (ModTime
time,FileSize
size) | Change
c Change -> Change -> Bool
forall a. Eq a => a -> a -> Bool
== Change
ChangeModtime -> Maybe FileA -> IO (Maybe FileA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileA -> IO (Maybe FileA))
-> Maybe FileA -> IO (Maybe FileA)
forall a b. (a -> b) -> a -> b
$ FileA -> Maybe FileA
forall a. a -> Maybe a
Just (FileA -> Maybe FileA) -> FileA -> Maybe FileA
forall a b. (a -> b) -> a -> b
$ ModTime -> FileSize -> FileHash -> FileA
FileA ModTime
time FileSize
size FileHash
noFileHash
        Just (ModTime
time,FileSize
size) -> do
            FileHash
hash <- IO FileHash -> IO FileHash
forall a. IO a -> IO a
unsafeInterleaveIO (IO FileHash -> IO FileHash) -> IO FileHash -> IO FileHash
forall a b. (a -> b) -> a -> b
$ FileName -> IO FileHash
getFileHash FileName
x
            Maybe FileA -> IO (Maybe FileA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileA -> IO (Maybe FileA))
-> Maybe FileA -> IO (Maybe FileA)
forall a b. (a -> b) -> a -> b
$ FileA -> Maybe FileA
forall a. a -> Maybe a
Just (FileA -> Maybe FileA) -> FileA -> Maybe FileA
forall a b. (a -> b) -> a -> b
$ ModTime -> FileSize -> FileHash -> FileA
FileA ModTime
time FileSize
size FileHash
hash


fileEqualValue :: ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue :: ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions{shakeChange :: ShakeOptions -> Change
shakeChange=Change
c} (FileA ModTime
x1 FileSize
x2 FileHash
x3) (FileA ModTime
y1 FileSize
y2 FileHash
y3) = case Change
c of
    Change
ChangeModtime -> Bool -> EqualCost
bool (Bool -> EqualCost) -> Bool -> EqualCost
forall a b. (a -> b) -> a -> b
$ ModTime
x1 ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
y1
    Change
ChangeDigest -> Bool -> EqualCost
bool (Bool -> EqualCost) -> Bool -> EqualCost
forall a b. (a -> b) -> a -> b
$ FileSize
x2 FileSize -> FileSize -> Bool
forall a. Eq a => a -> a -> Bool
== FileSize
y2 Bool -> Bool -> Bool
&& FileHash
x3 FileHash -> FileHash -> Bool
forall a. Eq a => a -> a -> Bool
== FileHash
y3
    Change
ChangeModtimeOrDigest -> Bool -> EqualCost
bool (Bool -> EqualCost) -> Bool -> EqualCost
forall a b. (a -> b) -> a -> b
$ ModTime
x1 ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
y1 Bool -> Bool -> Bool
&& FileSize
x2 FileSize -> FileSize -> Bool
forall a. Eq a => a -> a -> Bool
== FileSize
y2 Bool -> Bool -> Bool
&& FileHash
x3 FileHash -> FileHash -> Bool
forall a. Eq a => a -> a -> Bool
== FileHash
y3
    Change
_ | ModTime
x1 ModTime -> ModTime -> Bool
forall a. Eq a => a -> a -> Bool
== ModTime
y1 -> EqualCost
EqualCheap
      | FileSize
x2 FileSize -> FileSize -> Bool
forall a. Eq a => a -> a -> Bool
== FileSize
y2 Bool -> Bool -> Bool
&& FileHash
x3 FileHash -> FileHash -> Bool
forall a. Eq a => a -> a -> Bool
== FileHash
y3 -> EqualCost
EqualExpensive
      | Bool
otherwise -> EqualCost
NotEqual
    where bool :: Bool -> EqualCost
bool Bool
b = if Bool
b then EqualCost
EqualCheap else EqualCost
NotEqual


-- | Arguments: options; is the file an input; a message for failure if the file does not exist; filename
storedValueError :: ShakeOptions -> Bool -> String -> FileQ -> IO (Maybe FileA)
{-
storedValueError opts False msg x | False && not (shakeOutputCheck opts) = do
    when (shakeCreationCheck opts) $ do
        whenM (isNothing <$> (storedValue opts x :: IO (Maybe FileA))) $ error $ msg ++ "\n  " ++ unpackU (fromFileQ x)
    pure $ FileA fileInfoEq fileInfoEq fileInfoEq
-}
storedValueError :: ShakeOptions -> Bool -> String -> FileQ -> IO (Maybe FileA)
storedValueError ShakeOptions
opts Bool
input String
msg FileQ
x = Maybe FileA -> (FileA -> Maybe FileA) -> Maybe FileA -> Maybe FileA
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe FileA
def FileA -> Maybe FileA
forall a. a -> Maybe a
Just (Maybe FileA -> Maybe FileA)
-> IO (Maybe FileA) -> IO (Maybe FileA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts2 FileQ
x
    where def :: Maybe FileA
def = if ShakeOptions -> Bool
shakeCreationCheck ShakeOptions
opts Bool -> Bool -> Bool
|| Bool
input then String -> Maybe FileA
forall a. HasCallStack => String -> a
error String
err else Maybe FileA
forall a. Maybe a
Nothing
          err :: String
err = String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FileName -> String
fileNameToString (FileQ -> FileName
fromFileQ FileQ
x)
          opts2 :: ShakeOptions
opts2 = if Bool -> Bool
not Bool
input Bool -> Bool -> Bool
&& 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


---------------------------------------------------------------------
-- THE DEFAULT RULE

defaultRuleFile :: Rules ()
defaultRuleFile :: Rules ()
defaultRuleFile = do
    opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [String]
shakeShare :: ShakeOptions -> Maybe String
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintInside :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [String]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> String
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: String -> String -> Bool -> IO ()
shakeOutput :: Verbosity -> String -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeAllowRedefineRules :: Bool
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [String]
shakeShare :: Maybe String
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [String]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(String, String)]
shakeRebuild :: [(Rebuild, String)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [String]
shakeLintIgnore :: [String]
shakeLintInside :: [String]
shakeLint :: Maybe Lint
shakeReport :: [String]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: String
shakeThreads :: Int
shakeFiles :: String
shakeCreationCheck :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
..} <- Rules ShakeOptions
getShakeOptionsRules
    -- A rule from FileQ to (Maybe FileA). The result value is only useful for linting.
    BuiltinLint FileQ FileR
-> BuiltinIdentity FileQ FileR
-> BuiltinRun FileQ FileR
-> Rules ()
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 FileQ FileR
ruleLint ShakeOptions
opts) (ShakeOptions -> BuiltinIdentity FileQ FileR
ruleIdentity ShakeOptions
opts) (ShakeOptions -> (String -> Rebuild) -> BuiltinRun FileQ FileR
ruleRun ShakeOptions
opts ((String -> Rebuild) -> BuiltinRun FileQ FileR)
-> (String -> Rebuild) -> BuiltinRun FileQ FileR
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> String -> Rebuild
shakeRebuildApply ShakeOptions
opts)

ruleLint :: ShakeOptions -> BuiltinLint FileQ FileR
ruleLint :: ShakeOptions -> BuiltinLint FileQ FileR
ruleLint ShakeOptions
opts FileQ
k (FileR (Just FileA
v) Bool
True) = do
    Maybe FileA
now <- ShakeOptions -> FileQ -> IO (Maybe FileA)
fileStoredValue ShakeOptions
opts FileQ
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 FileA
now of
        Maybe FileA
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just String
"<missing>"
        Just FileA
now | ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts FileA
v FileA
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
$ FileA -> String
forall a. Show a => a -> String
show FileA
now
ruleLint ShakeOptions
_ FileQ
_ FileR
_ = Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing

ruleIdentity :: ShakeOptions -> BuiltinIdentity FileQ FileR
ruleIdentity :: ShakeOptions -> BuiltinIdentity FileQ FileR
ruleIdentity ShakeOptions
opts | ShakeOptions -> Change
shakeChange ShakeOptions
opts Change -> Change -> Bool
forall a. Eq a => a -> a -> Bool
== Change
ChangeModtime = SomeException -> BuiltinIdentity FileQ FileR
forall a. SomeException -> a
throwImpure SomeException
errorNoHash
ruleIdentity ShakeOptions
_ = \FileQ
k FileR
v -> case FileR -> Maybe FileA
answer FileR
v of
    Just (FileA ModTime
_ FileSize
size FileHash
hash) -> 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
$ 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
    Maybe FileA
Nothing -> Maybe ByteString
forall a. Maybe a
Nothing

ruleRun :: ShakeOptions -> (FilePath -> Rebuild) -> BuiltinRun FileQ FileR
ruleRun :: ShakeOptions -> (String -> Rebuild) -> BuiltinRun FileQ FileR
ruleRun opts :: ShakeOptions
opts@ShakeOptions{Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: String -> String -> Bool -> IO ()
shakeOutput :: Verbosity -> String -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeAllowRedefineRules :: Bool
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [String]
shakeShare :: Maybe String
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [String]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(String, String)]
shakeRebuild :: [(Rebuild, String)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [String]
shakeLintIgnore :: [String]
shakeLintInside :: [String]
shakeLint :: Maybe Lint
shakeReport :: [String]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: String
shakeThreads :: Int
shakeFiles :: String
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [String]
shakeShare :: ShakeOptions -> Maybe String
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintInside :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [String]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> String
shakeCreationCheck :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
..} String -> Rebuild
rebuildFlags o :: FileQ
o@(FileQ (FileName -> String
fileNameToString -> String
xStr)) oldBin :: Maybe ByteString
oldBin@((ByteString -> Answer) -> Maybe ByteString -> Maybe Answer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Answer
forall a. BinaryEx a => ByteString -> a
getEx -> Maybe Answer
old :: Maybe Answer) RunMode
mode = do
    -- for One, rebuild makes perfect sense
    -- for Forward, we expect the child will have already rebuilt - Rebuild just lets us deal with code changes
    -- for Phony, it doesn't make that much sense, but probably isn't harmful?
    let r :: Rebuild
r = String -> Rebuild
rebuildFlags String
xStr

    (Maybe Ver
ruleVer, [(Int, Mode)]
ruleAct, SomeException
ruleErr) <- FileQ
-> (FileRule -> Maybe String)
-> (FileRule -> Maybe Mode)
-> Action (Maybe Ver, [(Int, Mode)], SomeException)
forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal FileQ
o (\(FileRule String
s String -> Maybe Mode
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
s) ((FileRule -> Maybe Mode)
 -> Action (Maybe Ver, [(Int, Mode)], SomeException))
-> (FileRule -> Maybe Mode)
-> Action (Maybe Ver, [(Int, Mode)], SomeException)
forall a b. (a -> b) -> a -> b
$ \(FileRule String
_ String -> Maybe Mode
f) -> String -> Maybe Mode
f String
xStr
    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
|| case [(Int, Mode)]
ruleAct of [] -> Ver
v Ver -> Ver -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Ver
Ver Int
0; [(Int
v2,Mode
_)] -> Ver
v Ver -> Ver -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Ver
Ver Int
v2; [(Int, Mode)]
_ -> Bool
False
    let rebuild :: Action (RunResult FileR)
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]
++ FileQ -> String
forall a. Show a => a -> String
show FileQ
o
            case [(Int, Mode)]
ruleAct of
                [] -> Maybe (Int, Mode) -> Action (RunResult FileR)
rebuildWith Maybe (Int, Mode)
forall a. Maybe a
Nothing
                [(Int, Mode)
x] -> Maybe (Int, Mode) -> Action (RunResult FileR)
rebuildWith (Maybe (Int, Mode) -> Action (RunResult FileR))
-> Maybe (Int, Mode) -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ (Int, Mode) -> Maybe (Int, Mode)
forall a. a -> Maybe a
Just (Int, Mode)
x
                [(Int, Mode)]
_ -> SomeException -> Action (RunResult FileR)
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
ruleErr

    case Maybe Answer
old of
        Maybe Answer
_ | Rebuild
r Rebuild -> Rebuild -> Bool
forall a. Eq a => a -> a -> Bool
== Rebuild
RebuildNow -> Action (RunResult FileR)
rebuild
        Maybe Answer
_ | Rebuild
r Rebuild -> Rebuild -> Bool
forall a. Eq a => a -> a -> Bool
== Rebuild
RebuildLater -> case Maybe Answer
old of
            Just Answer
_ ->
                -- ignoring the currently stored value, which may trigger lint has changed
                -- so disable lint on this file
                RunResult FileR -> RunResult FileR
unLint (RunResult FileR -> RunResult FileR)
-> Action (RunResult FileR) -> Action (RunResult FileR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunChanged -> Action (RunResult FileR)
retOld RunChanged
ChangedNothing
            Maybe Answer
Nothing -> do
                -- i don't have a previous value, so assume this is a source node, and mark rebuild in future
                Maybe FileA
now <- 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
o
                case Maybe FileA
now of
                    Maybe FileA
Nothing -> Action (RunResult FileR)
rebuild
                    Just FileA
now -> do Action ()
alwaysRerun; RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
ChangedStore (Answer -> Action (RunResult FileR))
-> Answer -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ Ver -> FileA -> Answer
AnswerDirect (Int -> Ver
Ver Int
0) FileA
now
        {-
        _ | r == RebuildNever -> do
            now <- liftIO $ fileStoredValue opts o
            case now of
                Nothing -> rebuild
                Just now -> do
                    let diff | Just (AnswerDirect old) <- old, fileEqualValue opts old now /= NotEqual = ChangedRecomputeSame
                                | otherwise = ChangedRecomputeDiff
                    retNew diff $ AnswerDirect now
        -}
        Just (AnswerDirect Ver
ver FileA
old) | RunMode
mode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame, Ver -> Bool
verEq Ver
ver -> do
            Maybe FileA
now <- 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
o
            let noHash :: FileA -> Bool
noHash (FileA ModTime
_ FileSize
_ FileHash
x) = FileHash -> Bool
isNoFileHash FileHash
x
            case Maybe FileA
now of
                Maybe FileA
Nothing -> Action (RunResult FileR)
rebuild
                Just FileA
now -> case ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts FileA
old FileA
now of
                    EqualCost
NotEqual ->
                        Action (RunResult FileR)
rebuild
                    -- if our last build used no file hashing, but this build should, then we must refresh the hash
                    EqualCost
EqualCheap | if FileA -> Bool
noHash FileA
old then Change
shakeChange Change -> Change -> Bool
forall a. Eq a => a -> a -> Bool
== Change
ChangeModtimeAndDigestInput Bool -> Bool -> Bool
|| FileA -> Bool
noHash FileA
now else Bool
True ->
                        RunChanged -> Action (RunResult FileR)
retOld RunChanged
ChangedNothing
                    EqualCost
_ ->
                        RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
ChangedStore (Answer -> Action (RunResult FileR))
-> Answer -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ Ver -> FileA -> Answer
AnswerDirect Ver
ver FileA
now
        Just (AnswerForward Ver
ver FileA
_) | Ver -> Bool
verEq Ver
ver, RunMode
mode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame -> RunChanged -> Action (RunResult FileR)
retOld RunChanged
ChangedNothing
        Maybe Answer
_ -> Action (RunResult FileR)
rebuild
    where
        -- no need to lint check forward files
        -- but more than that, it goes wrong if you do, see #427
        fileR :: Answer -> FileR
fileR (AnswerDirect Ver
_ FileA
x) = Maybe FileA -> Bool -> FileR
FileR (FileA -> Maybe FileA
forall a. a -> Maybe a
Just FileA
x) Bool
True
        fileR (AnswerForward Ver
_ FileA
x) = Maybe FileA -> Bool -> FileR
FileR (FileA -> Maybe FileA
forall a. a -> Maybe a
Just FileA
x) Bool
False
        fileR Answer
AnswerPhony = Maybe FileA -> Bool -> FileR
FileR Maybe FileA
forall a. Maybe a
Nothing Bool
False
        unLint :: RunResult FileR -> RunResult FileR
unLint (RunResult RunChanged
a ByteString
b FileR
c) = RunChanged -> ByteString -> FileR -> RunResult FileR
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
a ByteString
b FileR
c{useLint :: Bool
useLint = Bool
False}

        retNew :: RunChanged -> Answer -> Action (RunResult FileR)
        retNew :: RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
c Answer
v = RunResult FileR -> Action (RunResult FileR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FileR -> Action (RunResult FileR))
-> RunResult FileR -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FileR -> RunResult FileR
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
c (Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Answer -> Builder
forall a. BinaryEx a => a -> Builder
putEx Answer
v) (FileR -> RunResult FileR) -> FileR -> RunResult FileR
forall a b. (a -> b) -> a -> b
$ Answer -> FileR
fileR Answer
v

        retOld :: RunChanged -> Action (RunResult FileR)
        retOld :: RunChanged -> Action (RunResult FileR)
retOld RunChanged
c = RunResult FileR -> Action (RunResult FileR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult FileR -> Action (RunResult FileR))
-> RunResult FileR -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> FileR -> RunResult FileR
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
c (Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ByteString
oldBin) (FileR -> RunResult FileR) -> FileR -> RunResult FileR
forall a b. (a -> b) -> a -> b
$ Answer -> FileR
fileR (Maybe Answer -> Answer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Answer
old)

        -- actually run the rebuild
        rebuildWith :: Maybe (Int, Mode) -> Action (RunResult FileR)
rebuildWith Maybe (Int, Mode)
act = do
            let answer :: (FileA -> Answer) -> FileA -> Action (RunResult FileR)
answer FileA -> Answer
ctor FileA
new = do
                    let b :: RunChanged
b = case () of
                                ()
_ | Just Answer
old <- Maybe Answer
old
                                    , Just FileA
old <- Answer -> Maybe FileA
fromAnswer Answer
old
                                    , ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts FileA
old FileA
new EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
/= EqualCost
NotEqual -> RunChanged
ChangedRecomputeSame
                                ()
_ -> RunChanged
ChangedRecomputeDiff
                    RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
b (Answer -> Action (RunResult FileR))
-> Answer -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ FileA -> Answer
ctor FileA
new
            case Maybe (Int, Mode)
act of
                Maybe (Int, Mode)
Nothing -> do
                    Maybe FileA
new <- 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 -> Bool -> String -> FileQ -> IO (Maybe FileA)
storedValueError ShakeOptions
opts Bool
True String
"Error, file does not exist and no rule available:" FileQ
o
                    (FileA -> Answer) -> FileA -> Action (RunResult FileR)
answer (Ver -> FileA -> Answer
AnswerDirect (Ver -> FileA -> Answer) -> Ver -> FileA -> Answer
forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
0)  (FileA -> Action (RunResult FileR))
-> FileA -> Action (RunResult FileR)
forall a b. (a -> b) -> a -> b
$ Maybe FileA -> FileA
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FileA
new
                Just (Int
ver, ModeForward Action (Maybe FileA)
act) -> do
                    Maybe FileA
new <- Action (Maybe FileA)
act
                    case Maybe FileA
new of
                        Maybe FileA
Nothing -> do
                            -- Not 100% sure how you get here, but I think it involves RebuildLater and multi-file rules
                            Action ()
historyDisable
                            RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
ChangedRecomputeDiff Answer
AnswerPhony
                        Just FileA
new -> (FileA -> Answer) -> FileA -> Action (RunResult FileR)
answer (Ver -> FileA -> Answer
AnswerForward (Ver -> FileA -> Answer) -> Ver -> FileA -> Answer
forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
ver) FileA
new
                Just (Int
ver, ModeDirect Action ()
act) -> do
                    Maybe ByteString
cache <- Int -> Action (Maybe ByteString)
historyLoad Int
ver
                    case Maybe ByteString
cache of
                        Just ByteString
encodedHash -> 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 -> Bool -> String -> FileQ -> IO (Maybe FileA)
storedValueError ShakeOptions
opts Bool
False String
"Error, restored the rule but did not produce file:" FileQ
o
                            (FileA -> Answer) -> FileA -> Action (RunResult FileR)
answer (Ver -> FileA -> Answer
AnswerDirect (Ver -> FileA -> Answer) -> Ver -> FileA -> Answer
forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
ver) (FileA -> Action (RunResult FileR))
-> FileA -> Action (RunResult FileR)
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
encodedHash
                        Maybe ByteString
Nothing -> do
                            Action ()
act
                            Maybe FileA
new <- 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 -> Bool -> String -> FileQ -> IO (Maybe FileA)
storedValueError ShakeOptions
opts Bool
False String
"Error, rule finished running but did not produce file:" FileQ
o
                            case Maybe FileA
new of
                                Maybe FileA
Nothing -> do
                                    -- rule ran, but didn't compute an answer, because shakeCreationCheck=False
                                    -- I think it should probably not return phony, but return a different valid-but-no-file
                                    -- but it's just too rare to bother
                                    Action ()
historyDisable
                                    RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
ChangedRecomputeDiff Answer
AnswerPhony
                                Just new :: FileA
new@(FileA ModTime
_ FileSize
_ FileHash
fileHash) -> do
                                    [String] -> Action ()
producesUnchecked [String
xStr]
                                    RunResult FileR
res <- (FileA -> Answer) -> FileA -> Action (RunResult FileR)
answer (Ver -> FileA -> Answer
AnswerDirect (Ver -> FileA -> Answer) -> Ver -> FileA -> Answer
forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
ver) FileA
new
                                    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
$
                                        if FileHash -> Bool
isNoFileHash FileHash
fileHash then SomeException -> Builder
forall a. SomeException -> a
throwImpure SomeException
errorNoHash else FileHash -> Builder
forall a. Storable a => a -> Builder
putExStorable FileHash
fileHash
                                    RunResult FileR -> Action (RunResult FileR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunResult FileR
res
                Just (Int
_, ModePhony Action ()
act) -> do
                    -- See #523 and #524
                    -- Shake runs the dependencies first, but stops when one has changed.
                    -- We don't want to run the existing deps first if someone changes the build system,
                    -- so insert a fake dependency that cuts the process dead.
                    Action ()
alwaysRerun
                    Action ()
act
                    RunChanged -> Answer -> Action (RunResult FileR)
retNew RunChanged
ChangedRecomputeDiff Answer
AnswerPhony


apply_ :: Partial => (a -> FileName) -> [a] -> Action [FileR]
apply_ :: (a -> FileName) -> [a] -> Action [FileR]
apply_ a -> FileName
f = [FileQ] -> Action [FileR]
forall key value.
(HasCallStack, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
[key] -> Action [value]
apply ([FileQ] -> Action [FileR])
-> ([a] -> [FileQ]) -> [a] -> Action [FileR]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FileQ) -> [a] -> [FileQ]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileQ
FileQ (FileName -> FileQ) -> (a -> FileName) -> a -> FileQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FileName
f)


-- | Has a file changed. This function will only give the correct answer if called in the rule
--   producing the file, /before/ the rule has modified the file in question.
--   Best avoided, but sometimes necessary in conjunction with 'needHasChanged' to cause rebuilds
--   to happen if the result is deleted or modified.
resultHasChanged :: FilePath -> Action Bool
resultHasChanged :: String -> Action Bool
resultHasChanged String
file = do
    let filename :: FileQ
filename = FileName -> FileQ
FileQ (FileName -> FileQ) -> FileName -> FileQ
forall a b. (a -> b) -> a -> b
$ String -> FileName
fileNameFromString String
file
    Maybe (Result (Either ByteString FileR))
res <- FileQ -> Action (Maybe (Result (Either ByteString FileR)))
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value) =>
key -> Action (Maybe (Result (Either ByteString value)))
getDatabaseValue FileQ
filename
    Maybe FileA
old<- 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
$ case Result (Either ByteString FileR) -> Either ByteString FileR
forall a. Result a -> a
result (Result (Either ByteString FileR) -> Either ByteString FileR)
-> Maybe (Result (Either ByteString FileR))
-> Maybe (Either ByteString FileR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Result (Either ByteString FileR))
res of
        Maybe (Either ByteString FileR)
Nothing -> Maybe FileA
forall a. Maybe a
Nothing
        Just (Left ByteString
bs) -> Answer -> Maybe FileA
fromAnswer (Answer -> Maybe FileA) -> Answer -> Maybe FileA
forall a b. (a -> b) -> a -> b
$ ByteString -> Answer
forall a. BinaryEx a => ByteString -> a
getEx ByteString
bs
        Just (Right FileR
v) -> FileR -> Maybe FileA
answer FileR
v
    case Maybe FileA
old of
        Maybe FileA
Nothing -> Bool -> Action Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Just FileA
old -> do
            ShakeOptions
opts <- Action ShakeOptions
getShakeOptions
            Maybe FileA
new <- 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
filename
            Bool -> Action Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Action Bool) -> Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ case Maybe FileA
new of
                Maybe FileA
Nothing -> Bool
True
                Just FileA
new -> ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts FileA
old FileA
new EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
== EqualCost
NotEqual


---------------------------------------------------------------------
-- OPTIONS ON TOP

-- | Internal method for adding forwarding actions
fileForward :: String -> (FilePath -> Maybe (Action (Maybe FileA))) -> Rules ()
fileForward :: String -> (String -> Maybe (Action (Maybe FileA))) -> Rules ()
fileForward String
help String -> Maybe (Action (Maybe FileA))
act = FileRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (FileRule -> Rules ()) -> FileRule -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> Maybe Mode) -> FileRule
FileRule String
help ((String -> Maybe Mode) -> FileRule)
-> (String -> Maybe Mode) -> FileRule
forall a b. (a -> b) -> a -> b
$ (Action (Maybe FileA) -> Mode)
-> Maybe (Action (Maybe FileA)) -> Maybe Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Maybe FileA) -> Mode
ModeForward (Maybe (Action (Maybe FileA)) -> Maybe Mode)
-> (String -> Maybe (Action (Maybe FileA))) -> String -> Maybe Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Action (Maybe FileA))
act


-- | Add a dependency on the file arguments, ensuring they are built before continuing.
--   The file arguments may be built in parallel, in any order. This function is particularly
--   necessary when calling 'Development.Shake.cmd' or 'Development.Shake.command'. As an example:
--
-- @
-- \"\/\/*.rot13\" '%>' \\out -> do
--     let src = 'Development.Shake.FilePath.dropExtension' out
--     'need' [src]
--     'Development.Shake.cmd' \"rot13\" [src] \"-o\" [out]
-- @
--
--   Usually @need [foo,bar]@ is preferable to @need [foo] >> need [bar]@ as the former allows greater
--   parallelism, while the latter requires @foo@ to finish building before starting to build @bar@.
--
--   This function should not be called with wildcards (e.g. @*.txt@ - use 'getDirectoryFiles' to expand them),
--   environment variables (e.g. @$HOME@ - use 'getEnv' to expand them) or directories (directories cannot be
--   tracked directly - track files within the directory instead).
need :: Partial => [FilePath] -> Action ()
need :: [String] -> Action ()
need = (HasCallStack => [String] -> Action ()) -> [String] -> Action ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => [String] -> Action ()) -> [String] -> Action ())
-> (HasCallStack => [String] -> Action ()) -> [String] -> Action ()
forall a b. (a -> b) -> a -> b
$ Action [FileR] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [FileR] -> Action ())
-> ([String] -> Action [FileR]) -> [String] -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> FileName) -> [String] -> Action [FileR]
forall a. HasCallStack => (a -> FileName) -> [a] -> Action [FileR]
apply_ String -> FileName
fileNameFromString


-- | Like 'need' but returns a list of rebuilt dependencies since the calling rule last built successfully.
--
--   The following example writes a list of changed dependencies to a file as its action.
--
-- @
-- \"target\" '%>' \\out -> do
--       let sourceList = [\"source1\", \"source2\"]
--       rebuildList <- 'needHasChanged' sourceList
--       'Development.Shake.writeFileLines' out rebuildList
-- @
--
--   This function can be used to alter the action depending on which dependency needed
--   to be rebuild.
--
--   Note that a rule can be run even if no dependency has changed, for example
--   because of 'shakeRebuild' or because the target has changed or been deleted.
--   To detect the latter case you may wish to use 'resultHasChanged'.
needHasChanged :: Partial => [FilePath] -> Action [FilePath]
needHasChanged :: [String] -> Action [String]
needHasChanged [String]
paths = (HasCallStack => Action [String]) -> Action [String]
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Action [String]) -> Action [String])
-> (HasCallStack => Action [String]) -> Action [String]
forall a b. (a -> b) -> a -> b
$ do
    (String -> FileName) -> [String] -> Action [FileR]
forall a. HasCallStack => (a -> FileName) -> [a] -> Action [FileR]
apply_ String -> FileName
fileNameFromString [String]
paths
    Maybe Key
self <- Action (Maybe Key)
getCurrentKey
    Maybe (Result (Either ByteString Value))
selfVal <- case Maybe Key
self of
        Maybe Key
Nothing -> Maybe (Result (Either ByteString Value))
-> Action (Maybe (Result (Either ByteString Value)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Result (Either ByteString Value))
forall a. Maybe a
Nothing
        Just Key
self -> Key -> Action (Maybe (Result (Either ByteString Value)))
getDatabaseValueGeneric Key
self
    case Maybe (Result (Either ByteString Value))
selfVal of
        Maybe (Result (Either ByteString Value))
Nothing -> [String] -> Action [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
paths -- never build before or not a key, so everything has changed
        Just Result (Either ByteString Value)
selfVal -> ((String -> Action Bool) -> [String] -> Action [String])
-> [String] -> (String -> Action Bool) -> Action [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Action Bool) -> [String] -> Action [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [String]
paths ((String -> Action Bool) -> Action [String])
-> (String -> Action Bool) -> Action [String]
forall a b. (a -> b) -> a -> b
$ \String
path -> do
            Maybe (Result (Either ByteString FileR))
pathVal <- FileQ -> Action (Maybe (Result (Either ByteString FileR)))
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value) =>
key -> Action (Maybe (Result (Either ByteString value)))
getDatabaseValue (FileName -> FileQ
FileQ (FileName -> FileQ) -> FileName -> FileQ
forall a b. (a -> b) -> a -> b
$ String -> FileName
fileNameFromString String
path)
            Bool -> Action Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Action Bool) -> Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ case Maybe (Result (Either ByteString FileR))
pathVal of
                Just Result (Either ByteString FileR)
pathVal | Result (Either ByteString FileR) -> Step
forall a. Result a -> Step
changed Result (Either ByteString FileR)
pathVal Step -> Step -> Bool
forall a. Ord a => a -> a -> Bool
> Result (Either ByteString Value) -> Step
forall a. Result a -> Step
built Result (Either ByteString Value)
selfVal -> Bool
True
                Maybe (Result (Either ByteString FileR))
_ -> Bool
False


needBS :: Partial => [BS.ByteString] -> Action ()
needBS :: [ByteString] -> Action ()
needBS = (HasCallStack => [ByteString] -> Action ())
-> [ByteString] -> Action ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => [ByteString] -> Action ())
 -> [ByteString] -> Action ())
-> (HasCallStack => [ByteString] -> Action ())
-> [ByteString]
-> Action ()
forall a b. (a -> b) -> a -> b
$ Action [FileR] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [FileR] -> Action ())
-> ([ByteString] -> Action [FileR]) -> [ByteString] -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> FileName) -> [ByteString] -> Action [FileR]
forall a. HasCallStack => (a -> FileName) -> [a] -> Action [FileR]
apply_ ByteString -> FileName
fileNameFromByteString

-- | Like 'need', but if 'shakeLint' is set, check that the file does not rebuild.
--   Used for adding dependencies on files that have already been used in this rule.
needed :: Partial => [FilePath] -> Action ()
needed :: [String] -> Action ()
needed [String]
xs = (HasCallStack => Action ()) -> Action ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Action ()) -> Action ())
-> (HasCallStack => Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ do
    ShakeOptions
opts <- Action ShakeOptions
getShakeOptions
    if Maybe Lint -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Lint -> Bool) -> Maybe Lint -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
opts then HasCallStack => [String] -> Action ()
[String] -> Action ()
need [String]
xs else HasCallStack => [FileName] -> Action ()
[FileName] -> Action ()
neededCheck ([FileName] -> Action ()) -> [FileName] -> Action ()
forall a b. (a -> b) -> a -> b
$ (String -> FileName) -> [String] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map String -> FileName
fileNameFromString [String]
xs


neededBS :: Partial => [BS.ByteString] -> Action ()
neededBS :: [ByteString] -> Action ()
neededBS [ByteString]
xs = (HasCallStack => Action ()) -> Action ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Action ()) -> Action ())
-> (HasCallStack => Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ do
    ShakeOptions
opts <- Action ShakeOptions
getShakeOptions
    if Maybe Lint -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Lint -> Bool) -> Maybe Lint -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
opts then HasCallStack => [ByteString] -> Action ()
[ByteString] -> Action ()
needBS [ByteString]
xs else HasCallStack => [FileName] -> Action ()
[FileName] -> Action ()
neededCheck ([FileName] -> Action ()) -> [FileName] -> Action ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> FileName) -> [ByteString] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> FileName
fileNameFromByteString [ByteString]
xs


neededCheck :: Partial => [FileName] -> Action ()
neededCheck :: [FileName] -> Action ()
neededCheck [FileName]
xs = (HasCallStack => Action ()) -> Action ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Action ()) -> Action ())
-> (HasCallStack => Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ do
    ShakeOptions
opts <- Action ShakeOptions
getShakeOptions
    [Maybe FileA]
pre <- 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
$ (FileName -> IO (Maybe FileA)) -> [FileName] -> 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 -> IO (Maybe FileA))
-> (FileName -> FileQ) -> FileName -> IO (Maybe FileA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> FileQ
FileQ) [FileName]
xs
    [FileR]
post <- (FileName -> FileName) -> [FileName] -> Action [FileR]
forall a. HasCallStack => (a -> FileName) -> [a] -> Action [FileR]
apply_ FileName -> FileName
forall a. a -> a
id [FileName]
xs
    let bad :: [(FileName, String)]
bad = [ (FileName
x, if Maybe FileA -> Bool
forall a. Maybe a -> Bool
isJust Maybe FileA
a then String
"File change" else String
"File created")
              | (FileName
x, Maybe FileA
a, FileR (Just FileA
b) Bool
_) <- [FileName]
-> [Maybe FileA] -> [FileR] -> [(FileName, Maybe FileA, FileR)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [FileName]
xs [Maybe FileA]
pre [FileR]
post, EqualCost -> (FileA -> EqualCost) -> Maybe FileA -> EqualCost
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EqualCost
NotEqual (\FileA
a -> ShakeOptions -> FileA -> FileA -> EqualCost
fileEqualValue ShakeOptions
opts FileA
a FileA
b) Maybe FileA
a EqualCost -> EqualCost -> Bool
forall a. Eq a => a -> a -> Bool
== EqualCost
NotEqual]
    case [(FileName, String)]
bad of
        [] -> () -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (FileName
file,String
msg):[(FileName, String)]
_ -> SomeException -> Action ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> Action ()) -> SomeException -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
            String
"Lint checking error - 'needed' file required rebuilding"
            [(String
"File", String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FileName -> String
fileNameToString FileName
file)
            ,(String
"Error",String -> Maybe String
forall a. a -> Maybe a
Just String
msg)]
            String
""


-- Either trackRead or trackWrite
track :: ([FileQ] -> Action ()) -> [FilePath] -> Action ()
track :: ([FileQ] -> Action ()) -> [String] -> Action ()
track [FileQ] -> Action ()
tracker [String]
xs = do
    ShakeOptions{[String]
shakeLintIgnore :: [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintIgnore} <- Action ShakeOptions
getShakeOptions
    let ignore :: String -> Bool
ignore = [String] -> String -> Bool
(?==*) [String]
shakeLintIgnore
    let ys :: [String]
ys = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
ignore) [String]
xs
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
        [FileQ] -> Action ()
tracker ([FileQ] -> Action ()) -> [FileQ] -> Action ()
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


-- | Track that a file was read by the action preceding it. If 'shakeLint' is activated
--   then these files must be dependencies of this rule. Calls to 'trackRead' are
--   automatically inserted in 'LintFSATrace' mode.
trackRead :: [FilePath] -> Action ()
trackRead :: [String] -> Action ()
trackRead = ([FileQ] -> Action ()) -> [String] -> Action ()
track [FileQ] -> Action ()
forall key. ShakeValue key => [key] -> Action ()
lintTrackRead


-- | Track that a file was written by the action preceding it. If 'shakeLint' is activated
--   then these files must either be the target of this rule, or never referred to by the build system.
--   Calls to 'trackWrite' are automatically inserted in 'LintFSATrace' mode.
trackWrite :: [FilePath] -> Action ()
trackWrite :: [String] -> Action ()
trackWrite = ([FileQ] -> Action ()) -> [String] -> Action ()
track [FileQ] -> Action ()
forall key. ShakeValue key => [key] -> Action ()
lintTrackWrite

-- | Allow accessing a file in this rule, ignoring any subsequent 'trackRead' \/ 'trackWrite' calls matching
--   the pattern.
trackAllow :: [FilePattern] -> Action ()
trackAllow :: [String] -> Action ()
trackAllow [String]
ps = do
    let ignore :: String -> Bool
ignore = [String] -> String -> Bool
(?==*) [String]
ps
    (FileQ -> Bool) -> Action ()
forall key. ShakeValue key => (key -> Bool) -> Action ()
lintTrackAllow ((FileQ -> Bool) -> Action ()) -> (FileQ -> Bool) -> Action ()
forall a b. (a -> b) -> a -> b
$ \(FileQ FileName
x) -> String -> Bool
ignore (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ FileName -> String
fileNameToString FileName
x


-- | This rule builds the following files, in addition to any defined by its target.
--   At the end of the rule these files must have been written.
--   These files must /not/ be tracked as part of the build system - two rules cannot produce
--   the same file and you cannot 'need' the files it produces.
produces :: [FilePath] -> Action ()
produces :: [String] -> Action ()
produces [String]
xs = do
    [String] -> Action ()
producesChecked [String]
xs
    [String] -> Action ()
trackWrite [String]
xs


-- | Require that the argument files are built by the rules, used to specify the target.
--
-- @
-- main = 'Development.Shake.shake' 'shakeOptions' $ do
--    'want' [\"Main.exe\"]
--    ...
-- @
--
--   This program will build @Main.exe@, given sufficient rules. All arguments to all 'want' calls
--   may be built in parallel, in any order.
--
--   This function is defined in terms of 'action' and 'need', use 'action' if you need more complex
--   targets than 'want' allows.
want :: Partial => [FilePath] -> Rules ()
want :: [String] -> Rules ()
want [] = () -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
want [String]
xs = (HasCallStack => Rules ()) -> Rules ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Rules ()) -> Rules ())
-> (HasCallStack => Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ Action () -> Rules ()
forall a. HasCallStack => Action a -> Rules ()
action (Action () -> Rules ()) -> Action () -> Rules ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => [String] -> Action ()
[String] -> Action ()
need [String]
xs


root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
root :: String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root String
help String -> Bool
test String -> Action ()
act = FileRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (FileRule -> Rules ()) -> FileRule -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> Maybe Mode) -> FileRule
FileRule String
help ((String -> Maybe Mode) -> FileRule)
-> (String -> Maybe Mode) -> FileRule
forall a b. (a -> b) -> a -> b
$ \String
x -> if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
test String
x then Maybe Mode
forall a. Maybe a
Nothing else Mode -> Maybe Mode
forall a. a -> Maybe a
Just (Mode -> Maybe Mode) -> Mode -> Maybe Mode
forall a b. (a -> b) -> a -> b
$ Action () -> Mode
ModeDirect (Action () -> Mode) -> Action () -> Mode
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 ()
createDirectoryRecursive (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
x
    String -> Action ()
act String
x


-- | Declare a Make-style phony action.  A phony target does not name
--   a file (despite living in the same namespace as file rules);
--   rather, it names some action to be executed when explicitly
--   requested.  You can demand 'phony' rules using 'want'. (And 'need',
--   although that's not recommended.)
--
--   Phony actions are intended to define recipes that can be executed
--   by the user. If you 'need' a phony action in a rule then every
--   execution where that rule is required will rerun both the rule and
--   the phony action.  However, note that phony actions are never
--   executed more than once in a single build run.
--
--   In make, the @.PHONY@ attribute on non-file-producing rules has a
--   similar effect.  However, while in make it is acceptable to omit
--   the @.PHONY@ attribute as long as you don't create the file in
--   question, a Shake rule which behaves this way will fail lint.
--   For file-producing rules which should be
--   rerun every execution of Shake, see 'Development.Shake.alwaysRerun'.
phony :: Located => String -> Action () -> Rules ()
phony :: String -> Action () -> Rules ()
phony oname :: String
oname@(ShowS
toStandard -> String
name) Action ()
act = do
    String -> Rules ()
addTarget String
oname
    String -> (String -> Maybe (Action ())) -> Rules ()
addPhony (String
"phony " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
oname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop) ((String -> Maybe (Action ())) -> Rules ())
-> (String -> Maybe (Action ())) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \String
s -> if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name then Action () -> Maybe (Action ())
forall a. a -> Maybe a
Just Action ()
act else Maybe (Action ())
forall a. Maybe a
Nothing

-- | A predicate version of 'phony', return 'Just' with the 'Action' for the matching rules.
phonys :: Located => (String -> Maybe (Action ())) -> Rules ()
phonys :: (String -> Maybe (Action ())) -> Rules ()
phonys = String -> (String -> Maybe (Action ())) -> Rules ()
addPhony (String
"phonys at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop)

-- | Infix operator alias for 'phony', for sake of consistency with normal
--   rules.
(~>) :: Located => String -> Action () -> Rules ()
~> :: String -> Action () -> Rules ()
(~>) oname :: String
oname@(ShowS
toStandard -> String
name) Action ()
act = do
    String -> Rules ()
addTarget String
oname
    String -> (String -> Maybe (Action ())) -> Rules ()
addPhony (ShowS
forall a. Show a => a -> String
show String
oname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ~> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop) ((String -> Maybe (Action ())) -> Rules ())
-> (String -> Maybe (Action ())) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \String
s -> if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name then Action () -> Maybe (Action ())
forall a. a -> Maybe a
Just Action ()
act else Maybe (Action ())
forall a. Maybe a
Nothing

addPhony :: String -> (String -> Maybe (Action ())) -> Rules ()
addPhony :: String -> (String -> Maybe (Action ())) -> Rules ()
addPhony String
help String -> Maybe (Action ())
act = FileRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (FileRule -> Rules ()) -> FileRule -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> Maybe Mode) -> FileRule
FileRule String
help ((String -> Maybe Mode) -> FileRule)
-> (String -> Maybe Mode) -> FileRule
forall a b. (a -> b) -> a -> b
$ (Action () -> Mode) -> Maybe (Action ()) -> Maybe Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action () -> Mode
ModePhony (Maybe (Action ()) -> Maybe Mode)
-> (String -> Maybe (Action ())) -> String -> Maybe Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Action ())
act


-- | Define a rule to build files. If the first argument returns 'True' for a given file,
--   the second argument will be used to build it. Usually '%>' is sufficient, but '?>' gives
--   additional power. For any file used by the build system, only one rule should return 'True'.
--   This function will create the directory for the result file, if necessary.
--
-- @
-- (all isUpper . 'Development.Shake.FilePath.takeBaseName') '?>' \\out -> do
--     let src = 'Development.Shake.FilePath.replaceBaseName' out $ map toLower $ takeBaseName out
--     'Development.Shake.writeFile'' out . map toUpper =<< 'Development.Shake.readFile'' src
-- @
--
--   If the 'Action' completes successfully the file is considered up-to-date, even if the file
--   has not changed.
(?>) :: Located => (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
?> :: (String -> Bool) -> (String -> Action ()) -> Rules ()
(?>) String -> Bool
test String -> Action ()
act = Seconds -> Rules () -> Rules ()
forall a. Seconds -> Rules a -> Rules a
priority Seconds
0.5 (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root (String
"?> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop) String -> Bool
test String -> Action ()
act


-- | Define a set of patterns, and if any of them match, run the associated rule. Defined in terms of '%>'.
--   Think of it as the OR (@||@) equivalent of '%>'.
(|%>) :: Located => [FilePattern] -> (FilePath -> Action ()) -> Rules ()
|%> :: [String] -> (String -> Action ()) -> Rules ()
(|%>) [String]
pats String -> Action ()
act = 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]
pats
    let ([String]
simp,[String]
other) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
simple [String]
pats
    case ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
toStandard [String]
simp of
        [] -> () -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        [String
p] -> String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root String
help (\String
x -> ShowS
toStandard String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p) String -> Action ()
act
        [String]
ps -> let set :: HashSet String
set = [String] -> HashSet String
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [String]
ps in String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root String
help ((String -> HashSet String -> Bool)
-> HashSet String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> HashSet String -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member HashSet String
set (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
toStandard) String -> Action ()
act
    Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
other) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
        let ps :: [String -> Bool]
ps = (String -> String -> Bool) -> [String] -> [String -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map String -> String -> Bool
(?==) [String]
other in Seconds -> Rules () -> Rules ()
forall a. Seconds -> Rules a -> Rules a
priority Seconds
0.5 (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root String
help (\String
x -> ((String -> Bool) -> Bool) -> [String -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
x) [String -> Bool]
ps) String -> Action ()
act
    where help :: String
help = [String] -> String
forall a. Show a => a -> String
show [String]
pats String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" |%> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop

-- | Define a rule that matches a 'FilePattern', see '?==' for the pattern rules.
--   Patterns with no wildcards have higher priority than those with wildcards, and no file
--   required by the system may be matched by more than one pattern at the same priority
--   (see 'priority' and 'alternatives' to modify this behaviour).
--   This function will create the directory for the result file, if necessary.
--
-- @
-- \"*.asm.o\" '%>' \\out -> do
--     let src = 'Development.Shake.FilePath.dropExtension' out
--     'need' [src]
--     'Development.Shake.cmd' \"as\" [src] \"-o\" [out]
-- @
--
--   To define a build system for multiple compiled languages, we recommend using @.asm.o@,
--   @.cpp.o@, @.hs.o@, to indicate which language produces an object file.
--   I.e., the file @foo.cpp@ produces object file @foo.cpp.o@.
--
--   Note that matching is case-sensitive, even on Windows.
--
--   If the 'Action' completes successfully the file is considered up-to-date, even if the file
--   has not changed.
(%>) :: Located => FilePattern -> (FilePath -> Action ()) -> Rules ()
%> :: String -> (String -> Action ()) -> Rules ()
(%>) String
test String -> Action ()
act = (HasCallStack => Rules ()) -> Rules ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Rules ()) -> Rules ())
-> (HasCallStack => Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$
    (if String -> Bool
simple String
test then Rules () -> Rules ()
forall a. a -> a
id else Seconds -> Rules () -> Rules ()
forall a. Seconds -> Rules a -> Rules a
priority Seconds
0.5) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Rules ()
addTarget String
test
        String -> (String -> Bool) -> (String -> Action ()) -> Rules ()
root (ShowS
forall a. Show a => a -> String
show String
test String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" %> at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
HasCallStack => String
callStackTop) (String
test String -> String -> Bool
?==) String -> Action ()
act