{-# 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
setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global{..} db :: Database
db i :: Id
i k :: Key
k v :: 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
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 "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
forall a. [a] -> [a] -> [a]
++ Status -> String
statusType Status
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " 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 "<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 r :: 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
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
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 "(changed)" else "(unchanged)")
_ -> 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 "" ("\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
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 k :: 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 k :: Key
k = do
Global{..} <- 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
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
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
global stack :: Stack
stack database :: Database
database i :: 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
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 "Shake Id no longer exists" [("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)] ""
Just (k :: Key
k, s :: Status
s) -> case Status
s of
Ready r :: 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 e :: SomeException
e _ -> 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 e :: 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
_ -> ((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
$ \continue :: Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
continue -> do
Just (_, s :: 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 r :: 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 e :: SomeException
e _ -> 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 w :: Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w) r :: Maybe (Result (OneShot BS_Store))
r -> do
let w2 :: Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w2 v :: 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 ())
-> 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) Maybe (Result (OneShot BS_Store))
r
Loaded r :: Result (OneShot BS_Store)
r -> Global
-> Stack
-> Database
-> Id
-> Key
-> 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) -> 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
Missing -> Global
-> Stack
-> Database
-> Id
-> Key
-> 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 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
buildOne :: Global -> Stack -> Database -> Id -> Key -> Maybe (Result BS.ByteString) -> Wait Locked (Either SomeException (Result (Value, BS_Store)))
buildOne :: Global
-> Stack
-> Database
-> Id
-> Key
-> Maybe (Result (OneShot BS_Store))
-> Wait
Locked (Either SomeException (Result (Value, OneShot BS_Store)))
buildOne global :: Global
global@Global{..} stack :: Stack
stack database :: Database
database i :: Id
i k :: Key
k r :: Maybe (Result (OneShot BS_Store))
r = case Id -> Key -> Stack -> Either SomeException Stack
addStack Id
i Key
k Stack
stack of
Left e :: 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
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
$ \continue :: 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 ())
-> 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) Maybe (Result (OneShot BS_Store))
r)
let go :: Wait Locked RunMode
go = Global
-> Stack
-> Database
-> 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 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
$ \mode :: 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
-> Maybe (Result (OneShot BS_Store))
-> RunMode
-> Capture
(Either
SomeException (RunResult (Result (Value, OneShot BS_Store))))
runKey Global
global Stack
stack Key
k 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
$ \res :: 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 (_, Running (NoShow w :: Either SomeException (Result (Value, OneShot BS_Store))
-> Locked ()
w) _) -> (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
_ -> 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
$ "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 "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]
++ ", 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{..} | 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}
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
mkError :: SomeException -> Status
mkError e :: SomeException
e = SomeException -> Maybe (Result (OneShot BS_Store)) -> Status
Failed SomeException
e (Maybe (Result (OneShot BS_Store)) -> Status)
-> Maybe (Result (OneShot BS_Store)) -> Status
forall a b. (a -> b) -> a -> b
$ if Bool
globalOneShot then Maybe (Result (OneShot BS_Store))
forall a. Maybe a
Nothing else Maybe (Result (OneShot BS_Store))
r
buildRunMode :: Global -> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode :: Global
-> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode global :: Global
global stack :: Stack
stack database :: Database
database me :: Maybe (Result a)
me = do
Bool
changed <- case Maybe (Result a)
me of
Nothing -> Bool -> Wait Locked Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just me :: 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
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged global :: Global
global stack :: Stack
stack database :: Database
database me :: 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 x :: [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 dep :: 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 _ = () -> Maybe ()
forall a. a -> Maybe a
Just ()
applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue callStack :: [String]
callStack ks :: [Key]
ks = do
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{..} <- 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
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
(is :: [Id]
is, wait :: 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 e :: 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
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 (_, Ready r :: 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
$ \s :: Local
s -> Local
s{localDepends :: [Depends]
localDepends = [Id] -> Depends
Depends [Id]
is Depends -> [Depends] -> [Depends]
forall a. a -> [a] -> [a]
: Local -> [Depends]
localDepends Local
s}
case Wait Locked (Either SomeException [Value])
wait of
Now vs :: 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
_ -> 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
$ \continue :: 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
$ \x :: 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
-> Key
-> Maybe (Result BS.ByteString)
-> RunMode
-> Capture (Either SomeException (RunResult (Result (Value, BS_Store))))
runKey :: Global
-> Stack
-> Key
-> 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{..},..} stack :: Stack
stack k :: Key
k r :: Maybe (Result (OneShot BS_Store))
r mode :: RunMode
mode continue :: Either SomeException (RunResult (Result (Value, OneShot BS_Store)))
-> IO ()
continue = do
let tk :: TypeRep
tk = Key -> TypeRep
typeKey Key
k
BuiltinRule{..} <- 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
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 r :: 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)
-> 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 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
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
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 e :: 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{..}, Local{..})
| 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 r :: Result (OneShot BS_Store)
r <- 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 (cr :: RunChanged
cr, c :: Step
c) | Just r :: Result (OneShot BS_Store)
r <- 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 $WResult :: 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 = [Depends] -> [Depends]
nubDepends ([Depends] -> [Depends]) -> [Depends] -> [Depends]
forall a b. (a -> b) -> a -> b
$ [Depends] -> [Depends]
forall a. [a] -> [a]
reverse [Depends]
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 = [Trace] -> [Trace]
forall a. [a] -> [a]
reverse [Trace]
localTraces}
where
mkResult :: Value -> OneShot BS_Store -> (Value, OneShot BS_Store)
mkResult value :: Value
value store :: OneShot BS_Store
store = (Value
value, if Bool
globalOneShot then OneShot BS_Store
BS.empty else OneShot BS_Store
store)
apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
apply :: [key] -> Action [value]
apply [] =
[value] -> Action [value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
apply ks :: [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)
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
historyLoad :: Int -> Action (Maybe BS.ByteString)
historyLoad :: Int -> Action (Maybe (OneShot BS_Store))
historyLoad (Int -> Ver
Ver -> Ver
ver) = do
global :: Global
global@Global{..} <- 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 "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 k :: 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
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 -> 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 res :: (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
Nothing -> case Maybe Cloud
globalCloud of
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 -> 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
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 (a :: OneShot BS_Store
a,b :: [[Key]]
b,c :: 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
Maybe (OneShot BS_Store, [[Id]], IO ())
res <- case Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res of
Now x :: 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
_ -> 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
$ \continue :: 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
$ \x :: 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
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 (res :: OneShot BS_Store
res, deps :: [[Id]]
deps, restore :: 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
$ "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
$ \s :: Local
s -> Local
s{localDepends :: [Depends]
localDepends = [Depends] -> [Depends]
forall a. [a] -> [a]
reverse ([Depends] -> [Depends]) -> [Depends] -> [Depends]
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)
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{..} <- 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)
historySave :: Int -> BS.ByteString -> Action ()
historySave :: Int -> OneShot BS_Store -> Action ()
historySave (Int -> Ver
Ver -> Ver
ver) store :: 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{..} <- 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, [Depends]
localDepends :: [Depends]
localDepends :: Local -> [Depends]
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
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 "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 <-
[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 ([Depends] -> [Depends]
forall a. [a] -> [a]
reverse [Depends]
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 is :: [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
$ \i :: Id
i -> do
Just (k :: Key
k, Ready r :: 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
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
$ "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 deps :: [[(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 -> 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 -> 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
$ "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 mp :: HashMap TypeRep BuiltinRule
mp k :: Key
k v :: Value
v
| Just BuiltinRule{..} <- 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 "runIdentify can't find rule"