{-# LANGUAGE RecordWildCards, NamedFieldPuns, ScopedTypeVariables, ConstraintKinds, TupleSections #-}

module Development.Shake.Internal.Core.Action(
    actionOnException, actionFinally, actionBracket, actionCatch, actionRetry,
    getShakeOptions, getProgress, runAfter,
    lintTrackRead, lintTrackWrite, lintTrackAllow,
    getVerbosity, putWhen, putVerbose, putInfo, putWarn, putError, withVerbosity, quietly,
    orderOnlyAction,
    newCacheIO,
    unsafeExtraThread,
    parallel,
    batch,
    reschedule,
    historyDisable,
    traced,
    -- Internal only
    producesChecked, producesUnchecked, producesCheck, lintCurrentDirectory, lintWatch,
    blockApply, unsafeAllowApply, shakeException, lintTrackFinished,
    getCurrentKey, getLocal,
    actionShareList, actionShareRemove, actionShareSanity
    ) where

import Control.Exception
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.DeepSeq
import Data.Typeable
import System.Directory
import System.FilePattern
import System.FilePattern.Directory
import System.Time.Extra
import Control.Concurrent.Extra
import Data.Maybe
import Data.Tuple.Extra
import Data.IORef.Extra
import Data.List.Extra
import Numeric.Extra
import General.Extra
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set

import Development.Shake.Classes
import Development.Shake.Internal.Core.Monad
import Development.Shake.Internal.Core.Database
import Development.Shake.Internal.History.Shared
import General.Pool
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Core.Pool
import Development.Shake.Internal.Value
import Development.Shake.Internal.FileInfo
import Development.Shake.Internal.FileName
import Development.Shake.Internal.Options
import Development.Shake.Internal.Errors
import General.Cleanup
import General.Fence


---------------------------------------------------------------------
-- RAW WRAPPERS

-- | Apply a modification, run an action, then run an undo action after.
--   Doesn't actually require exception handling because we don't have the ability to catch exceptions to the user.
actionThenUndoLocal :: (Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal :: (Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal Local -> (Local, Local -> Local)
f Action a
m = RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local a -> Action a)
-> RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a b. (a -> b) -> a -> b
$ do
    Local
s <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    let (Local
s2,Local -> Local
undo) = Local -> (Local, Local -> Local)
f Local
s
    Local -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
s2
    a
res <- Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
m
    (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW Local -> Local
undo
    a -> RAW ([String], [Key]) [Value] Global Local a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res


---------------------------------------------------------------------
-- EXCEPTION HANDLING

-- | Turn a normal exception into a ShakeException, giving it a stack and printing it out if in staunch mode.
--   If the exception is already a ShakeException (e.g. it's a child of ours who failed and we are rethrowing)
--   then do nothing with it.
shakeException :: Global -> Stack -> SomeException -> IO ShakeException
shakeException :: Global -> Stack -> SomeException -> IO ShakeException
shakeException Global{globalOptions :: Global -> ShakeOptions
globalOptions=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 ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [String]
shakeShare :: ShakeOptions -> Maybe String
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
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 ()
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
..},Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} Stack
stk SomeException
e = case SomeException -> Maybe ShakeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just (ShakeException
e :: ShakeException) -> ShakeException -> IO ShakeException
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeException
e
    Maybe ShakeException
Nothing -> do
        ShakeException
e<- ShakeException -> IO ShakeException
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShakeException -> IO ShakeException)
-> ShakeException -> IO ShakeException
forall a b. (a -> b) -> a -> b
$ Stack -> SomeException -> ShakeException
exceptionStack Stack
stk SomeException
e
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shakeStaunch Bool -> Bool -> Bool
&& Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Error) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Verbosity -> String -> IO ()
globalOutput Verbosity
Error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShakeException -> String
forall a. Show a => a -> String
show ShakeException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Continuing due to staunch mode"
        ShakeException -> IO ShakeException
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeException
e


actionBracketEx :: Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx :: Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx Bool
runOnSuccess IO a
alloc a -> IO b
free a -> Action c
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    (a
v, ReleaseKey
key) <- IO (a, ReleaseKey) -> Action (a, ReleaseKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, ReleaseKey) -> Action (a, ReleaseKey))
-> IO (a, ReleaseKey) -> Action (a, ReleaseKey)
forall a b. (a -> b) -> a -> b
$ IO (a, ReleaseKey) -> IO (a, ReleaseKey)
forall a. IO a -> IO a
mask_ (IO (a, ReleaseKey) -> IO (a, ReleaseKey))
-> IO (a, ReleaseKey) -> IO (a, ReleaseKey)
forall a b. (a -> b) -> a -> b
$ do
        a
v <- IO a
alloc
        ReleaseKey
key <- IO ReleaseKey -> IO ReleaseKey
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReleaseKey -> IO ReleaseKey) -> IO ReleaseKey -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$ Cleanup -> IO () -> IO ReleaseKey
register Cleanup
globalCleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$ IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> IO b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO b
free a
v
        (a, ReleaseKey) -> IO (a, ReleaseKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, ReleaseKey
key)
    c
res <- RAW ([String], [Key]) [Value] Global Local c -> Action c
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local c -> Action c)
-> RAW ([String], [Key]) [Value] Global Local c -> Action c
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local c
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local c)
-> RAW ([String], [Key]) [Value] Global Local c
forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW (Action c -> RAW ([String], [Key]) [Value] Global Local c
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action c -> RAW ([String], [Key]) [Value] Global Local c)
-> Action c -> RAW ([String], [Key]) [Value] Global Local c
forall a b. (a -> b) -> a -> b
$ a -> Action c
act a
v) ((SomeException -> RAW ([String], [Key]) [Value] Global Local c)
 -> RAW ([String], [Key]) [Value] Global Local c)
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local c)
-> RAW ([String], [Key]) [Value] Global Local c
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> IO () -> RAW ([String], [Key]) [Value] Global Local ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReleaseKey -> IO ()
release ReleaseKey
key) RAW ([String], [Key]) [Value] Global Local ()
-> RAW ([String], [Key]) [Value] Global Local c
-> RAW ([String], [Key]) [Value] Global Local c
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> RAW ([String], [Key]) [Value] Global Local c
forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ if Bool
runOnSuccess then ReleaseKey -> IO ()
release ReleaseKey
key else ReleaseKey -> IO ()
unprotect ReleaseKey
key
    c -> Action c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
res

-- | If an exception is raised by the 'Action', perform some 'IO' then reraise the exception.
actionOnException :: Action a -> IO b -> Action a
actionOnException :: Action a -> IO b -> Action a
actionOnException Action a
act IO b
free = Bool -> IO () -> (() -> IO b) -> (() -> Action a) -> Action a
forall a b c.
Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx Bool
False (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO b -> () -> IO b
forall a b. a -> b -> a
const IO b
free) (Action a -> () -> Action a
forall a b. a -> b -> a
const Action a
act)

-- | After an 'Action', perform some 'IO', even if there is an exception.
actionFinally :: Action a -> IO b -> Action a
actionFinally :: Action a -> IO b -> Action a
actionFinally Action a
act IO b
free = IO () -> (() -> IO b) -> (() -> Action a) -> Action a
forall a b c. IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO b -> () -> IO b
forall a b. a -> b -> a
const IO b
free) (Action a -> () -> Action a
forall a b. a -> b -> a
const Action a
act)

-- | Like `bracket`, but where the inner operation is of type 'Action'. Usually used as
--   @'actionBracket' alloc free use@.
actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket = Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
forall a b c.
Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx Bool
True


-- | If a syncronous exception is raised by the 'Action', perform some handler.
--   Note that there is no guarantee that the handler will run on shutdown (use 'actionFinally' for that),
--   and that 'actionCatch' /cannot/ catch exceptions thrown by dependencies, e.g. raised by 'need'
--   (to do so would allow untracked dependencies on failure conditions).
actionCatch :: Exception e => Action a -> (e -> Action a) -> Action a
actionCatch :: Action a -> (e -> Action a) -> Action a
actionCatch Action a
act e -> Action a
hdl = RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local a -> Action a)
-> RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local a
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local a)
-> RAW ([String], [Key]) [Value] Global Local a
forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW (Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act) ((SomeException -> RAW ([String], [Key]) [Value] Global Local a)
 -> RAW ([String], [Key]) [Value] Global Local a)
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local a)
-> RAW ([String], [Key]) [Value] Global Local a
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    case () of
        ()
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SomeException -> Bool
isAsyncException SomeException
e
          , Maybe ShakeException
