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

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

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

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


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

setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()
setIdKeyStatus Global{Bool
Maybe Shared
Maybe Cloud
IO Double
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalBuild :: [String] -> [Key] -> Action [Value]
globalDatabase :: Database
globalPool :: Pool
globalCleanup :: Cleanup
globalTimestamp :: IO Double
globalRules :: HashMap TypeRep BuiltinRule
globalOutput :: Verbosity -> String -> IO ()
globalOptions :: ShakeOptions
globalDiagnostic :: IO String -> IO ()
globalRuleFinished :: Key -> Action ()
globalAfter :: IORef [IO ()]
globalTrackAbsent :: IORef [(Key, Key)]
globalProgress :: IO Progress
globalUserRules :: Map UserRuleVersioned
globalShared :: Maybe Shared
globalCloud :: Maybe Cloud
globalStep :: Step
globalOneShot :: Bool
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
..} Database
db Id
i Key
k Status
v = do
    IO () -> Locked ()
forall a. IO a -> Locked a
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
        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
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Missing" (Status -> String
statusType (Status -> String)
-> ((Key, Status) -> Status) -> (Key, Status) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd) Maybe (Key, Status)
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Status -> String
statusType Status
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> ((Key, Status) -> String) -> Maybe (Key, Status) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" (Key -> String
forall a. Show a => a -> String
show (Key -> String)
-> ((Key, Status) -> Key) -> (Key, Status) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Key
forall a b. (a, b) -> a
fst) Maybe (Key, Status)
old
        let changeValue = case Status
v of
                Ready Result (Value, OneShot BS_Store)
r -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"    = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Value, OneShot BS_Store) -> String
forall a. Show a => a -> String
showBracket (Result (Value, OneShot BS_Store) -> (Value, OneShot BS_Store)
forall a. Result a -> a
result Result (Value, OneShot BS_Store)
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    if Result (Value, OneShot BS_Store) -> Step
forall a. Result a -> Step
changed Result (Value, OneShot BS_Store)
r Step -> Step -> Bool
forall a. Eq a => a -> a -> Bool
== Step
globalStep then String
"(changed)"
                    else 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
== Step
globalStep then String
"(unchanged)"
                    else String
"(didn't run)"
                Status
_ -> Maybe String
forall a. Maybe a
Nothing
        pure $ changeStatus ++ maybe "" ("\n" ++) 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 :: forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value) =>
key -> Action (Maybe (Result (Either (OneShot BS_Store) value)))
getDatabaseValue key
k =
    (Maybe (Result (Either (OneShot BS_Store) Value))
 -> Maybe (Result (Either (OneShot BS_Store) value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) value)))
forall a b. (a -> b) -> Action a -> Action b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Result a -> Result b
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 a b.
(a -> b)
-> Either (OneShot BS_Store) a -> Either (OneShot BS_Store) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> value
forall a. Typeable a => Value -> a
fromValue) (Action (Maybe (Result (Either (OneShot BS_Store) Value)))
 -> Action (Maybe (Result (Either (OneShot BS_Store) value))))
-> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
-> Action (Maybe (Result (Either (OneShot BS_Store) value)))
forall a b. (a -> b) -> a -> b
$ Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
getDatabaseValueGeneric (Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value))))
-> Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
forall a b. (a -> b) -> a -> b
$ key -> Key
forall a. ShakeValue a => a -> Key
newKey key
k

getDatabaseValueGeneric :: Key -> Action (Maybe (Result (Either BS.ByteString Value)))
getDatabaseValueGeneric :: Key -> Action (Maybe (Result (Either (OneShot BS_Store) Value)))
getDatabaseValueGeneric Key
k = do
    Global{..} <- 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 <- liftIO $ getValueFromKey globalDatabase k
    pure $ getResult status


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

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


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


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


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


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

applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue :: [String] -> [Key] -> Action [Value]
applyKeyValue [String]
callStack [Key]
ks = do
    -- this is the only place a user can inject a key into our world, so check they aren't throwing
    -- in unevaluated bottoms
    IO () -> Action ()
forall a. IO a -> Action a
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{..} <- 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{localStack, localBlockApply} <- Action getRW
    let stack = [String] -> Stack -> Stack
addCallStack [String]
callStack Stack
localStack

    let 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
    whenJust localBlockApply $ throwM . errorNoApply tk (show <$> listToMaybe ks)

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

    case wait of
        Now Either SomeException [Value]
