{-# 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 Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: 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 Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} Database
db Id
i Key
k Status
v = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic 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 <- forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
db Id
i
        let changeStatus :: String
changeStatus = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Missing" (Status -> String
statusType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (Key, Status)
old forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ Status -> String
statusType Status
v forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"    = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
showBracket (forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++
                    if forall a. Result a -> Step
changed Result (Value, OneShot BS_Store)
r forall a. Eq a => a -> a -> Bool
== Step
globalStep then String
"(changed)"
                    else if forall a. Result a -> Step
built Result (Value, OneShot BS_Store)
r forall a. Eq a => a -> a -> Bool
== Step
globalStep then String
"(unchanged)"
                    else String
"(didn't run)"
                Status
_ -> forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
changeStatus forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"\n" forall a. [a] -> [a] -> [a]
++) Maybe String
changeValue
    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 :: forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value) =>
key -> Action (Maybe (Result (Either (OneShot BS_Store) value)))
getDatabaseValue key
k =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Typeable a => Value -> a
fromValue) forall a b. (a -> b) -> a -> b
$ Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
getDatabaseValueGeneric forall a b. (a -> b) -> a -> b
$ 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 Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Just Status
status <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> IO (Maybe v)
getValueFromKey Database
globalDatabase Key
k
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall 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 -> forall (m :: * -> *) a. a -> Wait m a
Now forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> [(String, Maybe String)] -> String -> SomeException
errorStructured String
"Shake Id no longer exists" [(String
"Id", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. a -> Wait m a
Now forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Result (Value, OneShot BS_Store)
r
            Failed SomeException
e OneShot (Maybe (Result (OneShot BS_Store)))
_ -> forall (m :: * -> *) a. a -> Wait m a
Now forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. a -> Wait m a
Now forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
e
            Status
_ -> forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Wait m a
Later forall a b. (a -> b) -> a -> b
$ \Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue -> do
                Just (Key
_, Status
s) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 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
                        forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
database Id
i Key
k forall a b. (a -> b) -> a -> b
$ NoShow
  (Either SomeException (Result (Value, OneShot BS_Store))
   -> Locked ())
-> OneShot (Maybe (Result (OneShot BS_Store))) -> Status
Running (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 (forall a. a -> Maybe a
Just Result (OneShot BS_Store)
r) 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 forall a. Maybe a
Nothing 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 Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} 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
        forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly forall a b. (a -> b) -> a -> b
$ Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global
global Database
database Id
i Key
k forall a b. (a -> b) -> a -> b
$ SomeException -> Status
mkError SomeException
e
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
e
    Right Stack
stack -> forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Wait m a
Later 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 (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 = 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
        forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked RunMode
go forall a b. (a -> b) -> a -> b
$ \RunMode
mode -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolStart Pool
globalPool 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 forall a b. (a -> b) -> a -> b
$ \Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
res -> do
                forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database forall a b. (a -> b) -> a -> b
$ do
                    let val :: Either SomeException (Result (Value, OneShot BS_Store))
val = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall value. RunResult value -> value
runValue Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
res
                    Maybe (Key, Status)
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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)))
_) -> 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)
_ -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal forall a b. (a -> b) -> a -> b
$ String
"expected Waiting but got " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"nothing" (Status -> String
statusType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (Key, Status)
res forall a. [a] -> [a] -> [a]
++ String
", key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Key
k
                    Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global
global Database
database Id
i Key
k forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
/= RunChanged
ChangedNothing -> forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
database Id
i Key
k 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)))
_ -> 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 forall a b. (a -> b) -> a -> b
$ if Bool
globalOneShot then 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 :: forall a.
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Just Result a
me -> forall a.
Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged Global
global Stack
stack Database
database Result a
me
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall a.
Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged Global
global Stack
stack Database
database Result a
me = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM forall a. a -> a
id
    [forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException (Result (Value, OneShot BS_Store)) -> Maybe ()
test 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 <- 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) | forall a. Result a -> Step
changed Result (Value, OneShot BS_Store)
dep forall a. Ord a => a -> a -> Bool
<= forall a. Result a -> Step
built Result a
me = forall a. Maybe a
Nothing
        test Either SomeException (Result (Value, OneShot BS_Store))
_ = 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
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> ()
rnf) [Key]
ks

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

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

    let database :: Database
database = Database
globalDatabase
    ([Id]
is, Wait Locked (Either SomeException [Value])
wait) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database forall a b. (a -> b) -> a -> b
$ do
        [Id]
is <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
database) [Key]
ks
        Wait Locked (Either SomeException [Value])
wait <- forall (m :: * -> *) a. Monad m => Wait m a -> m (Wait m a)
runWait forall a b. (a -> b) -> a -> b
$ do
            Maybe SomeException
