{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards, PatternGuards, ScopedTypeVariables, NamedFieldPuns, GADTs #-}
{-# LANGUAGE Rank2Types, ConstraintKinds, TupleSections, ViewPatterns #-}

module Development.Shake.Internal.Core.Build(
    getDatabaseValue, getDatabaseValueGeneric,
    historyIsEnabled, historySave, historyLoad,
    applyKeyValue,
    apply, apply1,
    ) where

import Development.Shake.Classes
import General.Pool
import Development.Shake.Internal.Core.Database
import Development.Shake.Internal.Value
import Development.Shake.Internal.Errors
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.History.Shared
import Development.Shake.Internal.History.Cloud
import Development.Shake.Internal.Options
import Development.Shake.Internal.Core.Monad
import General.Wait
import qualified Data.ByteString.Char8 as BS
import Control.Monad.IO.Class
import General.Extra
import General.Intern(Id)

import Control.Exception
import Control.Monad.Extra
import Numeric.Extra
import qualified Data.HashMap.Strict as Map
import Development.Shake.Internal.Core.Rules
import Data.Typeable
import Data.Maybe
import Data.List.Extra
import Data.Either.Extra
import System.Time.Extra


---------------------------------------------------------------------
-- LOW-LEVEL OPERATIONS ON THE DATABASE

setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: 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 ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} Database
db Id
i Key
k Status
v = do
    IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- actually safe because we only lose the Locked to enter the diagnostic context
        Maybe (Key, Status)
old <- Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
db Id
i
        let changeStatus :: String
changeStatus = String
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Missing" (Status -> String
statusType (Status -> String)
-> ((Key, Status) -> Status) -> (Key, Status) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd) Maybe (Key, Status)
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Status -> String
statusType Status
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" (Key -> String
forall a. Show a => a -> String
show (Key -> String)
-> ((Key, Status) -> Key) -> (Key, Status) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Key
forall a b. (a, b) -> a
fst) Maybe (Key, Status)
old
        let changeValue :: Maybe String
changeValue = case Status
v of
                Ready Result (Value, OneShot BS_Store)
r -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"    = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Value, OneShot BS_Store) -> String
forall a. Show a => a -> String
showBracket (Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store)
forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Result (Value, OneShot BS_Store) -> Step
forall a. Result a -> Step
built Result (Value, OneShot BS_Store)
r Step -> Step -> Bool
forall a. Eq a => a -> a -> Bool
== Result (Value, OneShot BS_Store) -> Step
forall a. Result a -> Step
changed Result (Value, OneShot BS_Store)
r then String
"(changed)" else String
"(unchanged)")
                Status
_ -> Maybe String
forall a. Maybe a
Nothing
        String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
changeStatus String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++) Maybe String
changeValue
    Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
db Id
i Key
k Status
v


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

getDatabaseValue :: (RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action (Maybe (Result (Either BS.ByteString value)))
getDatabaseValue :: key -> Action (Maybe (Result (Either (OneShot BS_Store) value)))
getDatabaseValue key
k =
    (Maybe (Result (Either (OneShot BS_Store) Value))
 -> Maybe (Result (Either (OneShot BS_Store) value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) value)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Result (Either (OneShot BS_Store) Value)
 -> Result (Either (OneShot BS_Store) value))
-> Maybe (Result (Either (OneShot BS_Store) Value))
-> Maybe (Result (Either (OneShot BS_Store) value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Result (Either (OneShot BS_Store) Value)
  -> Result (Either (OneShot BS_Store) value))
 -> Maybe (Result (Either (OneShot BS_Store) Value))
 -> Maybe (Result (Either (OneShot BS_Store) value)))
-> (Result (Either (OneShot BS_Store) Value)
    -> Result (Either (OneShot BS_Store) value))
-> Maybe (Result (Either (OneShot BS_Store) Value))
-> Maybe (Result (Either (OneShot BS_Store) value))
forall a b. (a -> b) -> a -> b
$ (Either (OneShot BS_Store) Value
 -> Either (OneShot BS_Store) value)
-> Result (Either (OneShot BS_Store) Value)
-> Result (Either (OneShot BS_Store) value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (OneShot BS_Store) Value
  -> Either (OneShot BS_Store) value)
 -> Result (Either (OneShot BS_Store) Value)
 -> Result (Either (OneShot BS_Store) value))
-> (Either (OneShot BS_Store) Value
    -> Either (OneShot BS_Store) value)
-> Result (Either (OneShot BS_Store) Value)
-> Result (Either (OneShot BS_Store) value)
forall a b. (a -> b) -> a -> b
$ (Value -> value)
-> Either (OneShot BS_Store) Value
-> Either (OneShot BS_Store) value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> value
forall a. Typeable a => Value -> a
fromValue) (Action (Maybe (Result (Either (OneShot BS_Store) Value)))
 -> Action (Maybe (Result (Either (OneShot BS_Store) value))))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) value)))
forall a b. (a -> b) -> a -> b
$ Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
getDatabaseValueGeneric (Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value))))
-> Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
forall a b. (a -> b) -> a -> b
$ key -> Key
forall a. ShakeValue a => a -> Key
newKey key
k

getDatabaseValueGeneric :: Key -> Action (Maybe (Result (Either BS.ByteString Value)))
getDatabaseValueGeneric :: Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
getDatabaseValueGeneric Key
k = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Just Status
status <- IO (Maybe Status) -> Action (Maybe Status)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Status) -> Action (Maybe Status))
-> IO (Maybe Status) -> Action (Maybe Status)
forall a b. (a -> b) -> a -> b
$ Database -> Key -> IO (Maybe Status)
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> IO (Maybe v)
getValueFromKey Database
globalDatabase Key
k
    Maybe (Result (Either (OneShot BS_Store) Value))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Result (Either (OneShot BS_Store) Value))
 -> Action (Maybe (Result (Either (OneShot BS_Store) Value))))
-> Maybe (Result (Either (OneShot BS_Store) Value))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
forall a b. (a -> b) -> a -> b
$ Status -> Maybe (Result (Either (OneShot BS_Store) Value))
getResult Status
status


---------------------------------------------------------------------
-- NEW STYLE PRIMITIVES

-- | Lookup the value for a single Id, may need to spawn it
lookupOne :: Global -> Stack -> Database -> Id -> Wait Locked (Either SomeException (Result (Value, BS_Store)))
lookupOne :: Global
-> Stack
-> Database
-> Id
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
lookupOne Global
global Stack
stack Database
database Id
i = do
    Maybe (Key, Status)
res <- Locked (Maybe (Key, Status)) -> Wait Locked (Maybe (Key, Status))
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked (Maybe (Key, Status)) -> Wait Locked (Maybe (Key, Status)))
-> Locked (Maybe (Key, Status))
-> Wait Locked (Maybe (Key, Status))
forall a b. (a -> b) -> a -> b
$ IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status)))
-> IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall a b. (a -> b) -> a -> b
$ Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
database Id
i
    case Maybe (Key, Status)
res of
        Maybe (Key, Status)
