{-# 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 :: forall a.
(Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal Local -> (Local, Local -> Local)
f Action a
m = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ do
    Local
s <- 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
    forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
s2
    a
res <- forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
m
    forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW Local -> Local
undo
    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 Double
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeAllowRedefineRules :: ShakeOptions -> Bool
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 Double
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintInside :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [String]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> String
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: String -> String -> Bool -> IO ()
shakeOutput :: Verbosity -> String -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeAllowRedefineRules :: Bool
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [String]
shakeShare :: Maybe String
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [String]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(String, String)]
shakeRebuild :: [(Rebuild, String)]
shakeFlush :: Maybe Double
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 Double
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 Double
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 Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} Stack
stk SomeException
e = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just (ShakeException
e :: ShakeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeException
e
    Maybe ShakeException
Nothing -> do
        ShakeException
e<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Stack -> SomeException -> ShakeException
exceptionStack Stack
stk SomeException
e
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shakeStaunch Bool -> Bool -> Bool
&& Verbosity
shakeVerbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
Error) forall a b. (a -> b) -> a -> b
$
            Verbosity -> String -> IO ()
globalOutput Verbosity
Error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ShakeException
e forall a. [a] -> [a] -> [a]
++ String
"Continuing due to staunch mode"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ShakeException
e


actionBracketEx :: Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx :: forall a b c.
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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    (a
v, ReleaseKey
key) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
        a
v <- IO a
alloc
        ReleaseKey
key <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Cleanup -> IO () -> IO ReleaseKey
register Cleanup
globalCleanup forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ a -> IO b
free a
v
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, ReleaseKey
key)
    c
res <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ 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 (forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ a -> Action c
act a
v) forall a b. (a -> b) -> a -> b
$ \SomeException
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReleaseKey -> IO ()
release ReleaseKey
key) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e k v ro rw a. Exception e => e -> RAW k v ro rw a
throwRAW SomeException
e
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
runOnSuccess then ReleaseKey -> IO ()
release ReleaseKey
key else ReleaseKey -> IO ()
unprotect ReleaseKey
key
    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.
--   This function is implemented using 'actionBracket'.
actionOnException :: Action a -> IO b -> Action a
actionOnException :: forall a b. Action a -> IO b -> Action a
actionOnException Action a
act IO b
free = forall a b c.
Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracketEx Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const IO b
free) (forall a b. a -> b -> a
const Action a
act)

