{-# 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{..} 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
        -- actually safe because we only lose the Locked to enter the diagnostic context
        Maybe (Key, Status)
old <- Database -> Id -> IO (Maybe (Key, Status))
forall k v. DatabasePoly k v -> Id -> IO (Maybe (k, v))
getKeyValueFromId Database
db Id
i
        let changeStatus :: String
changeStatus = String
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "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


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

getDatabaseValue :: (RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action (Maybe (Result (Either BS.ByteString value)))
getDatabaseValue :: key -> Action (Maybe (Result (Either (OneShot BS_Store) value)))
getDatabaseValue 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


---------------------------------------------------------------------
-- 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
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


-- | 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
-> 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
                        -- 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
                        _ -> 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


-- | Compute the value for a given RunMode and a restore function to run
buildRunMode :: Global -> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode :: Global
-> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode
buildRunMode global :: Global
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


-- | Have the dependencies changed
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool
buildRunDependenciesChanged global :: Global
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 ()


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

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

    global :: Global
global@Global{..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Stack
localStack :: Local -> Stack
localStack :: Stack
localStack, Maybe String
localBlockApply :: Local -> Maybe String
localBlockApply :: Maybe String
localBlockApply} <- RAW ([String], [Key]) [Value] Global Local Local -> Action Local
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    let stack :: Stack
stack = [String] -> Stack -> Stack
addCallStack [String]
callStack Stack
localStack

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

    let database :: Database
database = Database
globalDatabase
    (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  -- 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
-> 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

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

        RAW ([String], [Key]) [Value] Global Local (RunResult Value, Local)
-> Action (RunResult Value, Local)
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW
   ([String], [Key]) [Value] Global Local (RunResult Value, Local)
 -> Action (RunResult Value, Local))
-> RAW
     ([String], [Key]) [Value] Global Local (RunResult Value, Local)
-> Action (RunResult Value, Local)
forall a b. (a -> b) -> a -> b
$ (Local -> (RunResult Value, Local))
-> RAW ([String], [Key]) [Value] Global Local Local
-> RAW
     ([String], [Key]) [Value] Global Local (RunResult Value, Local)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunResult Value
res,) RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW) Capture (Either SomeException (RunResult Value, Local))
-> Capture (Either SomeException (RunResult Value, Local))
forall a b. (a -> b) -> a -> b
$ \case
            Left 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)

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

-- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.
--   This function requires that appropriate rules have been added with 'addBuiltinRule'.
--   All @key@ values passed to 'apply' become dependencies of the 'Action'.
apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
apply :: [key] -> Action [value]
apply [] =
    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not
    [value] -> Action [value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
apply 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)


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



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

-- | Load a value from the history. Given a version from any user rule
--   (or @0@), return the payload that was stored by 'historySave'.
--
--   If this function returns 'Just' it will also have restored any files that
--   were saved by 'historySave'.
historyLoad :: Int -> Action (Maybe BS.ByteString)
historyLoad :: Int -> Action (Maybe (OneShot BS_Store))
historyLoad (Int -> Ver
Ver -> Ver
ver) = do
    global :: Global
global@Global{..} <- 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
        -- 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 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)


-- | Is the history enabled, returns 'True' if you have a 'shakeShare' or 'shakeCloud',
--   and haven't called 'historyDisable' so far in this rule.
historyIsEnabled :: Action Bool
historyIsEnabled :: Action Bool
historyIsEnabled = RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool)
-> RAW ([String], [Key]) [Value] Global Local Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ do
    Global{..} <- RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{Bool
localHistory :: Bool
localHistory :: Local -> Bool
localHistory} <- RAW ([String], [Key]) [Value] Global Local Local
forall k v ro rw. RAW k v ro rw rw
getRW
    Bool -> RAW ([String], [Key]) [Value] Global Local Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> RAW ([String], [Key]) [Value] Global Local Bool)
-> Bool -> RAW ([String], [Key]) [Value] Global Local Bool
forall a b. (a -> b) -> a -> b
$ Bool
localHistory Bool -> Bool -> Bool
&& (Maybe Shared -> Bool
forall a. Maybe a -> Bool
isJust Maybe Shared
globalShared Bool -> Bool -> Bool
|| Maybe Cloud -> Bool
forall a. Maybe a -> Bool
isJust Maybe Cloud
globalCloud)


-- | Save a value to the history. Record the version of any user rule
--   (or @0@), and a payload. Must be run at the end of the rule, after
--   any dependencies have been captured. If history is enabled, stores the information
--   in a cache.
--
--   This function relies on 'produces' to have been called correctly to describe
--   which files were written during the execution of this rule.
historySave :: Int -> BS.ByteString -> Action ()
historySave :: Int -> OneShot BS_Store -> Action ()
historySave (Int -> Ver
Ver -> Ver
ver) 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
        -- make sure we throw errors before we get into the history
        Ver -> IO Ver
forall a. a -> IO a
evaluate Ver
ver
        OneShot BS_Store -> IO (OneShot BS_Store)
forall a. a -> IO a
evaluate OneShot BS_Store
store
        Key
key <- Key -> IO Key
forall a. a -> IO a
evaluate (Key -> IO Key) -> Key -> IO Key
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe (String -> Key
forall a. Partial => String -> a
error "Can't call historySave outside a rule") (Maybe Key -> Key) -> Maybe Key -> Key
forall a b. (a -> b) -> a -> b
$ Stack -> Maybe Key
topStack Stack
localStack

        let produced :: [String]
produced = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, String) -> String
forall a b. (a, b) -> b
snd [(Bool, String)]
localProduces
        Maybe [[(Key, OneShot BS_Store)]]
deps <-
            -- can do this without the DB lock, since it reads things that are stable
            [Depends]
-> (Depends -> IO (Maybe [(Key, OneShot BS_Store)]))
-> IO (Maybe [[(Key, OneShot BS_Store)]])
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe [b])
forNothingM ([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"