Nothing -> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. a -> Wait m a
Now (Either SomeException (Result (Value, OneShot BS_Store))
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. a -> Either a b
Left (SomeException
 -> Either SomeException (Result (Value, OneShot BS_Store)))
-> SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured String
"Shake Id no longer exists" [(String
"Id", String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Id -> String
forall a. Show a => a -> String
show Id
i)] String
""
        Just (Key
k, Status
s) -> case Status
s of
            Ready Result (Value, OneShot BS_Store)
r -> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. a -> Wait m a
Now (Either SomeException (Result (Value, OneShot BS_Store))
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store)
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. b -> Either a b
Right Result (Value, OneShot BS_Store)
r
            Failed SomeException
e OneShot (Maybe (Result (OneShot BS_Store)))
_ -> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. a -> Wait m a
Now (Either SomeException (Result (Value, OneShot BS_Store))
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. a -> Either a b
Left SomeException
e
            Running{} | Left SomeException
e <- Id -> Key -> Stack -> Either SomeException Stack
addStack Id
i Key
k Stack
stack -> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. a -> Wait m a
Now (Either SomeException (Result (Value, OneShot BS_Store))
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. a -> Either a b
Left SomeException
e
            Status
_ -> ((Either SomeException (Result (Value, OneShot BS_Store))
  -> Locked ())
 -> Locked ())
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Wait m a
Later (((Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
  -> Locked ())
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> ((Either SomeException (Result (Value, OneShot BS_Store))
     -> Locked ())
    -> Locked ())
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ \Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue -> do
                Just (Key
_, Status
s) <- IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status)))
-> IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall a b. (a -> b) -> a -> b
$ Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
database Id
i
                case Status
s of
                    Ready Result (Value, OneShot BS_Store)
r -> Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue (Either SomeException (Result (Value, OneShot BS_Store))
 -> Locked ())
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store)
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. b -> Either a b
Right Result (Value, OneShot BS_Store)
r
                    Failed SomeException
e OneShot (Maybe (Result (OneShot BS_Store)))
_ -> Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue (Either SomeException (Result (Value, OneShot BS_Store))
 -> Locked ())
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. a -> Either a b
Left SomeException
e
                    Running (NoShow Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w) OneShot (Maybe (Result (OneShot BS_Store)))
r -> do
                        let w2 :: Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w2 Either SomeException (Result (Value, OneShot BS_Store))
v = Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w Either SomeException (Result (Value, OneShot BS_Store))
v Locked () -> Locked () -> Locked ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue Either SomeException (Result (Value, OneShot BS_Store))
v
                        Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
database Id
i Key
k (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$ NoShow
  (Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
-> OneShot (Maybe (Result (OneShot BS_Store))) -> Status
Running ((Either SomeException (Result (Value, OneShot BS_Store))
 -> Locked ())
-> NoShow
     (Either SomeException (Result (Value, OneShot BS_Store))
      -> Locked ())
forall a. a -> NoShow a
NoShow Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w2) OneShot (Maybe (Result (OneShot BS_Store)))
r
                    Loaded Result (OneShot BS_Store)
r -> Global
-> Stack
-> Database
-> Id
-> Key
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
buildOne Global
global Stack
stack Database
database Id
i Key
k (Result (OneShot BS_Store)
-> OneShot (Maybe (Result (OneShot BS_Store)))
forall a. a -> Maybe a
Just Result (OneShot BS_Store)
r) Wait
  Locked (Either SomeException (Result (Value, OneShot BS_Store)))
-> (Either SomeException (Result (Value, OneShot BS_Store))
    -> Locked ())
-> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
`fromLater` Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue
                    Status
Missing -> Global
-> Stack
-> Database
-> Id
-> Key
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
buildOne Global
global Stack
stack Database
database Id
i Key
k OneShot (Maybe (Result (OneShot BS_Store)))
forall a. Maybe a
Nothing Wait
  Locked (Either SomeException (Result (Value, OneShot BS_Store)))
-> (Either SomeException (Result (Value, OneShot BS_Store))
    -> Locked ())
-> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
`fromLater` Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue


-- | Build a key, must currently be either Loaded or Missing, changes to Waiting
buildOne :: Global -> Stack -> Database -> Id -> Key -> Maybe (Result BS.ByteString) -> Wait Locked (Either SomeException (Result (Value, BS_Store)))
buildOne :: Global
-> Stack
-> Database
-> Id
-> Key
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
buildOne global :: Global
global@Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} Stack
stack Database
database Id
i Key
k OneShot (Maybe (Result (OneShot BS_Store)))
r = case Id -> Key -> Stack -> Either SomeException Stack
addStack Id
i Key
k Stack
stack of
    Left SomeException
e -> do
        Locked () -> Wait Locked ()
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked () -> Wait Locked ()) -> Locked () -> Wait Locked ()
forall a b. (a -> b) -> a -> b
$ Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global
global Database
database Id
i Key
k (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Status
mkError SomeException
e
        Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Result (Value, OneShot BS_Store))
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Result (Value, OneShot BS_Store))
forall a b. a -> Either a b
Left SomeException
e
    Right Stack
stack -> ((Either SomeException (Result (Value, OneShot BS_Store))
  -> Locked ())
 -> Locked ())
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Wait m a
Later (((Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
  -> Locked ())
 -> Wait
      Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> ((Either SomeException (Result (Value, OneShot BS_Store))
     -> Locked ())
    -> Locked ())
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ \Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue -> do
        Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global
global Database
database Id
i Key
k (NoShow
  (Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
-> OneShot (Maybe (Result (OneShot BS_Store))) -> Status
Running ((Either SomeException (Result (Value, OneShot BS_Store))
 -> Locked ())
-> NoShow
     (Either SomeException (Result (Value, OneShot BS_Store))
      -> Locked ())
forall a. a -> NoShow a
NoShow Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue) OneShot (Maybe (Result (OneShot BS_Store)))
r)
        let go :: Wait Locked RunMode
go = Global
-> Stack
-> Database
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Wait Locked RunMode
forall a.
Global
-> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode Global
global Stack
stack Database
database OneShot (Maybe (Result (OneShot BS_Store)))
r
        Wait Locked RunMode -> (RunMode -> Locked ()) -> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked RunMode
go ((RunMode -> Locked ()) -> Locked ())
-> (RunMode -> Locked ()) -> Locked ()
forall a b. (a -> b) -> a -> b
$ \RunMode
mode -> IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ PoolPriority -> Pool -> IO () -> IO ()
forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolStart Pool
globalPool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Global
-> Stack
-> Key
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> RunMode
-> Capture
     (Either
        SomeException (RunResult (Result (Value, OneShot BS_Store))))
runKey Global
global Stack
stack Key
k OneShot (Maybe (Result (OneShot BS_Store)))
r RunMode
mode Capture
  (Either
     SomeException (RunResult (Result (Value, OneShot BS_Store))))
-> Capture
     (Either
        SomeException (RunResult (Result (Value, OneShot BS_Store))))
forall a b. (a -> b) -> a -> b
$ \Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
res -> do
                Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    let val :: Either SomeException (Result (Value, OneShot BS_Store))
val = (RunResult (Result (Value, OneShot BS_Store))
 -> Result (Value, OneShot BS_Store))
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> Either SomeException (Result (Value, OneShot BS_Store))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RunResult (Result (Value, OneShot BS_Store))
-> Result (Value, OneShot BS_Store)
forall value. RunResult value -> value
runValue Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
res
                    Maybe (Key, Status)
res <- IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status)))
-> IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall a b. (a -> b) -> a -> b
$ Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
database Id
i
                    Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w <- case Maybe (Key, Status)