-- | After an 'Action', perform some 'IO', even if there is an exception.
--   This function is implemented using 'actionBracket'.
actionFinally :: Action a -> IO b -> Action a
actionFinally :: forall a b. Action a -> IO b -> Action a
actionFinally Action a
act IO b
free = forall a b c. IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const IO b
free) (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@.
--
--   The @free@ action will be run masked. The cost of 'actionBracket' is _O(n log n)_
--   in the number of simultaneous 'actionBracket' calls active in the program.
actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket :: forall a b c. IO a -> (a -> IO b) -> (a -> Action c) -> Action c
actionBracket = 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 :: forall e a. Exception e => Action a -> (e -> Action a) -> Action a
actionCatch Action a
act e -> Action a
hdl = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ 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 (forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act) forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    case () of
        ()
_ | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ SomeException -> Bool
isAsyncException SomeException
e
          , Maybe ShakeException
Nothing <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe ShakeException
          , Just e
e <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
          -> forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ e -> Action a
hdl e
e
        ()
_ -> 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 :: forall a. Int -> Action a -> Action a
actionRetry Int
i Action a
act
    | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"actionRetry first argument must be positive, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
    | Int
i forall a. Eq a => a -> a -> Bool
== Int
1 = Action a
act
    | Bool
otherwise = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ 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 (forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act) forall a b. (a -> b) -> a -> b
$ \SomeException
_ -> forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ forall a. Int -> Action a -> Action a
actionRetry (Int
iforall 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 = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ Global -> ShakeOptions
globalOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [IO ()]
globalAfter (IO ()
opforall 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Verbosity
verb <- Action Verbosity
getVerbosity
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb forall a. Ord a => a -> a -> Bool
>= Verbosity
v) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ Local -> Verbosity
localVerbosity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall a. Verbosity -> Action a -> Action a
withVerbosity Verbosity
new = forall a.
(Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal 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 :: forall a. Action a -> Action a
quietly = forall a. Verbosity -> Action a -> Action a
withVerbosity Verbosity
Error


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

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

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

applyBlockedBy :: Maybe String -> Action a -> Action a
applyBlockedBy :: forall a. Maybe String -> Action a -> Action a
applyBlockedBy Maybe String
reason = forall a.
(Local -> (Local, Local -> Local)) -> Action a -> Action a
actionThenUndoLocal 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 :: forall a. String -> IO a -> Action a
traced String
msg IO a
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Local -> Stack
localStack :: Stack
localStack} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    Double
start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
globalTimestamp
    let key :: String
key = Stack -> String
showTopStack Stack
localStack
    String -> Action ()
putInfo forall a b. (a -> b) -> a -> b
$ String
"# " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
" (for " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
")"
    a
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        (ShakeOptions -> String -> String -> Bool -> IO ()
shakeTrace ShakeOptions
globalOptions String
key String
msg Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
act)
            forall a b. IO a -> IO b -> IO a
`finally` ShakeOptions -> String -> String -> Bool -> IO ()
shakeTrace ShakeOptions
globalOptions String
key String
msg Bool
False
    Double
stop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
globalTimestamp
    let trace :: Trace
trace = String -> Double -> Double -> Trace
newTrace String
msg Double
start Double
stop
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> ()
rnf Trace
trace
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW 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}
    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 :: forall key. ShakeValue key => [key] -> Action ()
lintTrackRead [key]
ks = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) forall a b. (a -> b) -> a -> b
$ do
        l :: Local
l@Local{Bool
Double
[(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 -> Double
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Double
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
        [Key]
deps <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Database -> Depends -> IO [Key]
listDepends Database
globalDatabase) 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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Key
k
        let condition2 :: Key -> Bool
condition2 Key
k = Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
deps
        let condition3 :: Key -> Bool
condition3 Key
k = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows
        let condition4 :: [Key]
condition4 = forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Bool -> Bool
not 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) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ShakeValue a => a -> Key
newKey [key]
ks
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
condition4) forall a b. (a -> b) -> a -> b
$
            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
l{localTrackRead :: [Key]
localTrackRead = [Key]
condition4 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 :: forall key. ShakeValue key => [key] -> Action ()
lintTrackWrite [key]
ks = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) forall a b. (a -> b) -> a -> b
$ do
        l :: Local
l@Local{Bool
Double
[(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 :: Double
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 -> Double
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action 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 = forall a. a -> Maybe a
Just Key
k forall a. Eq a => a -> a -> Bool
== Maybe Key
top
        let condition2 :: Key -> Bool
condition2 Key
k = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows
        let condition3 :: [Key]
condition3 = forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Key -> Bool
condition1 Key
k Bool -> Bool -> Bool
|| Key -> Bool
condition2 Key
k) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ShakeValue a => a -> Key
newKey [key]
ks
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
condition3) forall a b. (a -> b) -> a -> b
$
            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. rw -> RAW k v ro rw ()
putRW Local
l{localTrackWrite :: [Key]
localTrackWrite = [Key]
condition3 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Bool
Double
[(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 :: Double
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 -> Double
localDepends :: Local -> DependsList
localBuiltinVersion :: Local -> Ver
localTraces :: Local -> Traces
localStack :: Local -> Stack
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Key
k) [Key -> Bool]
localTrackAllows

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

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

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

        -- check Write 3
        [Key]
bad<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Bool
ignore) forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [Key]
localTrackWrite
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
bad) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [(Key, Key)]
globalTrackAbsent ([(forall a. a -> Maybe a -> a
fromMaybe Key
k Maybe Key
top, Key
k) | Key
k <- [Key]
bad] 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 :: forall key. ShakeValue key => (key -> Bool) -> Action ()
lintTrackAllow (key -> Bool
test :: key -> Bool) = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ShakeOptions -> Maybe Lint
shakeLint ShakeOptions
globalOptions) forall a b. (a -> b) -> a -> b
$
        forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localTrackAllows :: [Key -> Bool]
localTrackAllows = Key -> Bool
f forall a. a -> [a] -> [a]
: Local -> [Key -> Bool]
localTrackAllows Local
s}
    where
        tk :: TypeRep