x <- forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)) 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) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd [Id]
is
            case Maybe SomeException
x of
                Just SomeException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
e
                Maybe SomeException
Nothing -> forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just (Key
_, Ready Result (Value, OneShot BS_Store)
r)) -> forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
database) [Id]
is
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Id]
is, Wait Locked (Either SomeException [Value])
wait)
    forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = DependsList -> Depends -> DependsList
addDepends1 (Local -> DependsList
localDepends Local
s) 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 -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException [Value]
vs
        Wait Locked (Either SomeException [Value])
_ -> do
            IO Double
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Double)
offsetTime
            [Value]
vs <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW forall a b. (a -> b) -> a -> b
$ \Either SomeException [Value] -> IO ()
continue ->
                forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Either SomeException [Value])
wait forall a b. (a -> b) -> a -> b
$ \Either SomeException [Value]
x ->
                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool (if forall a b. Either a b -> Bool
isLeft Either SomeException [Value]
x then PoolPriority
PoolException else PoolPriority
PoolResume) Pool
globalPool forall a b. (a -> b) -> a -> b
$ Either SomeException [Value] -> IO ()
continue Either SomeException [Value]
x
            Double
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
offset
            forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ Double -> Local -> Local
addDiscount Double
offset
            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 Double
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeSymlink :: ShakeOptions -> Bool
shakeCloud :: ShakeOptions -> [String]
shakeShare :: ShakeOptions -> Maybe String
shakeColor :: ShakeOptions -> Bool
shakeVersionIgnore :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeCreationCheck :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeRunCommands :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeStorageLog :: ShakeOptions -> Bool
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeFlush :: ShakeOptions -> Maybe Double
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeLintWatch :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintInside :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeReport :: ShakeOptions -> [String]
shakeStaunch :: ShakeOptions -> Bool
shakeVerbosity :: ShakeOptions -> Verbosity
shakeVersion :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeFiles :: ShakeOptions -> String
shakeExtra :: HashMap TypeRep Dynamic
shakeTrace :: String -> String -> Bool -> IO ()
shakeOutput :: Verbosity -> String -> IO ()
shakeProgress :: IO Progress -> IO ()
shakeAllowRedefineRules :: Bool
shakeNeedDirectory :: Bool
shakeSymlink :: Bool
shakeCloud :: [String]
shakeShare :: Maybe String
shakeColor :: Bool
shakeVersionIgnore :: Bool
shakeLiveFiles :: [String]
shakeCreationCheck :: Bool
shakeChange :: Change
shakeRunCommands :: Bool
shakeTimings :: Bool
shakeLineBuffering :: Bool
shakeStorageLog :: Bool
shakeAbbreviations :: [(String, String)]
shakeRebuild :: [(Rebuild, String)]
shakeFlush :: Maybe Double
shakeCommandOptions :: [CmdOption]
shakeLintWatch :: [String]
shakeLintIgnore :: [String]
shakeLintInside :: [String]
shakeLint :: Maybe Lint
shakeReport :: [String]
shakeStaunch :: Bool
shakeVerbosity :: Verbosity
shakeVersion :: String
shakeThreads :: Int
shakeFiles :: String
..},Bool
Maybe Shared
Maybe Cloud
IO Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} 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 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 -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ TypeRep -> Maybe String -> Maybe TypeRep -> SomeException
errorNoRuleToBuildType TypeRep
tk (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Key
k) forall a. Maybe a
Nothing
        Just BuiltinRule
r -> 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 Double
time <- IO (IO Double)
offsetTime
    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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Result a -> a
result OneShot (Maybe (Result (OneShot BS_Store)))
r) RunMode
mode
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> ()
rnf RunResult Value
res

        -- completed, now track anything required afterwards
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall value. RunResult value -> RunChanged
runChanged RunResult Value
res forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RunChanged
ChangedRecomputeSame,RunChanged
ChangedRecomputeDiff]) 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

        forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunResult Value
res,) forall k v ro rw. RAW k v ro rw rw
getRW) forall a b. (a -> b) -> a -> b
$ \case
            Left SomeException
e ->
                Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException 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
Double
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localTraces :: Local -> Traces
localDiscount :: Local -> Double
localVerbosity :: Local -> Verbosity
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Double
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localBuiltinVersion :: Local -> Ver
localDepends :: Local -> DependsList
localBlockApply :: Local -> Maybe String
localStack :: Local -> Stack
..})
                | RunChanged
runChanged forall a. Eq a => a -> a -> Bool
== RunChanged
ChangedNothing Bool -> Bool -> Bool
|| RunChanged
runChanged 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 forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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
                    Double