res of
                        Just (Key
_, Running (NoShow Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w) OneShot (Maybe (Result (OneShot BS_Store)))
_) -> (Either SomeException (Result (Value, OneShot BS_Store))
 -> Locked ())
-> Locked
     (Either SomeException (Result (Value, OneShot BS_Store))
      -> Locked ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w
                        -- We used to be able to hit here, but we fixed it by ensuring the thread pool workers are all
                        -- dead _before_ any exception bubbles up
                        Maybe (Key, Status)
_ -> SomeException
-> Locked
     (Either SomeException (Result (Value, OneShot BS_Store))
      -> Locked ())
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException
 -> Locked
      (Either SomeException (Result (Value, OneShot BS_Store))
       -> Locked ()))
-> SomeException
-> Locked
     (Either SomeException (Result (Value, OneShot BS_Store))
      -> Locked ())
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$ String
"expected Waiting but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"nothing" (Status -> String
statusType (Status -> String)
-> ((Key, Status) -> Status) -> (Key, Status) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd) Maybe (Key, Status)
res String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
k
                    Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global
global Database
database Id
i Key
k (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> Status)
-> (Result (Value, OneShot BS_Store) -> Status)
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Status
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Status
mkError Result (Value, OneShot BS_Store) -> Status
Ready Either SomeException (Result (Value, OneShot BS_Store))
val
                    Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w Either SomeException (Result (Value, OneShot BS_Store))
val
                case Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
res of
                    Right RunResult{OneShot BS_Store
Result (Value, OneShot BS_Store)
RunChanged
runStore :: forall value. RunResult value -> OneShot BS_Store
runChanged :: forall value. RunResult value -> RunChanged
runValue :: Result (Value, OneShot BS_Store)
runStore :: OneShot BS_Store
runChanged :: RunChanged
runValue :: forall value. RunResult value -> value
..} | RunChanged
runChanged RunChanged -> RunChanged -> Bool
forall a. Eq a => a -> a -> Bool
/= RunChanged
ChangedNothing -> Database -> Id -> Key -> Status -> IO ()
forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
database Id
i Key
k (Status -> IO ()) -> Status -> IO ()
forall a b. (a -> b) -> a -> b
$ Result (OneShot BS_Store) -> Status
Loaded Result (Value, OneShot BS_Store)
runValue{result :: OneShot BS_Store
result=OneShot BS_Store
runStore}
                    Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    where
        mkError :: SomeException -> Status
mkError SomeException
e = SomeException
-> OneShot (Maybe (Result (OneShot BS_Store))) -> Status
Failed SomeException
e (OneShot (Maybe (Result (OneShot BS_Store))) -> Status)
-> OneShot (Maybe (Result (OneShot BS_Store))) -> Status
forall a b. (a -> b) -> a -> b
$ if Bool
globalOneShot then OneShot (Maybe (Result (OneShot BS_Store)))
forall a. Maybe a
Nothing else OneShot (Maybe (Result (OneShot BS_Store)))
r


-- | Compute the value for a given RunMode and a restore function to run
buildRunMode :: Global -> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode :: Global
-> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode Global
global Stack
stack Database
database Maybe (Result a)
me = do
    Bool
changed <- case Maybe (Result a)
me of
        Maybe (Result a)
Nothing -> Bool -> Wait Locked Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Just Result a
me -> Global -> Stack -> Database -> Result a -> Wait Locked Bool
forall a.
Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged Global
global Stack
stack Database
database Result a
me
    RunMode -> Wait Locked RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunMode -> Wait Locked RunMode) -> RunMode -> Wait Locked RunMode
forall a b. (a -> b) -> a -> b
$ if Bool
changed then RunMode
RunDependenciesChanged else RunMode
RunDependenciesSame


-- | Have the dependencies changed
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged Global
global Stack
stack Database
database Result a
me = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Wait Locked (Maybe ()) -> Wait Locked Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Wait Locked (Maybe ()) -> Wait Locked (Maybe ()))
-> [Wait Locked (Maybe ())] -> Wait Locked (Maybe ())
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM Wait Locked (Maybe ()) -> Wait Locked (Maybe ())
forall a. a -> a
id
    [(Id -> Wait Locked (Maybe ())) -> [Id] -> Wait Locked (Maybe ())
forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered ((Either SomeException (Result (Value, OneShot BS_Store))
 -> Maybe ())
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
-> Wait Locked (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (Result (Value, OneShot BS_Store)) -> Maybe ()
test (Wait
   Locked (Either SomeException (Result (Value, OneShot BS_Store)))
 -> Wait Locked (Maybe ()))
-> (Id
    -> Wait
         Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Id
-> Wait Locked (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Global
-> Stack
-> Database
-> Id
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
lookupOne Global
global Stack
stack Database
database) [Id]
x | Depends [Id]
x <- Result a -> [Depends]
forall a. Result a -> [Depends]
depends Result a
me]
    where
        test :: Either SomeException (Result (Value, OneShot BS_Store)) -> Maybe ()
test (Right Result (Value, OneShot BS_Store)
dep) | Result (Value, OneShot BS_Store) -> Step
forall a. Result a -> Step
changed Result (Value, OneShot BS_Store)
dep Step -> Step -> Bool
forall a. Ord a => a -> a -> Bool
<= Result a -> Step
forall a. Result a -> Step
built Result a
me = Maybe ()
forall a. Maybe a
Nothing
        test Either SomeException (Result (Value, OneShot BS_Store))
_ = () -> Maybe ()
forall a. a -> Maybe a
Just ()


---------------------------------------------------------------------
-- ACTUAL WORKERS

applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue [String]
callStack [Key]
ks = do
    -- this is the only place a user can inject a key into our world, so check they aren't throwing
    -- in unevaluated bottoms
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Key -> IO ()) -> [Key] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (() -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> (Key -> ()) -> Key -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ()
forall a. NFData a => a -> ()
rnf) [Key]
ks

    global :: Global
global@Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Local -> Stack
localStack :: Stack
localStack, Maybe String
localBlockApply :: Local -> Maybe String
localBlockApply :: Maybe String
localBlockApply} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    let stack :: Stack
stack = [String] -> Stack -> Stack
addCallStack [String]
callStack Stack
localStack

    let tk :: TypeRep
tk = Key -> TypeRep
typeKey (Key -> TypeRep) -> Key -> TypeRep
forall a b. (a -> b) -> a -> b
$ Key -> [Key] -> Key
forall a. a -> [a] -> a
headDef (() -> Key
forall a. ShakeValue a => a -> Key
newKey ()) [Key]
ks -- always called at non-empty so never see () key
    Maybe String -> (String -> Action ()) -> Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
localBlockApply ((String -> Action ()) -> Action ())
-> (String -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Action ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> Action ())
-> (String -> SomeException) -> String -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> Maybe String -> String -> SomeException
errorNoApply TypeRep
tk (Key -> String
forall a. Show a => a -> String
show (Key -> String) -> Maybe Key -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key] -> Maybe Key
forall a. [a] -> Maybe a
listToMaybe [Key]
ks)

    let database :: Database
database = Database
globalDatabase
    ([Id]
is, Wait Locked (Either SomeException [Value])
wait) <- IO ([Id], Wait Locked (Either SomeException [Value]))
-> Action ([Id], Wait Locked (Either SomeException [Value]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Id], Wait Locked (Either SomeException [Value]))
 -> Action ([Id], Wait Locked (Either SomeException [Value])))