tk = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy key)
        f :: Key -> Bool
f Key
k = Key -> TypeRep
typeKey Key
k forall a. Eq a => a -> a -> Bool
== TypeRep
tk Bool -> Bool -> Bool
&& key -> Bool
test (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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
old forall a. Eq a => a -> a -> Bool
/= String
now) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
        String
"Lint checking error - current directory has changed"
        [(String
"When", forall a. a -> Maybe a
Just String
msg)
        ,(String
"Wanted",forall a. a -> Maybe a
Just String
old)
        ,(String
"Got",forall a. a -> Maybe a
Just String
now)]
        String
""

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


listDepends :: Database -> Depends -> IO [Key]
listDepends :: Database -> Depends -> IO [Key]
listDepends Database
db (Depends [Id]
xs) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Partial => Maybe a -> a
fromJust) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) <- forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> IO (Maybe v)
getValueFromKey Database
db Key
k
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Result a -> [Depends]
depends Result (Value, OneShot BS_Store)
r


-- | This rule should not be saved to shared/cloud storage via 'shakeShare'.
--   There are usually two reasons to call this function:
--
--   1. It makes use of untracked dependencies that are specific to this machine,
--      e.g. files in a system directory or items on the @$PATH@.
--   2. The rule is trivial to compute locally, so there is no point sharing it.
--
--   If you want the rule to not be cached at all, use 'alwaysRerun'.
historyDisable :: Action ()
historyDisable :: Action ()
historyDisable = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW 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 = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localProduces :: [(Bool, String)]
localProduces = forall a b. (a -> b) -> [a] -> [b]
map (Bool
True,) (forall a. [a] -> [a]
reverse [String]
xs) 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 = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localProduces :: [(Bool, String)]
localProduces = forall a b. (a -> b) -> [a] -> [b]
map (Bool
False,) (forall a. [a] -> [a]
reverse [String]
xs) 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} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    [String]
missing <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *). Functor m => m Bool -> m Bool
notM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist_) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> a
fst [(Bool, String)]
localProduces
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
missing forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
        String
"Files declared by 'produces' not produced"
        [(String
"File " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i, forall a. a -> Maybe a
Just String
x) | (Integer
i,String
x) <- 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 :: forall a. Action a -> Action a
orderOnlyAction Action a
act = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ do
    Local{localDepends :: Local -> DependsList
localDepends=DependsList
pre} <- forall k v ro rw. RAW k v ro rw rw
getRW
    a
res <- forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction Action a
act
    forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends=DependsList
pre}
    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 :: forall k v.
(Eq k, Hashable k) =>
(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)))) <- forall a. a -> IO (Var a)
newVar forall k v. HashMap k v
Map.empty
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \k
key ->
        forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (HashMap k (Fence IO (Either SomeException (DependsList, v))))
var forall a b. (a -> b) -> a -> b
$ \HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp -> case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (,) HashMap k (Fence IO (Either SomeException (DependsList, v)))
mp forall a b. (a -> b) -> a -> b
$ do
                (Double
offset, (DependsList
deps, v
v)) <- forall b. Fence IO (Either SomeException b) -> Action (Double, b)
actionFenceRequeue Fence IO (Either SomeException (DependsList, v))
bar
                forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Double -> Local -> Local