vs -> (SomeException -> Action [Value])
-> ([Value] -> Action [Value])
-> Either SomeException [Value]
-> Action [Value]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Action [Value]
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM [Value] -> Action [Value]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException [Value]
vs
        Wait Locked (Either SomeException [Value])
_ -> do
            offset <- IO (IO Double) -> Action (IO Double)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Double)
offsetTime
            vs <- Action $ captureRAW $ \Either SomeException [Value] -> IO ()
continue ->
                Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ Wait Locked (Either SomeException [Value])
-> (Either SomeException [Value] -> Locked ()) -> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Either SomeException [Value])
wait ((Either SomeException [Value] -> Locked ()) -> Locked ())
-> (Either SomeException [Value] -> Locked ()) -> Locked ()
forall a b. (a -> b) -> a -> b
$ \Either SomeException [Value]
x ->
                    IO () -> Locked ()
forall a. IO a -> Locked a
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
            offset <- liftIO offset
            Action $ modifyRW $ addDiscount offset
            pure vs


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

    let s = (Stack -> Verbosity -> Local
newLocal Stack
stack Verbosity
shakeVerbosity){localBuiltinVersion = builtinVersion}
    time <- offsetTime
    runAction global s (do
        res <- builtinRun k (fmap result r) mode
        liftIO $ evaluate $ rnf res

        -- completed, now track anything required afterwards
        when (runChanged res `elem` [ChangedRecomputeSame,ChangedRecomputeDiff]) $ do
            -- if the users code didn't run you don't have to check anything (we assume builtin rules are correct)
            globalRuleFinished k
            producesCheck

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

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

-- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.
--   This function requires that appropriate rules have been added with 'addBuiltinRule'.
--   All @key@ values passed to 'apply' become dependencies of the 'Action'.
apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]
apply :: forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
[key] -> Action [value]
apply [] =
    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not
    [value] -> Action [value]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
apply [key]
ks =
    ([Value] -> [value]) -> Action [Value] -> Action [value]
forall a b. (a -> b) -> Action a -> Action b
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 :: forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
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 a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [value] -> value
forall a. [a] -> a
headErr (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 a. a -> [a]
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{..} <- 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{localStack, localBuiltinVersion} <- Action getRW
    if isNothing globalShared && isNothing globalCloud then pure Nothing else do
        key <- liftIO $ evaluate $ fromMaybe (error "Can't call historyLoad outside a rule") $ topStack localStack
        let database = Database
globalDatabase
        res <- liftIO $ runLocked database $ runWait $ do
            let ask Key
k = do
                    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 = 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
                    either (const Nothing) identify <$> lookupOne global localStack database i
            x <- case globalShared of
                Maybe Shared
Nothing -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall a. a -> Wait Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. Maybe a
Nothing
                Just Shared
shared -> Shared
-> (Key -> Wait Locked (Maybe (OneShot BS_Store)))
-> Key
-> Ver
-> Ver
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
lookupShared Shared
shared Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
key Ver
localBuiltinVersion Ver
ver
            x <- case x of
                Just (OneShot BS_Store, [[Key]], IO ())
res -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall a. a -> Wait Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OneShot BS_Store, [[Key]], IO ())
 -> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ())))
-> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall a b. (a -> b) -> a -> b
$ (OneShot BS_Store, [[Key]], IO ())
-> Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. a -> Maybe a
Just (OneShot BS_Store, [[Key]], IO ())
res
                Maybe (OneShot BS_Store, [[Key]], IO ())
Nothing -> case Maybe Cloud
globalCloud of
                    Maybe Cloud
Nothing -> Maybe (OneShot BS_Store, [[Key]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
forall a. a -> Wait Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Key]], IO ())
forall a. Maybe a
Nothing
                    Just Cloud
cloud -> Cloud
-> (Key -> Wait Locked (Maybe (OneShot BS_Store)))
-> Key
-> Ver
-> Ver
-> Wait Locked (Maybe (OneShot BS_Store, [[Key]], IO ()))
lookupCloud Cloud
cloud Key -> Wait Locked (Maybe (OneShot BS_Store))
ask Key
key Ver
localBuiltinVersion Ver
ver
            case x of
                Maybe (OneShot BS_Store, [[Key]], IO ())