-> IO ([Id], Wait Locked (Either SomeException [Value]))
-> Action ([Id], Wait Locked (Either SomeException [Value]))
forall a b. (a -> b) -> a -> b
$ Database
-> Locked ([Id], Wait Locked (Either SomeException [Value]))
-> IO ([Id], Wait Locked (Either SomeException [Value]))
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database (Locked ([Id], Wait Locked (Either SomeException [Value]))
 -> IO ([Id], Wait Locked (Either SomeException [Value])))
-> Locked ([Id], Wait Locked (Either SomeException [Value]))
-> IO ([Id], Wait Locked (Either SomeException [Value]))
forall a b. (a -> b) -> a -> b
$ do
        [Id]
is <- (Key -> Locked Id) -> [Key] -> Locked [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
database) [Key]
ks
        Wait Locked (Either SomeException [Value])
wait <- Wait Locked (Either SomeException [Value])
-> Locked (Wait Locked (Either SomeException [Value]))
forall (m :: * -> *) a. Monad m => Wait m a -> m (Wait m a)
runWait (Wait Locked (Either SomeException [Value])
 -> Locked (Wait Locked (Either SomeException [Value])))
-> Wait Locked (Either SomeException [Value])
-> Locked (Wait Locked (Either SomeException [Value]))
forall a b. (a -> b) -> a -> b
$ do
            Maybe SomeException
x <- (Id -> Wait Locked (Maybe SomeException))
-> [Id] -> Wait Locked (Maybe SomeException)
forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered ((Either SomeException (Result (Value, OneShot BS_Store))
 -> Maybe SomeException)
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
-> Wait Locked (Maybe SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeException -> Maybe SomeException)
-> (Result (Value, OneShot BS_Store) -> Maybe SomeException)
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Maybe SomeException
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (Maybe SomeException
-> Result (Value, OneShot BS_Store) -> Maybe SomeException
forall a b. a -> b -> a
const Maybe SomeException
forall a. Maybe a
Nothing)) (Wait
   Locked (Either SomeException (Result (Value, OneShot BS_Store)))
 -> Wait Locked (Maybe SomeException))
-> (Id
    -> Wait
         Locked (Either SomeException (Result (Value, OneShot BS_Store))))
-> Id
-> Wait Locked (Maybe SomeException)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Global
-> Stack
-> Database
-> Id
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
lookupOne Global
global Stack
stack Database
database) ([Id] -> Wait Locked (Maybe SomeException))
-> [Id] -> Wait Locked (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ [Id] -> [Id]
forall a. Ord a => [a] -> [a]
nubOrd [Id]
is
            case Maybe SomeException
x of
                Just SomeException
e -> Either SomeException [Value]
-> Wait Locked (Either SomeException [Value])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException [Value]
 -> Wait Locked (Either SomeException [Value]))
-> Either SomeException [Value]
-> Wait Locked (Either SomeException [Value])
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException [Value]
forall a b. a -> Either a b
Left SomeException
e
                Maybe SomeException
Nothing -> Locked (Either SomeException [Value])
-> Wait Locked (Either SomeException [Value])
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked (Either SomeException [Value])
 -> Wait Locked (Either SomeException [Value]))
-> Locked (Either SomeException [Value])
-> Wait Locked (Either SomeException [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Either SomeException [Value]
forall a b. b -> Either a b
Right ([Value] -> Either SomeException [Value])
-> Locked [Value] -> Locked (Either SomeException [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Id -> Locked Value) -> [Id] -> Locked [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe (Key, Status) -> Value)
-> Locked (Maybe (Key, Status)) -> Locked Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just (Key
_, Ready Result (Value, OneShot BS_Store)
r)) -> (Value, OneShot BS_Store) -> Value
forall a b. (a, b) -> a
fst ((Value, OneShot BS_Store) -> Value)
-> (Value, OneShot BS_Store) -> Value
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store)
forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r) (Locked (Maybe (Key, Status)) -> Locked Value)
-> (Id -> Locked (Maybe (Key, Status))) -> Id -> Locked Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key, Status)) -> Locked (Maybe (Key, Status)))
-> (Id -> IO (Maybe (Key, Status)))
-> Id
-> Locked (Maybe (Key, Status))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
database) [Id]
is
        ([Id], Wait Locked (Either SomeException [Value]))
-> Locked ([Id], Wait Locked (Either SomeException [Value]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Id]
is, Wait Locked (Either SomeException [Value])
wait)
    RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = DependsList -> Depends -> DependsList
addDepends1 (Local -> DependsList
localDepends Local
s) (Depends -> DependsList) -> Depends -> DependsList
forall a b. (a -> b) -> a -> b
$ [Id] -> Depends
Depends [Id]
is}

    case Wait Locked (Either SomeException [Value])
wait of
        Now Either SomeException [Value]
vs -> (SomeException -> Action [Value])
-> ([Value] -> Action [Value])
-> Either SomeException [Value]
-> Action [Value]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Action [Value]
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM [Value] -> Action [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException [Value]
vs
        Wait Locked (Either SomeException [Value])
_ -> do
            IO Seconds
offset <- IO (IO Seconds) -> Action (IO Seconds)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime
            [Value]
vs <- RAW ([String], [Key]) [Value] Global Local [Value]
-> Action [Value]
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local [Value]
 -> Action [Value])
-> RAW ([String], [Key]) [Value] Global Local [Value]
-> Action [Value]
forall a b. (a -> b) -> a -> b
$ Capture (Either SomeException [Value])
-> RAW ([String], [Key]) [Value] Global Local [Value]
forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW (Capture (Either SomeException [Value])
 -> RAW ([String], [Key]) [Value] Global Local [Value])
-> Capture (Either SomeException [Value])
-> RAW ([String], [Key]) [Value] Global Local [Value]
forall a b. (a -> b) -> a -> b
$ \Either SomeException [Value] -> IO ()
continue ->
                Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ Wait Locked (Either SomeException [Value])
-> (Either SomeException [Value] -> Locked ()) -> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Either SomeException [Value])
wait ((Either SomeException [Value] -> Locked ()) -> Locked ())
-> (Either SomeException [Value] -> Locked ()) -> Locked ()
forall a b. (a -> b) -> a -> b
$ \Either SomeException [Value]
x ->
                    IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ PoolPriority -> Pool -> IO () -> IO ()
forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool (if Either SomeException [Value] -> Bool
forall a b. Either a b -> Bool
isLeft Either SomeException [Value]
x then PoolPriority
PoolException else PoolPriority
PoolResume) Pool
globalPool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException [Value] -> IO ()
continue Either SomeException [Value]
x
            Seconds
offset <- IO Seconds -> Action Seconds
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
offset
            RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ Seconds -> Local -> Local