addDiscount Double
offset forall a b. (a -> b) -> a -> b
$ Local
s{localDepends :: DependsList
localDepends = DependsList -> DependsList -> DependsList
addDepends (Local -> DependsList
localDepends Local
s) DependsList
deps}
                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 <- forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (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,) forall a b. (a -> b) -> a -> b
$ do
                    Local{localDepends :: Local -> DependsList
localDepends=DependsList
pre} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
                    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = [Depends] -> DependsList
newDepends []}
                    Either SomeException v
res <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW forall a b. (a -> b) -> a -> b
$ forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ k -> Action v
act k
key
                    case Either SomeException v
res of
                        Left SomeException
err -> do
                            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Partial, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Fence IO (Either SomeException (DependsList, v))
bar forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
err
                            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ 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} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
                            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = DependsList -> DependsList -> DependsList
addDepends DependsList
pre DependsList
deps}
                            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Partial, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Fence IO (Either SomeException (DependsList, v))
bar forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (DependsList
deps, v
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 :: forall a. Action a -> Action a
unsafeExtraThread Action a
act = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    IO ()
stop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Pool -> IO (IO ())
increasePool Pool
globalPool
    Either SomeException a
res <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW forall a b. (a -> b) -> a -> b
$ forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ forall a. String -> Action a -> Action a
blockApply String
"Within unsafeExtraThread" Action a
act
    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
    (Double
wait, a
res) <- forall a. Either SomeException a -> Action (Double, a)
actionAlwaysRequeue Either SomeException a
res
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ Double -> Local -> Local
addDiscount Double
wait
    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.
--   If the two types of 'Action' are different dependencies which ultimately boil down to 'apply',
--   using 'Applicative' operations will still ensure the dependencies occur in parallel.
--   The main use of this function is to run work that happens in an 'Action' in parallel.
parallel :: [Action a] -> Action [a]
-- Note: There is no parallel_ unlike sequence_ because there is no stack benefit to doing so
parallel :: forall a. [Action a] -> Action [a]
parallel [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parallel [Action a
x] = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO

    IORef Bool
done <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
    [Fence IO (Either SomeException (Double, (Local, a)))]
waits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Action a]
acts forall a b. (a -> b) -> a -> b
$ \Action a
act ->
        forall a.
PoolPriority
-> Action a -> Action (Fence IO (Either SomeException (Double, a)))
addPoolWait PoolPriority
PoolResume forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
done) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parallel, one has already failed"
            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW Local -> Local
localClearMutable
            a
res <- Action a
act
            Local
old <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Local
old, a
res)
    (Double
wait, [(Double, (Local, a))]
res) <- forall b. Fence IO (Either SomeException b) -> Action (Double, b)
actionFenceSteal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) e r.
MonadIO m =>
[Fence m (Either e r)] -> m (Fence m (Either e [r]))
exceptFence [Fence IO (Either SomeException (Double, (Local, a)))]
waits)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Bool
done Bool
True
    let ([Double]
waits, [Local]
locals, [a]
results) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Double
a,(Local
b,a
c)) -> (Double
a,Local
b,a
c)) [(Double, (Local, a))]
res
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
root -> Double -> Local -> Local
addDiscount (Double
wait forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
waits) forall a b. (a -> b) -> a -> b
$ Local -> [Local] -> Local
localMergeMutable Local
root [Local]
locals
    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 :: forall a b.
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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Partial => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't call batchable with <= 0, you used " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
mx
    | Int