Nothing -> Maybe (OneShot BS_Store, [[Id]], IO ())
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a. a -> Wait Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Id]], IO ())
forall a. Maybe a
Nothing
                Just (OneShot BS_Store
a,[[Key]]
b,IO ()
c) -> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (m :: * -> *) a. Functor m => m a -> Wait m a
quickly (Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
 -> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ())))
-> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a b. (a -> b) -> a -> b
$ (OneShot BS_Store, [[Id]], IO ())
-> Maybe (OneShot BS_Store, [[Id]], IO ())
forall a. a -> Maybe a
Just ((OneShot BS_Store, [[Id]], IO ())
 -> Maybe (OneShot BS_Store, [[Id]], IO ()))
-> ([[Id]] -> (OneShot BS_Store, [[Id]], IO ()))
-> [[Id]]
-> Maybe (OneShot BS_Store, [[Id]], IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneShot BS_Store
a,,IO ()
c) ([[Id]] -> Maybe (OneShot BS_Store, [[Id]], IO ()))
-> Locked [[Id]]
-> Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Key] -> Locked [Id]) -> [[Key]] -> Locked [[Id]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
        res <- case res of
            Now Maybe (OneShot BS_Store, [[Id]], IO ())
x -> Maybe (OneShot BS_Store, [[Id]], IO ())
-> Action (Maybe (OneShot BS_Store, [[Id]], IO ()))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store, [[Id]], IO ())
x
            Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
_ -> do
                offset <- IO (IO Double) -> Action (IO Double)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (IO Double)
offsetTime
                res <- Action $ captureRAW $ \Either SomeException (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> IO ()
continue ->
                    Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
globalDatabase (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$ Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
-> (Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
-> Locked ()
forall (m :: * -> *) a. Monad m => Wait m a -> (a -> m ()) -> m ()
fromLater Wait Locked (Maybe (OneShot BS_Store, [[Id]], IO ()))
res ((Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
 -> Locked ())
-> (Maybe (OneShot BS_Store, [[Id]], IO ()) -> Locked ())
-> Locked ()
forall a b. (a -> b) -> a -> b
$ \Maybe (OneShot BS_Store, [[Id]], IO ())
x ->
                        IO () -> Locked ()
forall a. IO a -> Locked a
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
                offset <- liftIO offset
                Action $ modifyRW $ addDiscount offset
                pure res
        case res of
            Maybe (OneShot BS_Store, [[Id]], IO ())
Nothing -> Maybe (OneShot BS_Store) -> Action (Maybe (OneShot BS_Store))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneShot BS_Store)
forall a. Maybe a
Nothing
            Just (OneShot BS_Store
res, [[Id]]
deps, IO ()
restore) -> do
                IO () -> Action ()
forall a. IO a -> Action a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"History hit for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
key
                IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
restore
                RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ (Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ()
forall rw k v ro. (rw -> rw) -> RAW k v ro rw ()
modifyRW ((Local -> Local) -> RAW ([String], [Key]) [Value] Global Local ())
-> (Local -> Local)
-> RAW ([String], [Key]) [Value] Global Local ()
forall a b. (a -> b) -> a -> b
$ \Local
s -> Local
s{localDepends = newDepends $ map Depends deps}
                Maybe (OneShot BS_Store) -> Action (Maybe (OneShot BS_Store))
forall a. a -> Action a
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{localHistory} <- getRW
    pure $ localHistory && (isJust globalShared || isJust globalCloud)


-- | Save a value to the history. Record the version of any user rule
--   (or @0@), and a payload. Must be run at the end of the rule, after
--   any dependencies have been captured. If history is enabled, stores the information
--   in a cache.
--
--   This function relies on 'produces' to have been called correctly to describe
--   which files were written during the execution of this rule.
historySave :: Int -> BS.ByteString -> Action ()
historySave :: Int -> OneShot BS_Store -> Action ()
historySave (Int -> Ver
Ver -> Ver
ver) OneShot BS_Store
store = Action Bool -> Action () -> Action ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Action Bool
historyIsEnabled (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action (RAW ([String], [Key]) [Value] Global Local () -> Action ())
-> RAW ([String], [Key]) [Value] Global Local () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
    Global{..} <- RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    Local{localProduces, localDepends, localBuiltinVersion, localStack} <- getRW
    liftIO $ do
        -- make sure we throw errors before we get into the history
        evaluate ver
        evaluate store
        key <- evaluate $ fromMaybe (error "Can't call historySave outside a rule") $ topStack localStack

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


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