addDiscount Seconds
offset
            [Value] -> Action [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
vs


runKey
    :: Global
    -> Stack  -- Given the current stack with the key added on
    -> Key -- The key to build
    -> Maybe (Result BS.ByteString) -- A previous result, or Nothing if never been built before
    -> RunMode -- True if any of the children were dirty
    -> Capture (Either SomeException (RunResult (Result (Value, BS_Store))))
        -- Either an error, or a (the produced files, the result).
runKey :: Global
-> Stack
-> Key
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> RunMode
-> Capture
     (Either
        SomeException (RunResult (Result (Value, OneShot BS_Store))))
runKey global :: Global
global@Global{globalOptions :: Global -> ShakeOptions
globalOptions=ShakeOptions{Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [String]
shakeShare :: ShakeOptions -> Maybe String
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintInside :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [String]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> String
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: String -> String -> Bool -> IO ()
shakeOutput :: Verbosity -> String -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [String]
shakeShare :: Maybe String
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [String]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(String, String)]
shakeRebuild :: [(Rebuild, String)]
shakeFlush :: Maybe Seconds
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [String]
shakeLintIgnore :: [String]
shakeLintInside :: [String]
shakeLint :: Maybe Lint
shakeReport :: [String]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: String
shakeThreads :: Int
shakeFiles :: String
..},Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} Stack
stack Key
k OneShot (Maybe (Result (OneShot BS_Store)))
r RunMode
mode Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue = do
    let tk :: TypeRep
tk = Key -> TypeRep
typeKey Key
k
    BuiltinRule{String
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
BuiltinLint Key Value
builtinLocation :: BuiltinRule -> String
builtinVersion :: BuiltinRule -> Ver
builtinKey :: BuiltinRule -> BinaryOp Key
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinLint :: BuiltinRule -> BuiltinLint Key Value
builtinLocation :: String
builtinVersion :: Ver
builtinKey :: BinaryOp Key
builtinRun :: BuiltinRun Key Value
builtinIdentity :: BuiltinIdentity Key Value
builtinLint :: BuiltinLint Key Value
..} <- case TypeRep -> HashMap TypeRep BuiltinRule -> Maybe BuiltinRule
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TypeRep
tk HashMap TypeRep BuiltinRule
globalRules of
        Maybe BuiltinRule
Nothing -> SomeException -> IO BuiltinRule
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO BuiltinRule)
-> SomeException -> IO BuiltinRule
forall a b. (a -> b) -> a -> b
$ TypeRep -> Maybe String -> Maybe TypeRep -> SomeException
errorNoRuleToBuildType TypeRep
tk (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Key -> String
forall a. Show a => a -> String
show Key
k) Maybe TypeRep
forall a. Maybe a
Nothing
        Just BuiltinRule
r -> BuiltinRule -> IO BuiltinRule
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuiltinRule
r

    let s :: Local
s = (Stack -> Verbosity -> Local
newLocal Stack
stack Verbosity
shakeVerbosity){localBuiltinVersion :: Ver
localBuiltinVersion = Ver
builtinVersion}
    IO Seconds
time <- IO (IO Seconds)
offsetTime
    Global
-> Local
-> Action (RunResult Value, Local)
-> Capture (Either SomeException (RunResult Value, Local))
forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
global Local
s (do
        RunResult Value
res <- BuiltinRun Key Value
builtinRun Key
k ((Result (OneShot BS_Store) -> OneShot BS_Store)
-> OneShot (Maybe (Result (OneShot BS_Store)))
-> Maybe (OneShot BS_Store)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result (OneShot BS_Store) -> OneShot BS_Store
forall a. Result a -> a
result OneShot (Maybe (Result (OneShot BS_Store)))
r) RunMode
mode
        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ RunResult Value -> ()
forall a. NFData a => a -> ()
rnf RunResult Value
res

        -- completed, now track anything required afterwards
        Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunResult Value -> RunChanged
forall value. RunResult value -> RunChanged
runChanged RunResult Value
res RunChanged -> [RunChanged] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RunChanged
ChangedRecomputeSame,RunChanged
ChangedRecomputeDiff]) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
            -- if the users code didn't run you don't have to check anything (we assume builtin rules are correct)
            Key -> Action ()
globalRuleFinished Key
k
            Action ()
producesCheck

        RAW ([String], [Key]) [Value] Global Local (RunResult Value, Local)
-> Action (RunResult Value, Local)
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key]) [Value] Global Local (RunResult Value, Local)
 -> Action (RunResult Value, Local))
-> RAW
     ([String], [Key]) [Value] Global Local (RunResult Value, Local)
-> Action (RunResult Value, Local)
forall a b. (a -> b) -> a -> b
$ (Local -> (RunResult Value, Local))
-> RAW ([String], [Key]) [Value] Global Local Local
-> RAW
     ([String], [Key]) [Value] Global Local (RunResult Value, Local)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunResult Value
res,) RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW) Capture (Either SomeException (RunResult Value, Local))
-> Capture (Either SomeException (RunResult Value, Local))
forall a b. (a -> b) -> a -> b
$ \case
            Left SomeException
e ->
                Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue (Either
   SomeException (RunResult (Result (Value, OneShot BS_Store)))
 -> IO ())
-> (ShakeException
    -> Either
         SomeException (RunResult (Result (Value, OneShot BS_Store))))
-> ShakeException
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall a b. a -> Either a b
Left (SomeException
 -> Either
      SomeException (RunResult (Result (Value, OneShot BS_Store))))
-> (ShakeException -> SomeException)
-> ShakeException
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeException -> SomeException
forall e. Exception e => e -> SomeException
toException (ShakeException -> IO ()) -> IO ShakeException -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Global -> Stack -> SomeException -> IO ShakeException
shakeException Global
global Stack
stack SomeException
e
            Right (RunResult{OneShot BS_Store
Value
RunChanged
runValue :: Value
runStore :: OneShot BS_Store
runChanged :: RunChanged
runStore :: forall value. RunResult value -> OneShot BS_Store
runChanged :: forall value. RunResult value -> RunChanged
runValue :: forall value. RunResult value -> value
..}, Local{Bool
Seconds
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localTraces :: Local -> Traces
localDiscount :: Local -> Seconds
localVerbosity :: Local -> Verbosity
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Seconds
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localBuiltinVersion :: Local -> Ver
localDepends :: Local -> DependsList
localBlockApply :: Local -> Maybe String
localStack :: Local -> Stack
..})
                | RunChanged
runChanged RunChanged -> RunChanged -> Bool
forall a. Eq a => a -> a -> Bool
== RunChanged
ChangedNothing Bool -> Bool -> Bool
|| RunChanged
runChanged RunChanged -> RunChanged -> Bool
forall a. Eq a => a -> a -> Bool
== RunChanged
ChangedStore, Just Result (OneShot BS_Store)
r <- OneShot (Maybe (Result (OneShot BS_Store)))
r ->
                    Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue (Either
   SomeException (RunResult (Result (Value, OneShot BS_Store)))
 -> IO ())
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ RunResult (Result (Value, OneShot BS_Store))
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall a b. b -> Either a b
Right (RunResult (Result (Value, OneShot BS_Store))
 -> Either
      SomeException (RunResult (Result (Value, OneShot BS_Store))))
-> RunResult (Result (Value, OneShot BS_Store))
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ RunChanged
-> OneShot BS_Store
-> Result (Value, OneShot BS_Store)
-> RunResult (Result (Value, OneShot BS_Store))
forall value.
RunChanged -> OneShot BS_Store -> value -> RunResult value
RunResult RunChanged
runChanged OneShot BS_Store
runStore (Result (OneShot BS_Store)
r{result :: (Value, OneShot BS_Store)
result = Value -> OneShot BS_Store -> (Value, OneShot BS_Store)
mkResult Value
runValue OneShot BS_Store
runStore})
                | Bool
otherwise -> do
                    Seconds