mx forall a. Eq a => a -> a -> Bool
== Int
1 = (a -> Action ()) -> Rules ()
pred 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 (Double, Local)))])
todo :: IORef (Int, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef (Int
0, [])
        (a -> Action ()) -> Rules ()
pred forall a b. (a -> b) -> a -> b
$ \a
a -> do
            b
b <- a -> Action b
one a
a
            Fence IO (Either SomeException (Double, Local))
fence <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
newFence
            -- add one to the batch
            Local
local <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
            Int
count <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
todo forall a b. (a -> b) -> a -> b
$ \(Int
count, [(b, Local, Fence IO (Either SomeException (Double, Local)))]
bs) -> let i :: Int
i = Int
countforall a. Num a => a -> a -> a
+Int
1 in ((Int
i, (b
b,Local
local,Fence IO (Either SomeException (Double, Local))
fence)forall a. a -> [a] -> [a]
:[(b, Local, Fence IO (Either SomeException (Double, Local)))]
bs), Int
i)
            IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
-> (Int -> Int -> Bool) -> Int -> Action ()
requeue IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
todo forall a. Eq a => a -> a -> Bool
(==) Int
count
            (Double
wait, (Double
cost, Local
local2)) <- forall b. Fence IO (Either SomeException b) -> Action (Double, b)
actionFenceRequeue Fence IO (Either SomeException (Double, Local))
fence
            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
root -> Double -> Local -> Local
addDiscount (Double
wait forall a. Num a => a -> a -> a
- Double
cost) 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 (Double, Local)))])
-> (Int -> Int -> Bool) -> Int -> Action ()
requeue IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
todo Int -> Int -> Bool
trigger Int
count
            | Int
count Int -> Int -> Bool
`trigger` Int
mx = forall a. PoolPriority -> Action a -> Action ()
addPoolWait_ PoolPriority
PoolResume forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
-> Action ()
go IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
todo
            | Int
count Int -> Int -> Bool
`trigger` Int
1  = forall a. PoolPriority -> Action a -> Action ()
addPoolWait_ PoolPriority
PoolBatch  forall a b. (a -> b) -> a -> b
$ IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
-> Action ()
go IORef
  (Int,
   [(b, Local, Fence IO (Either SomeException (Double, Local)))])
todo
            | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(b, Local, Fence IO (Either SomeException (Double, Local)))]
now) forall a b. (a -> b) -> a -> b
$ do
                Either SomeException (Double, Local)
res <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall k v ro rw a.
RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)
tryRAW 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
                    forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Local -> Local
localClearMutable forall a b. (a -> b) -> a -> b
$ forall a b c. (a, b, c) -> b
snd3 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(b, Local, Fence IO (Either SomeException (Double, Local)))]
now
                    IO Double
start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Double)
offsetTime
                    forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall a b. (a -> b) -> a -> b
$ [b] -> Action ()
many forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> a
fst3 [(b, Local, Fence IO (Either SomeException (Double, Local)))]
now
                    Double
end <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
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 <- forall k v ro rw. RAW k v ro rw rw
getRW
                    let t :: Double
t = Double
end forall a. Num a => a -> a -> a
- Local -> Double
localDiscount Local
rw
                    let n :: Double
n = Int -> Double
intToDouble (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(b, Local, Fence IO (Either SomeException (Double, Local)))]
now)
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
t forall a. Fractional a => a -> a -> a
/ Double
n, Local
rw{localDiscount :: Double
localDiscount = Double
0})
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
(Partial, MonadIO m) =>
Fence m a -> a -> m ()
signalFence Either SomeException (Double, Local)
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> c
thd3) [(b, Local, Fence IO (Either SomeException (Double, 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 :: Double -> Action ()
reschedule Double
x = do
    (Double
wait, ()
_) <- forall a.
PoolPriority -> Either SomeException a -> Action (Double, a)
actionAlwaysRequeuePriority (Double -> PoolPriority
PoolDeprioritize forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Double
x) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ Double -> Local -> Local
addDiscount Double
wait


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

getLocal :: Action Local
getLocal :: Action Local
getLocal = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal String
"actionShareRemove with no shared"
        Just Shared
x -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Shared -> (Key -> Bool) -> IO ()
removeShared Shared
x forall a b. (a -> b) -> a -> b
$ \Key
k -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal String
"actionShareList with no shared"
        Just Shared
x -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 Double
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 Double
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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOptions :: Global -> ShakeOptions
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    case Maybe Shared
globalShared of
        Maybe Shared
Nothing -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal String
"actionShareSanity with no shared"
        Just Shared
x -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Shared -> IO ()
sanityShared Shared
x