dur <- IO Double
time
                    let (RunChanged
cr, Step
c) | Just Result (OneShot BS_Store)
r <- OneShot (Maybe (Result (OneShot BS_Store)))
r, RunChanged
runChanged forall a. Eq a => a -> a -> Bool
== RunChanged
ChangedRecomputeSame = (RunChanged
ChangedRecomputeSame, 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 forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall value.
RunChanged -> OneShot BS_Store -> value -> RunResult value
RunResult RunChanged
cr OneShot BS_Store
runStore 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 = Double -> Float
doubleToFloat forall a b. (a -> b) -> a -> b
$ Double
dur forall a. Num a => a -> a -> a
- Double
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 :: forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
[key] -> Action [value]
apply [] =
    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not
    forall (f :: * -> *) a. Applicative f => a -> f a
pure []
apply [key]
ks =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a. Typeable a => Value -> a
fromValue) forall a b. (a -> b) -> a -> b
$ forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall k v ro rw. k -> RAW k v ro rw v
stepRAW (Partial => [String]
callStackFull, forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
[key] -> Action [value]
apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Stack
localStack :: Local -> Stack
localStack, Ver
localBuiltinVersion :: Ver
localBuiltinVersion :: Local -> Ver
localBuiltinVersion} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw rw
getRW
    if forall a. Maybe a -> Bool
isNothing Maybe Shared
globalShared Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Cloud
globalCloud then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else do
        Key
key <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. Partial => String -> a
error String
"Can't call historyLoad outside a rule") 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
database forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Wait m a -> m (Wait m a)
runWait forall a b. (a -> b) -> a -> b
$ do
            let ask :: Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
k = do
                    Id
i <- forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Result a -> a
result
                    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Result (Value, OneShot BS_Store) -> Maybe (OneShot BS_Store)
identify 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
                Just (OneShot BS_Store
a,[[Key]]
b,IO ()
c) -> forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneShot BS_Store
a,,IO ()
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ 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 -> 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 Double
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Double)
offsetTime
                Maybe (OneShot BS_Store, [[Id]], IO ())
res <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall a k v ro rw.
Capture (Either SomeException a) -> RAW k v ro rw a
captureRAW forall a b. (a -> b) -> a -> b
$ \Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
continue ->
                    forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res forall a b. (a -> b) -> a -> b
$ \Maybe (OneShot BS_Store, [[Id]], IO ())
x ->
                        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolResume Pool
globalPool forall a b. (a -> b) -> a -> b
$ Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
continue forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Maybe (OneShot BS_Store, [[Id]], IO ())
x
                Double
offset <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
offset
                forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ Double -> Local -> Local
addDiscount Double
offset
                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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            Just (OneShot BS_Store
res, [[Id]]
deps, IO ()
restore) -> do
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"History hit for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Key
key
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
restore
                forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends :: DependsList
localDepends = [Depends] -> DependsList
newDepends forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Id] -> Depends
Depends [[Id]]
deps}
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 = forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Bool
localHistory :: Bool
localHistory :: Local -> Bool
localHistory} <- forall k v ro rw. RAW k v ro rw rw
getRW
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
localHistory Bool -> Bool -> Bool
&& (forall a. Maybe a -> Bool
isJust Maybe Shared
globalShared Bool -> Bool -> 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 = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Action Bool
historyIsEnabled forall a b. (a -> b) -> a -> b
$ forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall a b. (a -> b) -> a -> b
$ do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} <- 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} <- forall k v ro rw. RAW k v ro rw rw
getRW
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        -- make sure we throw errors before we get into the history
        forall a. a -> IO a
evaluate Ver
ver
        forall a. a -> IO a
evaluate OneShot BS_Store
store
        Key
key <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. Partial => String -> a
error String
"Can't call historySave outside a rule") forall a b. (a -> b) -> a -> b
$ Stack -> Maybe Key
topStack Stack
localStack

        let produced :: [String]
produced = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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
            forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM (DependsList -> [Depends]
flattenDepends DependsList
localDepends) forall a b. (a -> b) -> a -> b
$ \(Depends [Id]
is) -> forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM [Id]
is forall a b. (a -> b) -> a -> b
$ \Id
i -> do
                Just (Key
k, Ready Result (Value, OneShot BS_Store)
r) <- forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
globalDatabase Id
i
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Key
k,) 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 (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"Dependency with no identity for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe Key
k
            Just [[(Key, OneShot BS_Store)]]
deps -> do
                forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Shared
globalShared 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
                forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Cloud
globalCloud  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
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO String -> IO ()
globalDiagnostic forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"History saved for " forall a. [a] -> [a] -> [a]
++ 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
..} <- 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 = forall a. SomeException -> a
throwImpure forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
errorInternal String
"runIdentify can't find rule"