dur <- IO Seconds
time
                    let (RunChanged
cr, Step
c) | Just Result (OneShot BS_Store)
r <- OneShot (Maybe (Result (OneShot BS_Store)))
r, RunChanged
runChanged RunChanged -> RunChanged -> Bool
forall a. Eq a => a -> a -> Bool
== RunChanged
ChangedRecomputeSame = (RunChanged
ChangedRecomputeSame, Result (OneShot BS_Store) -> Step
forall a. Result a -> Step
changed Result (OneShot BS_Store)
r)
                                | Bool
otherwise = (RunChanged
ChangedRecomputeDiff, Step
globalStep)
                    Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue (Either
   SomeException (RunResult (Result (Value, OneShot BS_Store)))
 -> IO ())
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ RunResult (Result (Value, OneShot BS_Store))
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall a b. b -> Either a b
Right (RunResult (Result (Value, OneShot BS_Store))
 -> Either
      SomeException (RunResult (Result (Value, OneShot BS_Store))))
-> RunResult (Result (Value, OneShot BS_Store))
-> Either
     SomeException (RunResult (Result (Value, OneShot BS_Store)))
forall a b. (a -> b) -> a -> b
$ RunChanged
-> OneShot BS_Store
-> Result (Value, OneShot BS_Store)
-> RunResult (Result (Value, OneShot BS_Store))
forall value.
RunChanged -> OneShot BS_Store -> value -> RunResult value
RunResult RunChanged
cr OneShot BS_Store
runStore Result :: forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result
                        {result :: (Value, OneShot BS_Store)
result = Value -> OneShot BS_Store -> (Value, OneShot BS_Store)
mkResult Value
runValue OneShot BS_Store
runStore
                        ,changed :: Step
changed = Step
c
                        ,built :: Step
built = Step
globalStep
                        ,depends :: [Depends]
depends = DependsList -> [Depends]
flattenDepends DependsList
localDepends
                        ,execution :: Float
execution = Seconds -> Float
doubleToFloat (Seconds -> Float) -> Seconds -> Float
forall a b. (a -> b) -> a -> b
$ Seconds
dur Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
localDiscount
                        ,traces :: [Trace]
traces = Traces -> [Trace]
flattenTraces Traces
localTraces}
            where
                mkResult :: Value -> OneShot BS_Store -> (Value, OneShot BS_Store)
mkResult Value
value OneShot BS_Store
store = (Value
value, if Bool
globalOneShot then OneShot BS_Store
BS.empty else OneShot BS_Store
store)

---------------------------------------------------------------------
-- USER key/value WRAPPERS

-- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.
--   This function requires that appropriate rules have been added with 'addBuiltinRule'.
--   All @key@ values passed to 'apply' become dependencies of the 'Action'.
apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
apply :: [key] -> Action [value]
apply [] =
    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not
    [value] -> Action [value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
apply [key]
ks =
    ([Value] -> [value]) -> Action [Value] -> Action [value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> value) -> [Value] -> [value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> value
forall a. Typeable a => Value -> a
fromValue) (Action [Value] -> Action [value])
-> Action [Value] -> Action [value]
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local [Value]
-> Action [Value]
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local [Value]
 -> Action [Value])
-> RAW ([String], [Key]) [Value] Global Local [Value]
-> Action [Value]
forall a b. (a -> b) -> a -> b
$ ([String], [Key])
-> RAW ([String], [Key]) [Value] Global Local [Value]
forall k v ro rw. k -> RAW k v ro rw v
stepRAW ([String]
Partial => [String]
callStackFull, (key -> Key) -> [key] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map key -> Key
forall a. ShakeValue a => a -> Key
newKey [key]
ks)


-- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,
--   use 'apply' to allow parallelism.
apply1 :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action value
apply1 :: key -> Action value
apply1 = (Partial => key -> Action value) -> key -> Action value
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => key -> Action value) -> key -> Action value)
-> (Partial => key -> Action value) -> key -> Action value
forall a b. (a -> b) -> a -> b
$ ([value] -> value) -> Action [value] -> Action value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [value] -> value
forall a. [a] -> a
head (Action [value] -> Action value)
-> (key -> Action [value]) -> key -> Action value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [key] -> Action [value]
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
[key] -> Action [value]
apply ([key] -> Action [value])
-> (key -> [key]) -> key -> Action [value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> [key]
forall (f :: * -> *) a. Applicative f => a -> f a
pure



---------------------------------------------------------------------
-- HISTORY STUFF

-- | Load a value from the history. Given a version from any user rule
--   (or @0@), return the payload that was stored by 'historySave'.
--
--   If this function returns 'Just' it will also have restored any files that
--   were saved by 'historySave'.
historyLoad :: Int -> Action (Maybe BS.ByteString)
historyLoad :: Int -> Action (Maybe (OneShot BS_Store))
historyLoad (Int -> Ver
Ver -> Ver
ver) = do
    global :: Global
global@Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Stack
localStack :: Local -> Stack
localStack, Ver
localBuiltinVersion :: Ver
localBuiltinVersion :: Local -> Ver
localBuiltinVersion} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    if Maybe Shared -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Shared
globalShared Bool -> Bool -> Bool
&& Maybe Cloud -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Cloud
globalCloud then Maybe (OneShot BS_Store) -> Action (Maybe (OneShot BS_Store))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store)
forall a. Maybe a
Nothing else do
        Key
key <- IO Key -> Action Key
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Key -> Action Key) -> IO Key -> Action Key
forall a b. (a -> b) -> a -> b
$ Key -> IO Key
forall a. a -> IO a
evaluate (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe (String -> Key
forall a. Partial => String -> a
error String
"Can't call historyLoad outside a rule") (Maybe Key -> Key) -> Maybe Key -> Key
forall a b. (a -> b) -> a -> b
$ Stack -> Maybe Key
topStack Stack
localStack
        let database :: Database
database = Database
globalDatabase
        Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res <- IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> Action (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
 -> Action (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))))
-> IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> Action (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall a b. (a -> b) -> a -> b
$ Database
-> Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database (Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
 -> IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))))
-> Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> IO (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall a b. (a -> b) -> a -> b
$ Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall (m :: * -> *) a. Monad m => Wait m a -> m (Wait m a)
runWait (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
 -> Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))))
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Locked (Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
forall a b. (a -> b) -> a -> b
$ do
            let ask :: Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
k = do
                    Id
i <- Locked Id -> Wait Locked Id
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked Id -> Wait Locked Id) -> Locked Id -> Wait Locked Id
forall a b. (a -> b) -> a -> b
$ Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
database Key
k
                    let identify :: Result (Value, OneShot BS_Store) -> Maybe (OneShot BS_Store)
identify = HashMap TypeRep BuiltinRule -> BuiltinIdentity Key Value
runIdentify HashMap TypeRep BuiltinRule
globalRules Key
k (Value -> Maybe (OneShot BS_Store))
-> (Result (Value, OneShot BS_Store) -> Value)
-> Result (Value, OneShot BS_Store)
-> Maybe (OneShot BS_Store)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value, OneShot BS_Store) -> Value
forall a b. (a, b) -> a
fst ((Value, OneShot BS_Store) -> Value)
-> (Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store))
-> Result (Value, OneShot BS_Store)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store)
forall a. Result a -> a
result
                    (SomeException -> Maybe (OneShot BS_Store))