Nothing <- SomeException -> Maybe ShakeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe ShakeException
          , Just e
e <- SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
          -> Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action a -> RAW ([String], [Key]) [Value] Global Local a)
-> Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a b. (a -> b) -> a -> b
$ e -> Action a
hdl e
e
        ()
_ -> SomeException -> RAW ([String], [Key]) [Value] Global Local a
forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e


-- | Retry an 'Action' if it throws an exception, at most /n/ times (where /n/ must be positive).
--   If you need to call this function, you should probably try and fix the underlying cause (but you also probably know that).
actionRetry :: Int -> Action a -> Action a
actionRetry :: Int -> Action a -> Action a
actionRetry Int
i Action a
act
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action a) -> String -> Action a
forall a b. (a -> b) -> a -> b
$ String
"actionRetry first argument must be positive, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Action a
act
    | Bool
otherwise = RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local a -> Action a)
-> RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local a
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local a)
-> RAW ([String], [Key]) [Value] Global Local a
forall k v ro rw a.
RAW k v ro rw a
-> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a
catchRAW (Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act) ((SomeException -> RAW ([String], [Key]) [Value] Global Local a)
 -> RAW ([String], [Key]) [Value] Global Local a)
-> (SomeException -> RAW ([String], [Key]) [Value] Global Local a)
-> RAW ([String], [Key]) [Value] Global Local a
forall a b. (a -> b) -> a -> b
$ \SomeException
_ -> Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action a -> RAW ([String], [Key]) [Value] Global Local a)
-> Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a b. (a -> b) -> a -> b
$ Int -> Action a -> Action a
forall a. Int -> Action a -> Action a
actionRetry (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Action a
act


---------------------------------------------------------------------
-- QUERIES

-- | Get the initial 'ShakeOptions', these will not change during the build process.
getShakeOptions :: Action ShakeOptions
getShakeOptions :: Action ShakeOptions
getShakeOptions = RAW ([String], [Key]) [Value] Global Local ShakeOptions
-> Action ShakeOptions
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local ShakeOptions
 -> Action ShakeOptions)
-> RAW ([String], [Key]) [Value] Global Local ShakeOptions
-> Action ShakeOptions
forall a b. (a -> b) -> a -> b
$ Global -> ShakeOptions
globalOptions (Global -> ShakeOptions)
-> RAW ([String], [Key]) [Value] Global Local Global
-> RAW ([String], [Key]) [Value] Global Local ShakeOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO


-- | Get the current 'Progress' structure, as would be returned by 'shakeProgress'.
getProgress :: Action Progress
getProgress :: Action Progress
getProgress = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    IO Progress -> Action Progress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Progress
globalProgress

-- | Specify an action to be run after the database has been closed, if building completes successfully.
runAfter :: IO () -> Action ()
runAfter :: IO () -> Action ()
runAfter IO ()
op = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [IO ()]
globalAfter (IO ()
opIO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)


---------------------------------------------------------------------
-- VERBOSITY

putWhen :: Verbosity -> String -> Action ()
putWhen :: Verbosity -> String -> Action ()
putWhen Verbosity
v String
msg = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Verbosity
verb <- Action Verbosity
getVerbosity
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
v) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO ()
globalOutput Verbosity
v String
msg


-- | Write an unimportant message to the output, only shown when 'shakeVerbosity' is higher than normal ('Verbose' or above).
--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).
putVerbose :: String -> Action ()
putVerbose :: String -> Action ()
putVerbose = Verbosity -> String -> Action ()
putWhen Verbosity
Verbose

-- | Write a normal priority message to the output, only suppressed when 'shakeVerbosity' is 'Error', 'Warn' or 'Silent'.
--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).
putInfo :: String -> Action ()
putInfo :: String -> Action ()
putInfo = Verbosity -> String -> Action ()
putWhen Verbosity
Info

-- | Write a semi important message to the output, only suppressed when 'shakeVerbosity' is 'Error' or 'Silent'.
--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).
putWarn :: String -> Action ()
putWarn :: String -> Action ()
putWarn = Verbosity -> String -> Action ()
putWhen Verbosity
Warn

-- | Write an important message to the output, only suppressed when 'shakeVerbosity' is 'Silent'.
--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).
putError :: String -> Action ()
putError :: String -> Action ()
putError = Verbosity -> String -> Action ()
putWhen Verbosity
Error


-- | Get the current verbosity level, originally set by 'shakeVerbosity'. If you
--   want to output information to the console, you are recommended to use
--   'putVerbose' \/ 'putInfo' \/ 'putError', which ensures multiple messages are
--   not interleaved. The verbosity can be modified locally by 'withVerbosity'.
getVerbosity :: Action Verbosity
getVerbosity :: Action Verbosity
getVerbosity = RAW ([String], [Key]) [Value] Global Local Verbosity
-> Action Verbosity
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local Verbosity
 -> Action Verbosity)
-> RAW ([String], [Key]) [Value] Global Local Verbosity
-> Action Verbosity
forall a b. (a -> b) -> a -> b
$ Local -> Verbosity
localVerbosity (Local -> Verbosity)
-> RAW ([String], [Key]) [Value] Global Local Local
-> RAW ([String], [Key]) [Value] Global Local Verbosity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW


-- | Run an action with a particular verbosity level.
--   Will not update the 'shakeVerbosity' returned by 'getShakeOptions' and will
--   not have any impact on 'Diagnostic' tracing.
withVerbosity :: Verbosity -> Action a -> Action a
withVerbosity :: Verbosity -> Action a -> Action a
withVerbosity Verbosity
new = (Local -> (Local, Local -> Local)) -> Action a -> Action a
forall a.
(Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal ((Local -> (Local, Local -> Local)) -> Action a -> Action a)
-> (Local -> (Local, Local -> Local)) -> Action a -> Action a
forall a b. (a -> b) -> a -> b
$ \Local
s0 ->
    (Local
s0{localVerbosity :: Verbosity
localVerbosity=Verbosity
new}, \Local
s -> Local
s{localVerbosity :: Verbosity
localVerbosity=Local -> Verbosity
localVerbosity Local
s0})


-- | Run an action with 'Error' verbosity, in particular messages produced by 'traced'
--   (including from 'Development.Shake.cmd' or 'Development.Shake.command') will not be printed to the screen.
--   Will not update the 'shakeVerbosity' returned by 'getShakeOptions' and will
--   not turn off any 'Diagnostic' tracing.
quietly :: Action a -> Action a
quietly :: Action a -> Action a
quietly = Verbosity -> Action a -> Action a
forall a. Verbosity -> Action a -> Action a
withVerbosity Verbosity
Error


---------------------------------------------------------------------
-- BLOCK APPLY

unsafeAllowApply :: Action a -> Action a
unsafeAllowApply :: Action a -> Action a
unsafeAllowApply  = Maybe String -> Action a -> Action a
forall a. Maybe String -> Action a -> Action a
applyBlockedBy Maybe String
forall a. Maybe a
Nothing

blockApply :: String -> Action a -> Action a
blockApply :: String -> Action a -> Action a
blockApply = Maybe String -> Action a -> Action a
forall a. Maybe String -> Action a -> Action a
applyBlockedBy (Maybe String -> Action a -> Action a)
-> (String -> Maybe String) -> String -> Action a -> Action a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

applyBlockedBy :: Maybe String -> Action a -> Action a
applyBlockedBy :: Maybe String -> Action a -> Action a
applyBlockedBy Maybe String
reason = (Local -> (Local, Local -> Local)) -> Action a -> Action a
forall a.
(Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal ((Local -> (Local, Local -> Local)) -> Action a -> Action a)
-> (Local -> (Local, Local -> Local)) -> Action a -> Action a
forall a b. (a -> b) -> a -> b
$ \Local
s0 ->
    (Local
s0{localBlockApply :: Maybe String
localBlockApply=Maybe String
reason}, \Local
s -> Local
s{localBlockApply :: Maybe String
localBlockApply=Local -> Maybe String
localBlockApply Local
s0})


---------------------------------------------------------------------
-- TRACING

-- | Write an action to the trace list, along with the start/end time of running the IO action.
--   The 'Development.Shake.cmd' and 'Development.Shake.command' functions automatically call 'traced'
--   with the name of the executable. The trace list is used for profile reports (see 'shakeReport').
--
--   By default 'traced' prints some useful extra context about what
--   Shake is building, e.g.:
--
-- > # traced message (for myobject.o)
--
--   To suppress the output of 'traced' (for example you want more control
--   over the message using 'putInfo'), use the 'quietly' combinator.
--
--   It is recommended that the string passed to 'traced' is short and that only a small number of unique strings
--   are used (makes profiling work better).
--   The string does not need to make sense on its own, only in conjunction with the target it is building.
traced :: String -> IO a -> Action a
traced :: String -> IO a -> Action a
traced String
msg IO a
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Local -> Stack
localStack :: Stack
localStack} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    Seconds
start <- IO Seconds -> Action Seconds
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
globalTimestamp
    let key :: String
key = Stack -> String
showTopStack Stack
localStack
    String -> Action ()
putInfo (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    a
res <- IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Action a) -> IO a -> Action a
forall a b. (a -> b) -> a -> b
$
        (ShakeOptions -> String -> String -> Bool -> IO ()
shakeTrace ShakeOptions
globalOptions String
key String
msg Bool
True IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
act)
            IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` ShakeOptions -> String -> String -> Bool -> IO ()
shakeTrace ShakeOptions
globalOptions String
key String
msg Bool
False
    Seconds
stop <- IO Seconds -> Action Seconds
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
globalTimestamp
    let trace :: Trace
trace = String -> Seconds -> Seconds -> Trace
newTrace String
msg Seconds
start Seconds
stop
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Trace -> ()
forall a. NFData a => a -> ()
rnf Trace
trace
    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localTraces :: Traces
localTraces = Traces -> Trace -> Traces
addTrace (Local -> Traces
localTraces Local
s) Trace
trace}
    a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res


---------------------------------------------------------------------
-- TRACKING

-- | Track that a key has been used/read by the action preceding it when 'shakeLint' is active.
lintTrackRead :: ShakeValue key => [key] -> Action ()
-- One of the following must be true:
-- 1) you are the one building this key (e.g. key == topStack)
-- 2) you have already been used by apply, and are on the dependency list
-- 3) someone explicitly gave you permission with trackAllow
-- 4) at the end of the rule, a) you are now on the dependency list, and b) this key itself has no dependencies (is source file)
lintTrackRead :: [key] -> Action ()
lintTrackRead [key]
ks = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Lint -> Bool) -> Maybe Lint -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
        l :: Local
l@Local{Bool
Seconds
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localDiscount :: Local -> Seconds
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Seconds
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
        [Key]
deps <- IO [Key] -> Action [Key]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Key] -> Action [Key]) -> IO [Key] -> Action [Key]
forall a b. (a -> b) -> a -> b
$ (Depends -> IO [Key]) -> [Depends] -> IO [Key]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Database -> Depends -> IO [Key]
listDepends Database
globalDatabase) ([Depends] -> IO [Key]) -> [Depends] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends]
enumerateDepends DependsList
localDepends
        let top :: Maybe Key
top = Stack -> Maybe Key
topStack Stack
localStack

        let condition1 :: Key -> Bool
condition1 Key
k = Maybe Key
top Maybe Key -> Maybe Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k
        let condition2 :: Key -> Bool
condition2 Key
k = Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
deps
        let condition3 :: Key -> Bool
condition3 Key
k = ((Key -> Bool) -> Bool) -> [Key -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Key -> Bool) -> Key -> Bool
forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows
        let condition4 :: [Key]
condition4 = (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Bool
condition1 Key
k Bool -> Bool -> Bool
|| Key -> Bool
condition2 Key
k Bool -> Bool -> Bool
|| Key -> Bool
condition3 Key
k) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ (key -> Key) -> [key] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map key -> Key
forall a. ShakeValue a => a -> Key
newKey [key]
ks
        Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
condition4) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
            RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ Local -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
l{localTrackRead :: [Key]
localTrackRead = [Key]
condition4 [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ [Key]
localTrackRead}


-- | Track that a key has been changed/written by the action preceding it when 'shakeLint' is active.
lintTrackWrite :: ShakeValue key => [key] -> Action ()
-- One of the following must be true:
-- 1) you are the one building this key (e.g. key == topStack)
-- 2) someone explicitly gave you permission with trackAllow
-- 3) this file is never known to the build system, at the end it is not in the database
lintTrackWrite :: [key] -> Action ()
lintTrackWrite [key]
ks = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Lint -> Bool) -> Maybe Lint -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
        l :: Local
l@Local{Bool
Seconds
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Seconds
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localDiscount :: Local -> Seconds
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
        let top :: Maybe Key
top = Stack -> Maybe Key
topStack Stack
localStack

        let condition1 :: Key -> Bool
condition1 Key
k = Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k Maybe Key -> Maybe Key -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Key
top
        let condition2 :: Key -> Bool
condition2 Key
k = ((Key -> Bool) -> Bool) -> [Key -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Key -> Bool) -> Key -> Bool
forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows
        let condition3 :: [Key]
condition3 = (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Bool
condition1 Key
k Bool -> Bool -> Bool
|| Key -> Bool
condition2 Key
k) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ (key -> Key) -> [key] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map key -> Key
forall a. ShakeValue a => a -> Key
newKey [key]
ks
        Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
condition3) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
            RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ Local -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
l{localTrackWrite :: [Key]
localTrackWrite = [Key]
condition3 [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ [Key]
localTrackWrite}


lintTrackFinished :: Action ()
lintTrackFinished :: Action ()
lintTrackFinished = do
    -- only called when isJust shakeLint
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Bool
Seconds
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Seconds
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localDiscount :: Local -> Seconds
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
        let top :: Maybe Key
top = Stack -> Maybe Key
topStack Stack
localStack
        -- must apply the ignore at the end, because we might have merged in more ignores that
        -- apply to other branches
        let ignore :: Key -> Bool
ignore Key
k = ((Key -> Bool) -> Bool) -> [Key -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Key -> Bool) -> Key -> Bool
forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows

        -- Read stuff
        [Key]
deps <- (Depends -> IO [Key]) -> [Depends] -> IO [Key]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Database -> Depends -> IO [Key]
listDepends Database
globalDatabase) ([Depends] -> IO [Key]) -> [Depends] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends]
enumerateDepends DependsList
localDepends
        let used :: HashSet Key
used = (Key -> Bool) -> HashSet Key -> HashSet Key
forall a. (a -> Bool) -> HashSet a -> HashSet a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Bool
ignore) (HashSet Key -> HashSet Key) -> HashSet Key -> HashSet Key
forall a b. (a -> b) -> a -> b
$ [Key] -> HashSet Key
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [Key]
localTrackRead

        -- check Read 4a
        [Key]
bad<- [Key] -> IO [Key]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Key] -> IO [Key]) -> [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ HashSet Key -> [Key]
forall a. HashSet a -> [a]
Set.toList (HashSet Key -> [Key]) -> HashSet Key -> [Key]
forall a b. (a -> b) -> a -> b
$ HashSet Key
used HashSet Key -> HashSet Key -> HashSet Key
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`Set.difference` [Key] -> HashSet Key
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [Key]
deps
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
bad) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let n :: Int
n = [Key] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Key]
bad
            SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
                (String
"Lint checking error - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"value was" else Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values were") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" used but not depended upon")
                [(String
"Used", String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Key -> String
forall a. Show a => a -> String
show Key
x) | Key
x <- [Key]
bad]
                String
""

        -- check Read 4b
        [Key]
bad <- ((Key -> IO Bool) -> [Key] -> IO [Key])
-> [Key] -> (Key -> IO Bool) -> IO [Key]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Key -> IO Bool) -> [Key] -> IO [Key]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (HashSet Key -> [Key]
forall a. HashSet a -> [a]
Set.toList HashSet Key
used) ((Key -> IO Bool) -> IO [Key]) -> (Key -> IO Bool) -> IO [Key]
forall a b. (a -> b) -> a -> b
$ \Key
k -> Bool -> Bool
not (Bool -> Bool) -> ([Depends] -> Bool) -> [Depends] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Depends] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Depends] -> Bool) -> IO [Depends] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> Key -> IO [Depends]
lookupDependencies Database
globalDatabase Key
k
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
bad) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let n :: Int
n = [Key] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Key]
bad
            SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
                (String
"Lint checking error - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"value was" else Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values were") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" depended upon after being used")
                [(String
"Used", String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Key -> String
forall a. Show a => a -> String
show Key
x) | Key
x <- [Key]
bad]
                String
""

        -- check Write 3
        [Key]
bad<- [Key] -> IO [Key]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Key] -> IO [Key]) -> [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Bool
ignore) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ HashSet Key -> [Key]
forall a. HashSet a -> [a]
Set.toList (HashSet Key -> [Key]) -> HashSet Key -> [Key]
forall a b. (a -> b) -> a -> b
$ [Key] -> HashSet Key
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [Key]
localTrackWrite
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
bad) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [(Key, Key)] -> ([(Key, Key)] -> [(Key, Key)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [(Key, Key)]
globalTrackAbsent ([(Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe Key
k Maybe Key
top, Key
k) | Key
k <- [Key]
bad] [(Key, Key)] -> [(Key, Key)] -> [(Key, Key)]
forall a. [a] -> [a] -> [a]
++)


-- | Allow any matching key recorded with 'lintTrackRead' or 'lintTrackWrite' in this action,
--   after this call, to violate the tracking rules.
lintTrackAllow :: ShakeValue key => (key -> Bool) -> Action ()
lintTrackAllow :: (key -> Bool) -> Action ()
lintTrackAllow (key -> Bool
test :: key -> Bool) = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Lint -> Bool) -> Maybe Lint -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
        RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localTrackAllows :: [Key -> Bool]
localTrackAllows = Key -> Bool
f (Key -> Bool) -> [Key -> Bool] -> [Key -> Bool]
forall a. a -> [a] -> [a]
: Local -> [Key -> Bool]
localTrackAllows Local
s}
    where
        tk :: TypeRep
tk = Proxy key -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key)
        f :: Key -> Bool
f Key
k = Key -> TypeRep
typeKey Key
k TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
tk Bool -> Bool -> Bool
&& key -> Bool
test (Key -> key
forall a. Typeable a => Key -> a
fromKey Key
k)


lintCurrentDirectory :: FilePath -> String -> IO ()
lintCurrentDirectory :: String -> String -> IO ()
lintCurrentDirectory String
old String
msg = do
    String
now <- IO String
getCurrentDirectory
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
old String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
now) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
        String
"Lint checking error - current directory has changed"
        [(String
"When", String -> Maybe String
forall a. a -> Maybe a
Just String
msg)
        ,(String
"Wanted",String -> Maybe String
forall a. a -> Maybe a
Just String
old)
        ,(String
"Got",String -> Maybe String
forall a. a -> Maybe a
Just String
now)]
        String
""

lintWatch :: [FilePattern] -> IO (String -> IO ())
lintWatch :: [String] -> IO (String -> IO ())
lintWatch [] = (String -> IO ()) -> IO (String -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> IO ()) -> IO (String -> IO ()))
-> (String -> IO ()) -> IO (String -> IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> String -> IO ()) -> IO () -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
lintWatch [String]
pats = do
    let op :: IO [String]
op = String -> [String] -> IO [String]
getDirectoryFiles String
"." [String]
pats -- cache parsing of the pats
    let record :: IO [(String, Maybe (ModTime, FileSize))]
record = do [String]
xs <- IO [String]
op; [String]
-> (String -> IO (String, Maybe (ModTime, FileSize)))
-> IO [(String, Maybe (ModTime, FileSize))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
xs ((String -> IO (String, Maybe (ModTime, FileSize)))
 -> IO [(String, Maybe (ModTime, FileSize))])
-> (String -> IO (String, Maybe (ModTime, FileSize)))
-> IO [(String, Maybe (ModTime, FileSize))]
forall a b. (a -> b) -> a -> b
$ \String
x -> (String
x,) (Maybe (ModTime, FileSize) -> (String, Maybe (ModTime, FileSize)))
-> IO (Maybe (ModTime, FileSize))
-> IO (String, Maybe (ModTime, FileSize))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> FileName -> IO (Maybe (ModTime, FileSize))
getFileInfo Bool
False (String -> FileName
fileNameFromString String
x)
    [(String, Maybe (ModTime, FileSize))]
old <- IO [(String, Maybe (ModTime, FileSize))]
record
    (String -> IO ()) -> IO (String -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> IO ()) -> IO (String -> IO ()))
-> (String -> IO ()) -> IO (String -> IO ())
forall a b. (a -> b) -> a -> b
$ \String
msg -> do
        [(String, Maybe (ModTime, FileSize))]
now <- IO [(String, Maybe (ModTime, FileSize))]
record
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(String, Maybe (ModTime, FileSize))]
old [(String, Maybe (ModTime, FileSize))]
-> [(String, Maybe (ModTime, FileSize))] -> Bool
forall a. Eq a => a -> a -> Bool
/= [(String, Maybe (ModTime, FileSize))]
now) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
            String
"Lint checking error - watched files have changed"
            ((String
"When", String -> Maybe String
forall a. a -> Maybe a
Just String
msg) (String, Maybe String)
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. a -> [a] -> [a]
: HashMap String (Maybe (ModTime, FileSize))
-> HashMap String (Maybe (ModTime, FileSize))
-> [(String, Maybe String)]
forall a a.
(Hashable a, Eq a, Eq a) =>
HashMap a a -> HashMap a a -> [(String, Maybe a)]
changes ([(String, Maybe (ModTime, FileSize))]
-> HashMap String (Maybe (ModTime, FileSize))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(String, Maybe (ModTime, FileSize))]
old) ([(String, Maybe (ModTime, FileSize))]
-> HashMap String (Maybe (ModTime, FileSize))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(String, Maybe (ModTime, FileSize))]
now))
            String
""
    where
        changes :: HashMap a a -> HashMap a a -> [(String, Maybe a)]
changes HashMap a a
old HashMap a a
now =
            [(String
"Created", a -> Maybe a
forall a. a -> Maybe a
Just a
x) | a
x <- HashMap a a -> [a]
forall k v. HashMap k v -> [k]
Map.keys (HashMap a a -> [a]) -> HashMap a a -> [a]
forall a b. (a -> b) -> a -> b
$ HashMap a a -> HashMap a a -> HashMap a a
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
Map.difference HashMap a a
now HashMap a a
old] [(String, Maybe a)] -> [(String, Maybe a)] -> [(String, Maybe a)]
forall a. [a] -> [a] -> [a]
++
            [(String
"Deleted", a -> Maybe a
forall a. a -> Maybe a
Just a
x) | a
x <- HashMap a a -> [a]
forall k v. HashMap k v -> [k]
Map.keys (HashMap a a -> [a]) -> HashMap a a -> [a]
forall a b. (a -> b) -> a -> b
$ HashMap a a -> HashMap a a -> HashMap a a
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
Map.difference HashMap a a
old HashMap a a
now] [(String, Maybe a)] -> [(String, Maybe a)] -> [(String, Maybe a)]
forall a. [a] -> [a] -> [a]
++
            [(String
"Changed", a -> Maybe a
forall a. a -> Maybe a
Just a
x) | a
x <- HashMap a Bool -> [a]
forall k v. HashMap k v -> [k]
Map.keys (HashMap a Bool -> [a]) -> HashMap a Bool -> [a]
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> HashMap a Bool -> HashMap a Bool
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter Bool -> Bool
forall a. a -> a
id (HashMap a Bool -> HashMap a Bool)
-> HashMap a Bool -> HashMap a Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> HashMap a a -> HashMap a a -> HashMap a Bool
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
Map.intersectionWith a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) HashMap a a
old HashMap a a
now]


listDepends :: Database -> Depends -> IO [Key]
listDepends :: Database -> Depends -> IO [Key]
listDepends Database
db (Depends [Id]
xs) = (Id -> IO Key) -> [Id] -> IO [Key]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe (Key, Status) -> Key) -> IO (Maybe (Key, Status)) -> IO Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key, Status) -> Key
forall a b. (a, b) -> a
fst ((Key, Status) -> Key)
-> (Maybe (Key, Status) -> (Key, Status))
-> Maybe (Key, Status)
-> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Key, Status) -> (Key, Status)
forall a. HasCallStack => Maybe a -> a
fromJust) (IO (Maybe (Key, Status)) -> IO Key)
-> (Id -> IO (Maybe (Key, Status))) -> Id -> IO Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
db) [Id]
xs


lookupDependencies :: Database -> Key -> IO [Depends]
lookupDependencies :: Database -> Key -> IO [Depends]
lookupDependencies Database
db Key
k = do
    Just (Ready Result (Value, OneShot BS_Store)
r) <- Database -> Key -> IO (Maybe Status)
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> IO (Maybe v)
getValueFromKey Database
db Key
k
    [Depends] -> IO [Depends]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Depends] -> IO [Depends]) -> [Depends] -> IO [Depends]
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store) -> [Depends]
forall a. Result a -> [Depends]
depends Result (Value, OneShot BS_Store)
r


-- | This rule should not be cached or recorded in the history because it makes use of untracked dependencies
--   (e.g. files in a system directory or items on the @$PATH@), or is trivial to compute locally.
historyDisable :: Action ()
historyDisable :: Action ()
historyDisable = RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localHistory :: Bool
localHistory = Bool
False}


-- | A version of 'produces' that checks the files actually exist
producesChecked :: [FilePath] -> Action ()
producesChecked :: [String] -> Action ()
producesChecked [String]
xs = RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localProduces :: [(Bool, String)]
localProduces = (String -> (Bool, String)) -> [String] -> [(Bool, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
True,) ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
xs) [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ Local -> [(Bool, String)]
localProduces Local
s}

-- | A version of 'produces' that does not check.
producesUnchecked :: [FilePath] -> Action ()
producesUnchecked :: [String] -> Action ()
producesUnchecked [String]
xs = RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localProduces :: [(Bool, String)]
localProduces = (String -> (Bool, String)) -> [String] -> [(Bool, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False,) ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
xs) [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ Local -> [(Bool, String)]
localProduces Local
s}

producesCheck :: Action ()
producesCheck :: Action ()
producesCheck = do
    Local{[(Bool, String)]
localProduces :: [(Bool, String)]
localProduces :: Local -> [(Bool, String)]
localProduces} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    [String]
missing <- IO [String] -> Action [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Action [String]) -> IO [String] -> Action [String]
forall a b. (a -> b) -> a -> b
$ (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> IO Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist_) ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, String) -> String
forall a b. (a, b) -> b
snd ([(Bool, String)] -> [String]) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Bool, String) -> Bool) -> [(Bool, String)] -> [(Bool, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, String) -> Bool
forall a b. (a, b) -> a
fst [(Bool, String)]
localProduces
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
missing [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ 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
"Files declared by 'produces' not produced"
        [(String
"File " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i, String -> Maybe String
forall a. a -> Maybe a
Just String
x) | (Integer
i,String
x) <- Integer -> [String] -> [(Integer, String)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [String]
missing]
        String
""


-- | Run an action but do not depend on anything the action uses.
--   A more general version of 'orderOnly'.
orderOnlyAction :: Action a -> Action a
orderOnlyAction :: Action a -> Action a
orderOnlyAction Action a
act = RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local a -> Action a)
-> RAW ([String], [Key]) [Value] Global Local a -> Action a
forall a b. (a -> b) -> a -> b
$ do
    Local{localDepends :: Local -> DependsList
localDepends=DependsList
pre} <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    a
res <- Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act
    (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends=DependsList
pre}
    a -> RAW ([String], [Key]) [Value] Global Local a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res


---------------------------------------------------------------------
-- MORE COMPLEX

-- | A version of 'Development.Shake.newCache' that runs in IO, and can be called before calling 'Development.Shake.shake'.
--   Most people should use 'Development.Shake.newCache' instead.
newCacheIO :: (Eq k, Hashable k) => (k -> Action v) -> IO (k -> Action v)
newCacheIO :: (k -> Action v) -> IO (k -> Action v)
newCacheIO (k -> Action v
act :: k -> Action v) = do
    Var (HashMap k (Fence IO (Either SomeException (DependsList, v))))
var :: Var (Map.HashMap k (Fence IO (Either SomeException (DependsList,v)))) <- HashMap k (Fence IO (Either SomeException (DependsList, v)))
-> IO
     (Var
        (HashMap k (Fence IO (Either SomeException (DependsList, v)))))
forall a. a -> IO (Var a)
newVar HashMap k (Fence IO (Either SomeException (DependsList, v)))
forall k v. HashMap k v
Map.empty
    (k -> Action v) -> IO (k -> Action v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((k -> Action v) -> IO (k -> Action v))
-> (k -> Action v) -> IO (k -> Action v)
forall a b. (a -> b) -> a -> b
$ \k
key ->
        Action (Action v) -> Action v
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Action (Action v) -> Action v) -> Action (Action v) -> Action v
forall a b. (a -> b) -> a -> b
$ IO (Action v) -> Action (Action v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Action v) -> Action (Action v))
-> IO (Action v) -> Action (Action v)
forall a b. (a -> b) -> a -> b
$ Var (HashMap k (Fence IO (Either SomeException (DependsList, v))))
-> (HashMap k (Fence IO (Either SomeException (DependsList, v)))
    -> IO
         (HashMap k (Fence IO (Either SomeException (DependsList, v))),
          Action v))
-> IO (Action v)
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (HashMap k (Fence IO (Either SomeException (DependsList, v))))
var ((HashMap k (Fence IO (Either SomeException (DependsList, v)))
  -> IO
       (HashMap k (Fence IO (Either SomeException (DependsList, v))),
        Action v))
 -> IO (Action v))
-> (HashMap k (Fence IO (Either SomeException (DependsList, v)))
    -> IO
         (HashMap k (Fence IO (Either SomeException (DependsList, v))),
          Action v))
-> IO (Action v)
forall a b. (a -> b) -> a -> b
$ \HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp -> case k
-> HashMap k (Fence IO (Either SomeException (DependsList, v)))
-> Maybe (Fence IO (Either SomeException (DependsList, v)))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup k
key HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp of
            Just Fence IO (Either SomeException (DependsList, v))
bar -> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
 Action v)
-> IO
     (HashMap k (Fence IO (Either SomeException (DependsList, v))),
      Action v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HashMap k (Fence IO (Either SomeException (DependsList, v))),
  Action v)
 -> IO
      (HashMap k (Fence IO (Either SomeException (DependsList, v))),
       Action v))
-> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
    Action v)
-> IO
     (HashMap k (Fence IO (Either SomeException (DependsList, v))),
      Action v)
forall a b. (a -> b) -> a -> b
$ (,) HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp (Action v
 -> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
     Action v))
-> Action v
-> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
    Action v)
forall a b. (a -> b) -> a -> b
$ do
                (Seconds
offset, (DependsList
deps, v
v)) <- Fence IO (Either SomeException (DependsList, v))
-> Action (Seconds, (DependsList, v))
forall b. Fence IO (Either SomeException b) -> Action (Seconds, b)
actionFenceRequeue Fence IO (Either SomeException (DependsList, v))
bar
                RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Seconds -> Local -> Local
addDiscount Seconds
offset (Local -> Local) -> Local -> Local
forall a b. (a -> b) -> a -> b
$ Local
s{localDepends :: DependsList
localDepends = DependsList -> DependsList -> DependsList
addDepends (Local -> DependsList
localDepends Local
s) DependsList
deps}
                v -> Action v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
            Maybe (Fence IO (Either SomeException (DependsList, v)))
Nothing -> do
                Fence IO (Either SomeException (DependsList, v))
bar <- IO (Fence IO (Either SomeException (DependsList, v)))
forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
                (HashMap k (Fence IO (Either SomeException (DependsList, v))),
 Action v)
-> IO
     (HashMap k (Fence IO (Either SomeException (DependsList, v))),
      Action v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HashMap k (Fence IO (Either SomeException (DependsList, v))),
  Action v)
 -> IO
      (HashMap k (Fence IO (Either SomeException (DependsList, v))),
       Action v))
-> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
    Action v)
-> IO
     (HashMap k (Fence IO (Either SomeException (DependsList, v))),
      Action v)
forall a b. (a -> b) -> a -> b
$ (k
-> Fence IO (Either SomeException (DependsList, v))
-> HashMap k (Fence IO (Either SomeException (DependsList, v)))
-> HashMap k (Fence IO (Either SomeException (DependsList, v)))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert k
key Fence IO (Either SomeException (DependsList, v))
bar HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp,) (Action v
 -> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
     Action v))
-> Action v
-> (HashMap k (Fence IO (Either SomeException (DependsList, v))),
    Action v)
forall a b. (a -> b) -> a -> b
$ do
                    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = [Depends] -> DependsList
newDepends []}
                    Either SomeException v
res <- RAW ([String], [Key]) [Value] Global Local (Either SomeException v)
-> Action (Either SomeException v)
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key]) [Value] Global Local (Either SomeException v)
 -> Action (Either SomeException v))
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException v)
-> Action (Either SomeException v)
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local v
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException v)
forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW (RAW ([String], [Key]) [Value] Global Local v
 -> RAW
      ([String], [Key]) [Value] Global Local (Either SomeException v))
-> RAW ([String], [Key]) [Value] Global Local v
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException v)
forall a b. (a -> b) -> a -> b
$ Action v -> RAW ([String], [Key]) [Value] Global Local v
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action v -> RAW ([String], [Key]) [Value] Global Local v)
-> Action v -> RAW ([String], [Key]) [Value] Global Local v
forall a b. (a -> b) -> a -> b
$ k -> Action v
act k
key
                    case Either SomeException v
res of
                        Left SomeException
err -> do
                            IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Fence IO (Either SomeException (DependsList, v))
-> Either SomeException (DependsList, v) -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Fence IO (Either SomeException (DependsList, v))
bar (Either SomeException (DependsList, v) -> IO ())
-> Either SomeException (DependsList, v) -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException (DependsList, v)
forall a b. a -> Either a b
Left SomeException
err
                            RAW ([String], [Key]) [Value] Global Local v -> Action v
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local v -> Action v)
-> RAW ([String], [Key]) [Value] Global Local v -> Action v
forall a b. (a -> b) -> a -> b
$ SomeException -> RAW ([String], [Key]) [Value] Global Local v
forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
err
                        Right v
v -> do
                            Local{localDepends :: Local -> DependsList
localDepends=DependsList
deps} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
                            IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Fence IO (Either SomeException (DependsList, v))
-> Either SomeException (DependsList, v) -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Fence IO (Either SomeException (DependsList, v))
bar (Either SomeException (DependsList, v) -> IO ())
-> Either SomeException (DependsList, v) -> IO ()
forall a b. (a -> b) -> a -> b
$ (DependsList, v) -> Either SomeException (DependsList, v)
forall a b. b -> Either a b
Right (DependsList
deps, v
v)
                            v -> Action v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v


-- | Run an action without counting to the thread limit, typically used for actions that execute
--   on remote machines using barely any local CPU resources.
--   Unsafe as it allows the 'shakeThreads' limit to be exceeded.
--   You cannot depend on a rule (e.g. 'need') while the extra thread is executing.
--   If the rule blocks (e.g. calls 'withResource') then the extra thread may be used by some other action.
--   Only really suitable for calling 'cmd' / 'command'.
unsafeExtraThread :: Action a -> Action a
unsafeExtraThread :: Action a -> Action a
unsafeExtraThread Action a
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    IO ()
stop <- IO (IO ()) -> Action (IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> Action (IO ())) -> IO (IO ()) -> Action (IO ())
forall a b. (a -> b) -> a -> b
$ Pool -> IO (IO ())
increasePool Pool
globalPool
    Either SomeException a
res <- RAW ([String], [Key]) [Value] Global Local (Either SomeException a)
-> Action (Either SomeException a)
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key]) [Value] Global Local (Either SomeException a)
 -> Action (Either SomeException a))
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException a)
-> Action (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local a
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException a)
forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW (RAW ([String], [Key]) [Value] Global Local a
 -> RAW
      ([String], [Key]) [Value] Global Local (Either SomeException a))
-> RAW ([String], [Key]) [Value] Global Local a
-> RAW
     ([String], [Key]) [Value] Global Local (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action a -> RAW ([String], [Key]) [Value] Global Local a)
-> Action a -> RAW ([String], [Key]) [Value] Global Local a
forall a b. (a -> b) -> a -> b
$ String -> Action a -> Action a
forall a. String -> Action a -> Action a
blockApply String
"Within unsafeExtraThread" Action a
act
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
stop
    -- we start a new thread, giving up ours, to ensure the thread count goes down
    (Seconds
wait, a
res) <- Either SomeException a -> Action (Seconds, a)
forall a. Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeue Either SomeException a
res
    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ Seconds -> Local -> Local
addDiscount Seconds
wait
    a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res


-- | Execute a list of actions in parallel. In most cases 'need' will be more appropriate to benefit from parallelism.
parallel :: [Action a] -> Action [a]
-- Note: There is no parallel_ unlike sequence_ because there is no stack benefit to doing so
parallel :: [Action a] -> Action [a]
parallel [] = [a] -> Action [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parallel [Action a
x] = a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [a]) -> Action a -> Action [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action a
x
parallel [Action a]
acts = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO

    IORef Bool
done <- IO (IORef Bool) -> Action (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Action (IORef Bool))
-> IO (IORef Bool) -> Action (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    [Fence IO (Either SomeException (Seconds, (Local, a)))]
waits <- [Action a]
-> (Action a
    -> Action (Fence IO (Either SomeException (Seconds, (Local, a)))))
-> Action [Fence IO (Either SomeException (Seconds, (Local, a)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Action a]
acts ((Action a
  -> Action (Fence IO (Either SomeException (Seconds, (Local, a)))))
 -> Action [Fence IO (Either SomeException (Seconds, (Local, a)))])
-> (Action a
    -> Action (Fence IO (Either SomeException (Seconds, (Local, a)))))
-> Action [Fence IO (Either SomeException (Seconds, (Local, a)))]
forall a b. (a -> b) -> a -> b
$ \Action a
act ->
        PoolPriority
-> Action (Local, a)
-> Action (Fence IO (Either SomeException (Seconds, (Local, a))))
forall a.
PoolPriority
-> Action a
-> Action (Fence IO (Either SomeException (Seconds, a)))
addPoolWait PoolPriority
PoolResume (Action (Local, a)
 -> Action (Fence IO (Either SomeException (Seconds, (Local, a)))))
-> Action (Local, a)
-> Action (Fence IO (Either SomeException (Seconds, (Local, a))))
forall a b. (a -> b) -> a -> b
$ do
            Action Bool -> Action () -> Action ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> Action Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Action Bool) -> IO Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
done) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
                String -> Action ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parallel, one has already failed"
            RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW Local -> Local
localClearMutable
            a
res <- Action a
act
            Local
old <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
            (Local, a) -> Action (Local, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Local
old, a
res)
    (Seconds
wait, [(Seconds, (Local, a))]
res) <- Fence IO (Either SomeException [(Seconds, (Local, a))])
-> Action (Seconds, [(Seconds, (Local, a))])
forall b. Fence IO (Either SomeException b) -> Action (Seconds, b)
actionFenceSteal (Fence IO (Either SomeException [(Seconds, (Local, a))])
 -> Action (Seconds, [(Seconds, (Local, a))]))
-> Action (Fence IO (Either SomeException [(Seconds, (Local, a))]))
-> Action (Seconds, [(Seconds, (Local, a))])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Fence IO (Either SomeException [(Seconds, (Local, a))]))
-> Action (Fence IO (Either SomeException [(Seconds, (Local, a))]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Fence IO (Either SomeException (Seconds, (Local, a)))]
-> IO (Fence IO (Either SomeException [(Seconds, (Local, a))]))
forall (m :: * -> *) e r.
MonadIO m =>
[Fence m (Either e r)] -> m (Fence m (Either e [r]))
exceptFence [Fence IO (Either SomeException (Seconds, (Local, a)))]
waits)
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Bool
done Bool
True
    let ([Seconds]
waits, [Local]
locals, [a]
results) = [(Seconds, Local, a)] -> ([Seconds], [Local], [a])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Seconds, Local, a)] -> ([Seconds], [Local], [a]))
-> [(Seconds, Local, a)] -> ([Seconds], [Local], [a])
forall a b. (a -> b) -> a -> b
$ ((Seconds, (Local, a)) -> (Seconds, Local, a))
-> [(Seconds, (Local, a))] -> [(Seconds, Local, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Seconds
a,(Local
b,a
c)) -> (Seconds
a,Local
b,a
c)) [(Seconds, (Local, a))]
res
    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
root -> Seconds -> Local -> Local
addDiscount (Seconds
wait Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- [Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Seconds]
waits) (Local -> Local) -> Local -> Local
forall a b. (a -> b) -> a -> b
$ Local -> [Local] -> Local
localMergeMutable Local
root [Local]
locals
    [a] -> Action [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
results


-- | Batch different outputs into a single 'Action', typically useful when a command has a high
--   startup cost - e.g. @apt-get install foo bar baz@ is a lot cheaper than three separate
--   calls to @apt-get install@. As an example, if we have a standard build rule:
--
-- @
-- \"*.out\" 'Development.Shake.%>' \\out -> do
--     'Development.Shake.need' [out '-<.>' \"in\"]
--     'Development.Shake.cmd' "build-multiple" [out '-<.>' \"in\"]
-- @
--
--   Assuming that @build-multiple@ can compile multiple files in a single run,
--   and that the cost of doing so is a lot less than running each individually,
--   we can write:
--
-- @
-- 'batch' 3 (\"*.out\" 'Development.Shake.%>')
--     (\\out -> do 'Development.Shake.need' [out '-<.>' \"in\"]; pure out)
--     (\\outs -> 'Development.Shake.cmd' "build-multiple" [out '-<.>' \"in\" | out \<- outs])
-- @
--
--   In constrast to the normal call, we have specified a maximum batch size of 3,
--   an action to run on each output individually (typically all the 'need' dependencies),
--   and an action that runs on multiple files at once. If we were to require lots of
--   @*.out@ files, they would typically be built in batches of 3.
--
--   If Shake ever has nothing else to do it will run batches before they are at the maximum,
--   so you may see much smaller batches, especially at high parallelism settings.
batch
    :: Int   -- ^ Maximum number to run in a single batch, e.g. @3@, must be positive.
    -> ((a -> Action ()) -> Rules ()) -- ^ Way to match an entry, e.g. @\"*.ext\" '%>'@.
    -> (a -> Action b)  -- ^ Preparation to run individually on each, e.g. using 'need'.
    -> ([b] -> Action ())  -- ^ Combination action to run on all, e.g. using 'cmd'.
    -> Rules ()
batch :: Int
-> ((a -> Action ()) -> Rules ())
-> (a -> Action b)
-> ([b] -> Action ())
-> Rules ()
batch Int
mx (a -> Action ()) -> Rules ()
pred a -> Action b
one [b] -> Action ()
many
    | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Rules ()
forall a. HasCallStack => String -> a
error (String -> Rules ()) -> String -> Rules ()
forall a b. (a -> b) -> a -> b
$ String
"Can't call batchable with <= 0, you used " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mx
    | Int
mx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (a -> Action ()) -> Rules ()
pred ((a -> Action ()) -> Rules ()) -> (a -> Action ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do b
b <- a -> Action b
one a
a; [b] -> Action ()
many [b
b]
    | Bool
otherwise = do
        IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo :: IORef (Int, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]) <- IO
  (IORef
     (Int,
      [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
-> Rules
     (IORef
        (Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IORef
      (Int,
       [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
 -> Rules
      (IORef
         (Int,
          [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])))
-> IO
     (IORef
        (Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
-> Rules
     (IORef
        (Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
forall a b. (a -> b) -> a -> b
$ (Int,
 [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> IO
     (IORef
        (Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]))
forall a. a -> IO (IORef a)
newIORef (Int
0, [])
        (a -> Action ()) -> Rules ()
pred ((a -> Action ()) -> Rules ()) -> (a -> Action ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
            b
b <- a -> Action b
one a
a
            Fence IO (Either SomeException (Seconds, Local))
fence <- IO (Fence IO (Either SomeException (Seconds, Local)))
-> Action (Fence IO (Either SomeException (Seconds, Local)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Fence IO (Either SomeException (Seconds, Local)))
forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
            -- add one to the batch
            Local
local <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
            Int
count <- IO Int -> Action Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Action Int) -> IO Int -> Action Int
forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> ((Int,
     [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
    -> ((Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
        Int))
-> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo (((Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
  -> ((Int,
       [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
      Int))
 -> IO Int)
-> ((Int,
     [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
    -> ((Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
        Int))
-> IO Int
forall a b. (a -> b) -> a -> b
$ \(Int
count, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
bs) -> let i :: Int
i = Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in ((Int
i, (b
b,Local
local,Fence IO (Either SomeException (Seconds, Local))
fence)(b, Local, Fence IO (Either SomeException (Seconds, Local)))
-> [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
forall a. a -> [a] -> [a]
:[(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
bs), Int
i)
            IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> (Int -> Int -> Bool) -> Int -> Action ()
requeue IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int
count
            (Seconds
wait, (Seconds
cost, Local
local2)) <- Fence IO (Either SomeException (Seconds, Local))
-> Action (Seconds, (Seconds, Local))
forall b. Fence IO (Either SomeException b) -> Action (Seconds, b)
actionFenceRequeue Fence IO (Either SomeException (Seconds, Local))
fence
            RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
root -> Seconds -> Local -> Local
addDiscount (Seconds
wait Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
cost) (Local -> Local) -> Local -> Local
forall a b. (a -> b) -> a -> b
$ Local -> [Local] -> Local
localMergeMutable Local
root [Local
local2]
    where
        -- When changing by one, only trigger on (==) so we don't have lots of waiting pool entries
        -- When changing by many, trigger on (>=) because we don't hit all edges
        requeue :: IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> (Int -> Int -> Bool) -> Int -> Action ()
requeue IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo Int -> Int -> Bool
trigger Int
count
            | Int
count Int -> Int -> Bool
`trigger` Int
mx = PoolPriority -> Action () -> Action ()
forall a. PoolPriority -> Action a -> Action ()
addPoolWait_ PoolPriority
PoolResume (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> Action ()
go IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo
            | Int
count Int -> Int -> Bool
`trigger` Int
1  = PoolPriority -> Action () -> Action ()
forall a. PoolPriority -> Action a -> Action ()
addPoolWait_ PoolPriority
PoolBatch  (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> Action ()
go IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo
            | Bool
otherwise = () -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        go :: IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> Action ()
go IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo = do
            -- delete at most mx from the batch
            ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now, Int
count) <- IO
  ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
   Int)
-> Action
     ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
      Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
    Int)
 -> Action
      ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
       Int))
-> IO
     ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
      Int)
-> Action
     ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
      Int)
forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> ((Int,
     [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
    -> ((Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
        ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
         Int)))
-> IO
     ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
      Int)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo (((Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
  -> ((Int,
       [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
      ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
       Int)))
 -> IO
      ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
       Int))
-> ((Int,
     [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
    -> ((Int,
         [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]),
        ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
         Int)))
-> IO
     ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
      Int)
forall a b. (a -> b) -> a -> b
$ \(Int
count, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
bs) ->
                let ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now,[(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
later) = Int
-> [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))],
    [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
mx [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
bs
                    count2 :: Int
count2 = if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx then Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mx else Int
0
                in ((Int
count2, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
later), ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now, Int
count2))
            IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
-> (Int -> Int -> Bool) -> Int -> Action ()
requeue IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Seconds, Local)))])
todo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Int
count

            Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
                Either SomeException (Seconds, Local)
res <- RAW
  ([String], [Key])
  [Value]
  Global
  Local
  (Either SomeException (Seconds, Local))
-> Action (Either SomeException (Seconds, Local))
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key])
   [Value]
   Global
   Local
   (Either SomeException (Seconds, Local))
 -> Action (Either SomeException (Seconds, Local)))
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Either SomeException (Seconds, Local))
-> Action (Either SomeException (Seconds, Local))
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local (Seconds, Local)
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Either SomeException (Seconds, Local))
forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW (RAW ([String], [Key]) [Value] Global Local (Seconds, Local)
 -> RAW
      ([String], [Key])
      [Value]
      Global
      Local
      (Either SomeException (Seconds, Local)))
-> RAW ([String], [Key]) [Value] Global Local (Seconds, Local)
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Either SomeException (Seconds, Local))
forall a b. (a -> b) -> a -> b
$ do
                    -- make sure we are using one of the local's that we are computing
                    -- we things like stack, blockApply etc. work as expected
                    (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ Local -> Local -> Local
forall a b. a -> b -> a
const (Local -> Local -> Local) -> Local -> Local -> Local
forall a b. (a -> b) -> a -> b
$ Local -> Local
localClearMutable (Local -> Local) -> Local -> Local
forall a b. (a -> b) -> a -> b
$ (b, Local, Fence IO (Either SomeException (Seconds, Local)))
-> Local
forall a b c. (a, b, c) -> b
snd3 ((b, Local, Fence IO (Either SomeException (Seconds, Local)))
 -> Local)
-> (b, Local, Fence IO (Either SomeException (Seconds, Local)))
-> Local
forall a b. (a -> b) -> a -> b
$ [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> (b, Local, Fence IO (Either SomeException (Seconds, Local)))
forall a. [a] -> a
head [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now
                    IO Seconds
start <- IO (IO Seconds)
-> RAW ([String], [Key]) [Value] Global Local (IO Seconds)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime
                    Action () -> RAW ([String], [Key]) [Value] Global Local ()
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action () -> RAW ([String], [Key]) [Value] Global Local ())
-> Action () -> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ [b] -> Action ()
many ([b] -> Action ()) -> [b] -> Action ()
forall a b. (a -> b) -> a -> b
$ ((b, Local, Fence IO (Either SomeException (Seconds, Local))) -> b)
-> [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, Local, Fence IO (Either SomeException (Seconds, Local))) -> b
forall a b c. (a, b, c) -> a
fst3 [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now
                    Seconds
end <- IO Seconds -> RAW ([String], [Key]) [Value] Global Local Seconds
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
start

                    -- accounting for time is tricky, we spend time T, over N jobs
                    -- so want to charge everyone for T / N time
                    -- but that also means we need to subtract localDiscount so we don't apply that to all
                    Local
rw <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
                    let t :: Seconds
t = Seconds
end Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Local -> Seconds
localDiscount Local
rw
                    let n :: Seconds
n = Int -> Seconds
intToDouble ([(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now)
                    (Seconds, Local)
-> RAW ([String], [Key]) [Value] Global Local (Seconds, Local)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seconds
t Seconds -> Seconds -> Seconds
forall a. Fractional a => a -> a -> a
/ Seconds
n, Local
rw{localDiscount :: Seconds
localDiscount = Seconds
0})
                IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ ((b, Local, Fence IO (Either SomeException (Seconds, Local)))
 -> IO ())
-> [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Fence IO (Either SomeException (Seconds, Local))
 -> Either SomeException (Seconds, Local) -> IO ())
-> Either SomeException (Seconds, Local)
-> Fence IO (Either SomeException (Seconds, Local))
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fence IO (Either SomeException (Seconds, Local))
-> Either SomeException (Seconds, Local) -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Either SomeException (Seconds, Local)
res (Fence IO (Either SomeException (Seconds, Local)) -> IO ())
-> ((b, Local, Fence IO (Either SomeException (Seconds, Local)))
    -> Fence IO (Either SomeException (Seconds, Local)))
-> (b, Local, Fence IO (Either SomeException (Seconds, Local)))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Local, Fence IO (Either SomeException (Seconds, Local)))
-> Fence IO (Either SomeException (Seconds, Local))
forall a b c. (a, b, c) -> c
thd3) [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]
now


-- | Given a running task, reschedule so it only continues after all other pending tasks,
--   and all rescheduled tasks with a higher pool priority. Note that due to parallelism there is no guarantee
--   that all actions of a higher pool priority will have /completed/ before the action resumes.
--   Only useful if the results are being interactively reported or consumed.
reschedule :: Double -> Action ()
reschedule :: Seconds -> Action ()
reschedule Seconds
x = do
    (Seconds
wait, ()
_) <- PoolPriority -> Either SomeException () -> Action (Seconds, ())
forall a.
PoolPriority -> Either SomeException a -> Action (Seconds, a)
actionAlwaysRequeuePriority (Seconds -> PoolPriority
PoolDeprioritize (Seconds -> PoolPriority) -> Seconds -> PoolPriority
forall a b. (a -> b) -> a -> b
$ Seconds -> Seconds
forall a. Num a => a -> a
negate Seconds
x) (Either SomeException () -> Action (Seconds, ()))
-> Either SomeException () -> Action (Seconds, ())
forall a b. (a -> b) -> a -> b
$ () -> Either SomeException ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ Seconds -> Local -> Local
addDiscount Seconds
wait


getCurrentKey :: Action (Maybe Key)
getCurrentKey :: Action (Maybe Key)
getCurrentKey = RAW ([String], [Key]) [Value] Global Local (Maybe Key)
-> Action (Maybe Key)
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local (Maybe Key)
 -> Action (Maybe Key))
-> RAW ([String], [Key]) [Value] Global Local (Maybe Key)
-> Action (Maybe Key)
forall a b. (a -> b) -> a -> b
$ Stack -> Maybe Key
topStack (Stack -> Maybe Key) -> (Local -> Stack) -> Local -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local -> Stack
localStack (Local -> Maybe Key)
-> RAW ([String], [Key]) [Value] Global Local Local
-> RAW ([String], [Key]) [Value] Global Local (Maybe Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW

getLocal :: Action Local
getLocal :: Action Local
getLocal = RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW

-- | Hooked up to --share-remove
actionShareRemove :: [String] -> Action ()
actionShareRemove :: [String] -> Action ()
actionShareRemove [String]
substrs = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> SomeException -> Action ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> Action ()) -> SomeException -> Action ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> SomeException
String -> SomeException
errorInternal String
"actionShareRemove with no shared"
        Just Shared
x -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Shared -> (Key -> Bool) -> IO ()
removeShared Shared
x ((Key -> Bool) -> IO ()) -> (Key -> Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Key
k -> (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Key -> String
forall a. Show a => a -> String
show Key
k) [String]
substrs

-- | Hooked up to --share-list
actionShareList :: Action ()
actionShareList :: Action ()
actionShareList = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> SomeException -> Action ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> Action ()) -> SomeException -> Action ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> SomeException
String -> SomeException
errorInternal String
"actionShareList with no shared"
        Just Shared
x -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Shared -> IO ()
listShared Shared
x

-- | Hooked up to --share-sanity
actionShareSanity :: Action ()
actionShareSanity :: Action ()
actionShareSanity = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> SomeException -> Action ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> Action ()) -> SomeException -> Action ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> SomeException
String -> SomeException
errorInternal String
"actionShareSanity with no shared"
        Just Shared
x -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Shared -> IO ()
sanityShared Shared
x