-> (Result (Value, OneShot BS_Store) -> Maybe (OneShot BS_Store))
-> Either SomeException (Result (Value, OneShot BS_Store))
-> Maybe (OneShot BS_Store)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (OneShot BS_Store)
-> SomeException -> Maybe (OneShot BS_Store)
forall a b. a -> b -> a
const Maybe (OneShot BS_Store)
forall a. Maybe a
Nothing) Result (Value, OneShot BS_Store) -> Maybe (OneShot BS_Store)
identify (Either SomeException (Result (Value, OneShot BS_Store))
 -> Maybe (OneShot BS_Store))
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
-> Wait Locked (Maybe (OneShot BS_Store))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Global
-> Stack
-> Database
-> Id
-> Wait
     Locked (Either SomeException (Result (Value, OneShot BS_Store)))
lookupOne Global
global Stack
localStack Database
database Id
i
            Maybe (OneShot BS_Store, [[Key]], IO ())
x <- case Maybe Shared
globalShared of
                Maybe Shared
Nothing -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. Maybe a
Nothing
                Just Shared
shared -> Shared
-> (Key -> Wait Locked (Maybe (OneShot BS_Store)))
-> Key
-> Ver
-> Ver
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
lookupShared Shared
shared Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
key Ver
localBuiltinVersion Ver
ver
            Maybe (OneShot BS_Store, [[Key]], IO ())
x <- case Maybe (OneShot BS_Store, [[Key]], IO ())
x of
                Just (OneShot BS_Store, [[Key]], IO ())
res -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OneShot BS_Store, [[Key]], IO ())
 -> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ())))
-> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall a b. (a -> b) -> a -> b
$ (OneShot BS_Store, [[Key]], IO ())
-> Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. a -> Maybe a
Just (OneShot BS_Store, [[Key]], IO ())
res
                Maybe (OneShot BS_Store, [[Key]], IO ())
Nothing -> case Maybe Cloud
globalCloud of
                    Maybe Cloud
Nothing -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. Maybe a
Nothing
                    Just Cloud
cloud -> Cloud
-> (Key -> Wait Locked (Maybe (OneShot BS_Store)))
-> Key
-> Ver
-> Ver
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
lookupCloud Cloud
cloud Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
key Ver
localBuiltinVersion Ver
ver
            case Maybe (OneShot BS_Store, [[Key]], IO ())
x of
                Maybe (OneShot BS_Store, [[Key]], IO ())
Nothing -> Maybe (OneShot BS_Store, [[Id]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Id]], IO ())
forall a. Maybe a
Nothing
                Just (OneShot BS_Store
a,[[Key]]
b,IO ()
c) -> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
 -> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a b. (a -> b) -> a -> b
$ (OneShot BS_Store, [[Id]], IO ())
-> Maybe (OneShot BS_Store, [[Id]], IO ())
forall a. a -> Maybe a
Just ((OneShot BS_Store, [[Id]], IO ())
 -> Maybe (OneShot BS_Store, [[Id]], IO ()))
-> ([[Id]] -> (OneShot BS_Store, [[Id]], IO ()))
-> [[Id]]
-> Maybe (OneShot BS_Store, [[Id]], IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneShot BS_Store
a,,IO ()
c) ([[Id]] -> Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Locked [[Id]]
-> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Key] -> Locked [Id]) -> [[Key]] -> Locked [[Id]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Key -> Locked Id) -> [Key] -> Locked [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Key -> Locked Id) -> [Key] -> Locked [Id])
-> (Key -> Locked Id) -> [Key] -> Locked [Id]
forall a b. (a -> b) -> a -> b
$ Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
database) [[Key]]
b
        -- FIXME: If running with cloud and shared, and you got a hit in cloud, should also add it to shared
        Maybe (OneShot BS_Store, [[Id]], IO ())
res <- case Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res of
            Now Maybe (OneShot BS_Store, [[Id]], IO ())
x -> Maybe (OneShot BS_Store, [[Id]], IO ())
-> Action (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Id]], IO ())
x
            Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
_ -> do
                IO Seconds
offset <- IO (IO Seconds) -> Action (IO Seconds)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Seconds)
offsetTime
                Maybe (OneShot BS_Store, [[Id]], IO ())
res <- RAW
  ([String], [Key])
  [Value]
  Global
  Local
  (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Action (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key])
   [Value]
   Global
   Local
   (Maybe (OneShot BS_Store, [[Id]], IO ()))
 -> Action (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Action (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a b. (a -> b) -> a -> b
$ Capture
  (Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW (Capture
   (Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ())))
 -> RAW
      ([String], [Key])
      [Value]
      Global
      Local
      (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> Capture
     (Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> RAW
     ([String], [Key])
     [Value]
     Global
     Local
     (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a b. (a -> b) -> a -> b
$ \Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
continue ->
                    Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> (Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
-> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res ((Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
 -> Locked ())
-> (Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
-> Locked ()
forall a b. (a -> b) -> a -> b
$ \Maybe (OneShot BS_Store, [[Id]], IO ())
x ->
                        IO () -> Locked ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Locked ()) -> IO () -> Locked ()
forall a b. (a -> b) -> a -> b
$ PoolPriority -> Pool -> IO () -> IO ()
forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolResume Pool
globalPool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
continue (Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
 -> IO ())
-> Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (OneShot BS_Store, [[Id]], IO ())
-> Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a b. b -> Either a b
Right Maybe (OneShot BS_Store, [[Id]], IO ())
x
                Seconds
offset <- IO Seconds -> Action Seconds
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Seconds
offset
                RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ Seconds -> Local -> Local
addDiscount Seconds
offset
                Maybe (OneShot BS_Store, [[Id]], IO ())
-> Action (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Id]], IO ())
res
        case Maybe (OneShot BS_Store, [[Id]], IO ())
res of
            Maybe (OneShot BS_Store, [[Id]], IO ())
Nothing -> Maybe (OneShot BS_Store) -> Action (Maybe (OneShot BS_Store))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store)
forall a. Maybe a
Nothing
            Just (OneShot BS_Store
res, [[Id]]
deps, IO ()
restore) -> do
                IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"History hit for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
key
                IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
restore
                RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = [Depends] -> DependsList
newDepends ([Depends] -> DependsList) -> [Depends] -> DependsList
forall a b. (a -> b) -> a -> b
$ ([Id] -> Depends) -> [[Id]] -> [Depends]
forall a b. (a -> b) -> [a] -> [b]
map [Id] -> Depends
Depends [[Id]]
deps}
                Maybe (OneShot BS_Store) -> Action (Maybe (OneShot BS_Store))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OneShot BS_Store -> Maybe (OneShot BS_Store)
forall a. a -> Maybe a
Just OneShot BS_Store
res)


-- | Is the history enabled, returns 'True' if you have a 'shakeShare' or 'shakeCloud',
--   and haven't called 'historyDisable' so far in this rule.
historyIsEnabled :: Action Bool
historyIsEnabled :: Action Bool
historyIsEnabled = RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool)
-> RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Bool
localHistory :: Bool
localHistory :: Local -> Bool
localHistory} <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    Bool -> RAW ([String], [Key]) [Value] Global Local Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> RAW ([String], [Key]) [Value] Global Local Bool)
-> Bool -> RAW ([String], [Key]) [Value] Global Local Bool
forall a b. (a -> b) -> a -> b
$ Bool
localHistory Bool -> Bool -> Bool
&& (Maybe Shared -> Bool
forall a. Maybe a -> Bool
isJust Maybe Shared
globalShared Bool -> Bool -> Bool
|| Maybe Cloud -> Bool
forall a. Maybe a -> Bool
isJust Maybe Cloud
globalCloud)


-- | Save a value to the history. Record the version of any user rule
--   (or @0@), and a payload. Must be run at the end of the rule, after
--   any dependencies have been captured. If history is enabled, stores the information
--   in a cache.
--
--   This function relies on 'produces' to have been called correctly to describe
--   which files were written during the execution of this rule.
historySave :: Int -> BS.ByteString -> Action ()
historySave :: Int -> OneShot BS_Store -> Action ()
historySave (Int -> Ver
Ver -> Ver
ver) OneShot BS_Store
store = Action Bool -> Action () -> Action ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Action Bool
historyIsEnabled (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{[(Bool, String)]
localProduces :: [(Bool, String)]
localProduces :: Local -> [(Bool, String)]
localProduces, DependsList
localDepends :: DependsList
localDepends :: Local -> DependsList
localDepends, Ver
localBuiltinVersion :: Ver
localBuiltinVersion :: Local -> Ver
localBuiltinVersion, Stack
localStack :: Stack
localStack :: Local -> Stack
localStack} <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    IO () -> RAW ([String], [Key]) [Value] Global Local ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RAW ([String], [Key]) [Value] Global Local ())
-> IO () -> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ do
        -- make sure we throw errors before we get into the history
        Ver -> IO Ver
forall a. a -> IO a
evaluate Ver
ver
        OneShot BS_Store -> IO (OneShot BS_Store)
forall a. a -> IO a
evaluate OneShot BS_Store
store
        Key
key <- Key -> IO Key
forall a. a -> IO a
evaluate (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe (String -> Key
forall a. Partial => String -> a
error String
"Can't call historySave outside a rule") (Maybe Key -> Key) -> Maybe Key -> Key
forall a b. (a -> b) -> a -> b
$ Stack -> Maybe Key
topStack Stack
localStack

        let produced :: [String]
produced = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
localProduces
        Maybe [[(Key, OneShot BS_Store)]]
deps <-
            -- can do this without the DB lock, since it reads things that are stable
            [Depends]
-> (Depends -> IO (Maybe [(Key, OneShot BS_Store)]))
-> IO (Maybe [[(Key, OneShot BS_Store)]])
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM (DependsList -> [Depends]
flattenDepends DependsList
localDepends) ((Depends -> IO (Maybe [(Key, OneShot BS_Store)]))
 -> IO (Maybe [[(Key, OneShot BS_Store)]]))
-> (Depends -> IO (Maybe [(Key, OneShot BS_Store)]))
-> IO (Maybe [[(Key, OneShot BS_Store)]])
forall a b. (a -> b) -> a -> b
$ \(Depends [Id]
is) -> [Id]
-> (Id -> IO (Maybe (Key, OneShot BS_Store)))
-> IO (Maybe [(Key, OneShot BS_Store)])
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM [Id]
is ((Id -> IO (Maybe (Key, OneShot BS_Store)))
 -> IO (Maybe [(Key, OneShot BS_Store)]))
-> (Id -> IO (Maybe (Key, OneShot BS_Store)))
-> IO (Maybe [(Key, OneShot BS_Store)])
forall a b. (a -> b) -> a -> b
$ \Id
i -> do
                Just (Key
k, Ready Result (Value, OneShot BS_Store)
r) <- Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
globalDatabase Id
i
                Maybe (Key, OneShot BS_Store) -> IO (Maybe (Key, OneShot BS_Store))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Key, OneShot BS_Store)
 -> IO (Maybe (Key, OneShot BS_Store)))
-> Maybe (Key, OneShot BS_Store)
-> IO (Maybe (Key, OneShot BS_Store))
forall a b. (a -> b) -> a -> b
$ (Key
k,) (OneShot BS_Store -> (Key, OneShot BS_Store))
-> Maybe (OneShot BS_Store) -> Maybe (Key, OneShot BS_Store)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TypeRep BuiltinRule -> BuiltinIdentity Key Value
runIdentify HashMap TypeRep BuiltinRule
globalRules Key
k ((Value, OneShot BS_Store) -> Value
forall a b. (a, b) -> a
fst ((Value, OneShot BS_Store) -> Value)
-> (Value, OneShot BS_Store) -> Value
forall a b. (a -> b) -> a -> b
$ Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store)
forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r)
        let k :: Maybe Key
k = Stack -> Maybe Key
topStack Stack
localStack
        case Maybe [[(Key, OneShot BS_Store)]]
deps of
            Maybe [[(Key, OneShot BS_Store)]]
Nothing -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Dependency with no identity for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Key -> String
forall a. Show a => a -> String
show Maybe Key
k
            Just [[(Key, OneShot BS_Store)]]
deps -> do
                Maybe Shared -> (Shared -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Shared
globalShared ((Shared -> IO ()) -> IO ()) -> (Shared -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Shared
shared -> Shared
-> Key
-> Ver
-> Ver
-> [[(Key, OneShot BS_Store)]]
-> OneShot BS_Store
-> [String]
-> IO ()
addShared Shared
shared Key
key Ver
localBuiltinVersion Ver
ver [[(Key, OneShot BS_Store)]]
deps OneShot BS_Store
store [String]
produced
                Maybe Cloud -> (Cloud -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Cloud
globalCloud  ((Cloud -> IO ()) -> IO ()) -> (Cloud -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Cloud
cloud  -> Cloud
-> Key
-> Ver
-> Ver
-> [[(Key, OneShot BS_Store)]]
-> OneShot BS_Store
-> [String]
-> IO ()
addCloud  Cloud
cloud  Key
key Ver
localBuiltinVersion Ver
ver [[(Key, OneShot BS_Store)]]
deps OneShot BS_Store
store [String]
produced
                IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"History saved for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Key -> String
forall a. Show a => a -> String
show Maybe Key
k


runIdentify :: Map.HashMap TypeRep BuiltinRule -> Key -> Value -> Maybe BS.ByteString
runIdentify :: HashMap TypeRep BuiltinRule -> BuiltinIdentity Key Value
runIdentify HashMap TypeRep BuiltinRule
mp Key
k Value
v
    | Just BuiltinRule{String
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
BuiltinLint Key Value
builtinLocation :: String
builtinVersion :: Ver
builtinKey :: BinaryOp Key
builtinRun :: BuiltinRun Key Value
builtinIdentity :: BuiltinIdentity Key Value
builtinLint :: BuiltinLint Key Value
builtinLocation :: BuiltinRule -> String
builtinVersion :: BuiltinRule -> Ver
builtinKey :: BuiltinRule -> BinaryOp Key
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinLint :: BuiltinRule -> BuiltinLint Key Value
..} <- TypeRep -> HashMap TypeRep BuiltinRule -> Maybe BuiltinRule
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Key -> TypeRep
typeKey Key
k) HashMap TypeRep BuiltinRule
mp = BuiltinIdentity Key Value
builtinIdentity Key
k Value
v
    | Bool
otherwise = SomeException -> Maybe (OneShot BS_Store)
forall a. SomeException -> a
throwImpure (SomeException -> Maybe (OneShot BS_Store))
-> SomeException -> Maybe (OneShot BS_Store)
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal String
"runIdentify can't find rule"