{-# LANGUAGE LambdaCase #-}{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}{-# LANGUAGE ConstraintKinds, TupleSections, ViewPatterns #-}{-# LANGUAGE TypeFamilies, NamedFieldPuns #-}moduleDevelopment.Shake.Internal.Core.Run(RunState ,open ,reset ,run ,shakeRunAfter ,liveFilesState ,profileState ,errorsState )whereimportControl.ExceptionimportData.Tuple.ExtraimportControl.Concurrent.Extrahiding(withNumCapabilities)importDevelopment.Shake.Internal.Core.Database importControl.Monad.IO.ClassimportGeneral.Binary importDevelopment.Shake.Classes importDevelopment.Shake.Internal.Core.Storage importDevelopment.Shake.Internal.Core.Build importDevelopment.Shake.Internal.History.Shared importDevelopment.Shake.Internal.History.Cloud importqualifiedGeneral.TypeMap asTMapimportControl.Monad.ExtraimportData.TypeableimportNumeric.ExtraimportData.List.ExtraimportqualifiedData.HashMap.StrictasMapimportqualifiedData.HashSetasSetimportData.DynamicimportData.MaybeimportData.IORef.ExtraimportSystem.DirectoryimportSystem.Time.ExtraimportqualifiedData.ByteStringasBSimportDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Action importDevelopment.Shake.Internal.Core.Rules importGeneral.Pool importDevelopment.Shake.Internal.Progress importDevelopment.Shake.Internal.Value importDevelopment.Shake.Internal.Profile importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Errors importGeneral.Timing importGeneral.Thread importGeneral.Extra importGeneral.Cleanup importData.MonoidimportPrelude----------------------------------------------------------------------- MAKEdataRunState =RunState {RunState -> ShakeOptions
opts ::ShakeOptions ,RunState -> HashMap TypeRep BuiltinRule
builtinRules ::Map.HashMapTypeRepBuiltinRule ,RunState -> Map UserRuleVersioned
userRules ::TMap.Map UserRuleVersioned ,RunState -> Database
database ::Database ,RunState -> String
curdir ::FilePath,RunState -> Maybe Shared
shared ::MaybeShared ,RunState -> Maybe Cloud
cloud ::MaybeCloud ,RunState -> [(Stack, Action ())]
actions ::[(Stack ,Action ())]}open ::Cleanup ->ShakeOptions ->Rules ()->IORunState open :: Cleanup -> ShakeOptions -> Rules () -> IO RunState
open Cleanup
cleanup ShakeOptions
opts Rules ()
rs =ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO RunState)
-> IO RunState
forall a.
ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO RunState)
 -> IO RunState)
-> (ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO RunState)
-> IO RunState
forall a b. (a -> b) -> a -> b
$\opts :: ShakeOptions
opts @ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
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 Seconds
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
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
.. }IO String -> IO ()
diagnostic Verbosity -> String -> IO ()
_->doIO String -> IO ()
diagnostic (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
pureString
"Starting run"SRules {[(Stack, Action ())]
actions :: [(Stack, Action ())]
actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
actions ,HashMap TypeRep BuiltinRule
builtinRules :: HashMap TypeRep BuiltinRule
builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
builtinRules ,Map UserRuleVersioned
userRules :: Map UserRuleVersioned
userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules }<-ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs IO String -> IO ()
diagnostic (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
"Number of actions = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show([(Stack, Action ())] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[(Stack, Action ())]
actions )IO String -> IO ()
diagnostic (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
"Number of builtin rules = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show(HashMap TypeRep BuiltinRule -> Int
forall k v. HashMap k v -> Int
Map.sizeHashMap TypeRep BuiltinRule
builtinRules )String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++[TypeRep] -> String
forall a. Show a => a -> String
show(HashMap TypeRep BuiltinRule -> [TypeRep]
forall k v. HashMap k v -> [k]
Map.keysHashMap TypeRep BuiltinRule
builtinRules )IO String -> IO ()
diagnostic (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
"Number of user rule types = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show(Map UserRuleVersioned -> Int
forall (f :: * -> *). Map f -> Int
TMap.size Map UserRuleVersioned
userRules )IO String -> IO ()
diagnostic (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
"Number of user rules = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum((forall a. UserRuleVersioned a -> Int)
-> Map UserRuleVersioned -> [Int]
forall (f :: * -> *) b. (forall a. f a -> b) -> Map f -> [b]
TMap.toList (UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize (UserRule a -> Int)
-> (UserRuleVersioned a -> UserRule a)
-> UserRuleVersioned a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UserRuleVersioned a -> UserRule a
forall a. UserRuleVersioned a -> UserRule a
userRuleContents )Map UserRuleVersioned
userRules ))HashMap TypeRep Dynamic -> IO ()
checkShakeExtra HashMap TypeRep Dynamic
shakeExtra String
curdir <-IO String
getCurrentDirectoryDatabase
database <-Cleanup
-> ShakeOptions
-> (IO String -> IO ())
-> HashMap TypeRep BuiltinRule
-> IO Database
usingDatabase Cleanup
cleanup ShakeOptions
opts IO String -> IO ()
diagnostic HashMap TypeRep BuiltinRule
builtinRules (Maybe Shared
shared ,Maybe Cloud
cloud )<-Database
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
forall k v.
DatabasePoly k v
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
loadSharedCloud Database
database ShakeOptions
opts HashMap TypeRep BuiltinRule
builtinRules RunState -> IO RunState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureRunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
opts :: ShakeOptions
actions :: [(Stack, Action ())]
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
curdir :: String
database :: Database
shared :: Maybe Shared
cloud :: Maybe Cloud
.. }-- Prepare for a fresh run by changing Result to Loadedreset ::RunState ->IO()reset :: RunState -> IO ()
reset RunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: RunState -> ShakeOptions
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
userRules :: RunState -> Map UserRuleVersioned
database :: RunState -> Database
curdir :: RunState -> String
shared :: RunState -> Maybe Shared
cloud :: RunState -> Maybe Cloud
actions :: RunState -> [(Stack, Action ())]
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
.. }=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
$Database -> (Status -> Status) -> Locked ()
forall k v. DatabasePoly k v -> (v -> v) -> Locked ()
modifyAllMem Database
database Status -> Status
f wheref :: Status -> Status
f (Ready Result (Value, BS_Store)
r )=Result BS_Store -> Status
Loaded ((Value, BS_Store) -> BS_Store
forall a b. (a, b) -> b
snd((Value, BS_Store) -> BS_Store)
-> Result (Value, BS_Store) -> Result BS_Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Result (Value, BS_Store)
r )f (Failed SomeException
_OneShot (Maybe (Result BS_Store))
x )=Status
-> (Result BS_Store -> Status)
-> OneShot (Maybe (Result BS_Store))
-> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybeStatus
Missing Result BS_Store -> Status
Loaded OneShot (Maybe (Result BS_Store))
x f (Running NoShow
 (Either SomeException (Result (Value, BS_Store)) -> Locked ())
_OneShot (Maybe (Result BS_Store))
x )=Status
-> (Result BS_Store -> Status)
-> OneShot (Maybe (Result BS_Store))
-> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybeStatus
Missing Result BS_Store -> Status
Loaded OneShot (Maybe (Result BS_Store))
x -- shouldn't ever happen, but Loaded is least worstf Status
x =Status
x run ::RunState ->Bool->[Action ()]->IO[IO()]run :: RunState -> Bool -> [Action ()] -> IO [IO ()]
run RunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: RunState -> ShakeOptions
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
userRules :: RunState -> Map UserRuleVersioned
database :: RunState -> Database
curdir :: RunState -> String
shared :: RunState -> Maybe Shared
cloud :: RunState -> Maybe Cloud
actions :: RunState -> [(Stack, Action ())]
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
.. }Bool
oneshot [Action ()]
actions2 =ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO [IO ()])
-> IO [IO ()]
forall a.
ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO [IO ()])
 -> IO [IO ()])
-> (ShakeOptions
 -> (IO String -> IO ())
 -> (Verbosity -> String -> IO ())
 -> IO [IO ()])
-> IO [IO ()]
forall a b. (a -> b) -> a -> b
$\opts :: ShakeOptions
opts @ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }IO String -> IO ()
diagnostic Verbosity -> String -> IO ()
output ->do-- timings are a bit delicate, we want to make sure we clear them before we leave (so each run is fresh)-- but we also want to only print them if there is no exception, and have to caputre them before we clear them-- we use this variable to stash them away, then print after the exception handling blockIORef (Maybe [String])
timingsToShow <-Maybe [String] -> IO (IORef (Maybe [String]))
forall a. a -> IO (IORef a)
newIORefMaybe [String]
forall a. Maybe a
Nothing[IO ()]
res <-(Cleanup -> IO [IO ()]) -> IO [IO ()]
forall a. (Cleanup -> IO a) -> IO a
withCleanup ((Cleanup -> IO [IO ()]) -> IO [IO ()])
-> (Cleanup -> IO [IO ()]) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$\Cleanup
cleanup ->doCleanup -> IO () -> IO ReleaseKey
register Cleanup
cleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
forall a b. (a -> b) -> a -> b
$doBool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Bool
shakeTimings Bool -> Bool -> Bool
&&Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>=Verbosity
Info )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IORef (Maybe [String]) -> Maybe [String] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORefIORef (Maybe [String])
timingsToShow (Maybe [String] -> IO ())
-> ([String] -> Maybe [String]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> Maybe [String]
forall a. a -> Maybe a
Just([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<IO [String]
getTimings IO ()
resetTimings IO Seconds
start <-IO (IO Seconds)
offsetTimeIORef (Maybe (String, ShakeException))
except <-Maybe (String, ShakeException)
-> IO (IORef (Maybe (String, ShakeException)))
forall a. a -> IO (IORef a)
newIORef(Maybe (String, ShakeException)
forall a. Maybe a
Nothing::Maybe(String,ShakeException ))letgetFailure :: IO (Maybe String)
getFailure =((String, ShakeException) -> String)
-> Maybe (String, ShakeException) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(String, ShakeException) -> String
forall a b. (a, b) -> a
fst(Maybe (String, ShakeException) -> Maybe String)
-> IO (Maybe (String, ShakeException)) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>IORef (Maybe (String, ShakeException))
-> IO (Maybe (String, ShakeException))
forall a. IORef a -> IO a
readIORefIORef (Maybe (String, ShakeException))
except letraiseError :: ShakeException -> IO ()
raiseError ShakeException
err |Bool -> Bool
notBool
shakeStaunch =ShakeException -> IO ()
forall e a. Exception e => e -> IO a
throwIOShakeException
err |Bool
otherwise=doletnamed :: ShakeException -> String
named =ShakeOptions -> String -> String
shakeAbbreviationsApply ShakeOptions
opts (String -> String)
-> (ShakeException -> String) -> ShakeException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShakeException -> String
shakeExceptionTarget IORef (Maybe (String, ShakeException))
-> (Maybe (String, ShakeException)
 -> (Maybe (String, ShakeException), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORefIORef (Maybe (String, ShakeException))
except ((Maybe (String, ShakeException)
 -> (Maybe (String, ShakeException), ()))
 -> IO ())
-> (Maybe (String, ShakeException)
 -> (Maybe (String, ShakeException), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$\Maybe (String, ShakeException)
v ->((String, ShakeException) -> Maybe (String, ShakeException)
forall a. a -> Maybe a
Just((String, ShakeException) -> Maybe (String, ShakeException))
-> (String, ShakeException) -> Maybe (String, ShakeException)
forall a b. (a -> b) -> a -> b
$(String, ShakeException)
-> Maybe (String, ShakeException) -> (String, ShakeException)
forall a. a -> Maybe a -> a
fromMaybe(ShakeException -> String
named ShakeException
err ,ShakeException
err )Maybe (String, ShakeException)
v ,())-- no need to print exceptions here, they get printed when they are wrappedIORef [IO ()]
after <-[IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef[]IORef [(Key, Key)]
absent <-[(Key, Key)] -> IO (IORef [(Key, Key)])
forall a. a -> IO (IORef a)
newIORef[]Step
step <-Database -> IO Step
incrementStep Database
database IO Progress
getProgress <-Cleanup
-> ShakeOptions
-> Database
-> Step
-> IO (Maybe String)
-> IO (IO Progress)
usingProgress Cleanup
cleanup ShakeOptions
opts Database
database Step
step IO (Maybe String)
getFailure String -> String -> IO ()
lintCurrentDirectory String
curdir String
"When running"String -> IO ()
watch <-[String] -> IO (String -> IO ())
lintWatch [String]
shakeLintWatch letruleFinished :: Key -> Action ()
ruleFinished |Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJustMaybe Lint
shakeLint =\Key
k ->doIO () -> 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
$String -> String -> IO ()
lintCurrentDirectory String
curdir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$Key -> String
forall a. Show a => a -> String
showKey
k Action ()
lintTrackFinished 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
$String -> IO ()
watch (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$Key -> String
forall a. Show a => a -> String
showKey
k |Bool
otherwise=IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO(IO () -> Action ()) -> (Key -> IO ()) -> Key -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> IO ()
watch (String -> IO ()) -> (Key -> String) -> Key -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Key -> String
forall a. Show a => a -> String
showString -> IO ()
addTiming String
"Running rules"IORef [Local]
locals <-[Local] -> IO (IORef [Local])
forall a. a -> IO (IORef a)
newIORef[]Bool -> Int -> (Pool -> IO ()) -> IO ()
runPool (Int
shakeThreads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1)Int
shakeThreads ((Pool -> IO ()) -> IO ()) -> (Pool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Pool
pool ->doletglobal :: Global
global =([String] -> [Key] -> Action [Value])
-> Database
-> Pool
-> Cleanup
-> IO Seconds
-> HashMap TypeRep BuiltinRule
-> (Verbosity -> String -> IO ())
-> ShakeOptions
-> (IO String -> IO ())
-> (Key -> Action ())
-> IORef [IO ()]
-> IORef [(Key, Key)]
-> IO Progress
-> Map UserRuleVersioned
-> Maybe Shared
-> Maybe Cloud
-> Step
-> Bool
-> Global
Global [String] -> [Key] -> Action [Value]
applyKeyValue Database
database Pool
pool Cleanup
cleanup IO Seconds
start HashMap TypeRep BuiltinRule
builtinRules Verbosity -> String -> IO ()
output ShakeOptions
opts IO String -> IO ()
diagnostic Key -> Action ()
ruleFinished IORef [IO ()]
after IORef [(Key, Key)]
absent IO Progress
getProgress Map UserRuleVersioned
userRules Maybe Shared
shared Maybe Cloud
cloud Step
step Bool
oneshot -- give each action a stack to start with![(Stack, Action ())] -> ((Stack, Action ()) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_([(Stack, Action ())]
actions [(Stack, Action ())]
-> [(Stack, Action ())] -> [(Stack, Action ())]
forall a. [a] -> [a] -> [a]
++(Action () -> (Stack, Action ()))
-> [Action ()] -> [(Stack, Action ())]
forall a b. (a -> b) -> [a] -> [b]
map(Stack
emptyStack ,)[Action ()]
actions2 )(((Stack, Action ()) -> IO ()) -> IO ())
-> ((Stack, Action ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(Stack
stack ,Action ()
act )->doletlocal :: Local
local =Stack -> Verbosity -> Local
newLocal Stack
stack Verbosity
shakeVerbosity PoolPriority -> Pool -> IO () -> IO ()
forall a. PoolPriority -> Pool -> IO a -> IO ()
addPool PoolPriority
PoolStart Pool
pool (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Global
-> Local -> Action Local -> Capture (Either SomeException Local)
forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
global Local
local (Action ()
act Action () -> Action Local -> Action Local
forall a b. Action a -> Action b -> Action b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Action Local
getLocal )Capture (Either SomeException Local)
-> Capture (Either SomeException Local)
forall a b. (a -> b) -> a -> b
$\caseLeftSomeException
e ->ShakeException -> IO ()
raiseError (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 RightLocal
local ->IORef [Local] -> ([Local] -> [Local]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_IORef [Local]
locals (Local
local Local -> [Local] -> [Local]
forall a. a -> [a] -> [a]
:)IO (Maybe (String, ShakeException))
-> ((String, ShakeException) -> IO ()) -> IO ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM(IORef (Maybe (String, ShakeException))
-> IO (Maybe (String, ShakeException))
forall a. IORef a -> IO a
readIORefIORef (Maybe (String, ShakeException))
except )(ShakeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO(ShakeException -> IO ())
-> ((String, ShakeException) -> ShakeException)
-> (String, ShakeException)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, ShakeException) -> ShakeException
forall a b. (a, b) -> b
snd)Database -> IO ()
assertFinishedDatabase Database
database letputWhen :: Verbosity -> String -> IO ()
putWhen Verbosity
lvl String
msg =Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>=Verbosity
lvl )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Verbosity -> String -> IO ()
output Verbosity
lvl String
msg [Local]
locals <-IORef [Local] -> IO [Local]
forall a. IORef a -> IO a
readIORefIORef [Local]
locals Seconds
end <-IO Seconds
start if[(Stack, Action ())] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[(Stack, Action ())]
actions Bool -> Bool -> Bool
&&[Action ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[Action ()]
actions2 thenVerbosity -> String -> IO ()
putWhen Verbosity
Info String
"Warning: No want/action statements, nothing to do"elseStep -> [Local] -> Seconds -> Database -> IO ()
recordRoot Step
step [Local]
locals Seconds
end Database
database Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Maybe Lint -> Bool
forall a. Maybe a -> Bool
isJustMaybe Lint
shakeLint )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doString -> IO ()
addTiming String
"Lint checking"String -> String -> IO ()
lintCurrentDirectory String
curdir String
"After completion"(IO String -> IO ())
-> Database
-> (Key -> Value -> IO (Maybe String))
-> [(Key, Key)]
-> IO ()
checkValid IO String -> IO ()
diagnostic Database
database (HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)
runLint HashMap TypeRep BuiltinRule
builtinRules )([(Key, Key)] -> IO ()) -> IO [(Key, Key)] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<IORef [(Key, Key)] -> IO [(Key, Key)]
forall a. IORef a -> IO a
readIORefIORef [(Key, Key)]
absent Verbosity -> String -> IO ()
putWhen Verbosity
Verbose String
"Lint checking succeeded"Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when([String]
shakeReport [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/=[])(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doString -> IO ()
addTiming String
"Profile report"[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[String]
shakeReport ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\String
file ->doVerbosity -> String -> IO ()
putWhen Verbosity
Info (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$String
"Writing report to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
file String -> Database -> IO ()
writeProfile String
file Database
database Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when([String]
shakeLiveFiles [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/=[])(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doString -> IO ()
addTiming String
"Listing live"IO String -> IO ()
diagnostic (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
pureString
"Listing live keys"[String]
xs <-Database -> IO [String]
liveFiles Database
database [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[String]
shakeLiveFiles ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\String
file ->doVerbosity -> String -> IO ()
putWhen Verbosity
Info (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$String
"Writing live list to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
file (ifString
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"-"thenString -> IO ()
putStrelseString -> String -> IO ()
writeFileString
file )(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$[String] -> String
unlines[String]
xs [IO ()]
res <-IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORefIORef [IO ()]
after String -> IO ()
addTiming String
"Cleanup"[IO ()] -> IO [IO ()]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[IO ()]
res IO (Maybe [String]) -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM(IORef (Maybe [String]) -> IO (Maybe [String])
forall a. IORef a -> IO a
readIORefIORef (Maybe [String])
timingsToShow )(([String] -> IO ()) -> IO ()) -> ([String] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$String -> IO ()
putStr(String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
unlines[IO ()] -> IO [IO ()]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[IO ()]
res -- | Run a set of IO actions, treated as \"after\" actions, typically returned from-- 'Development.Shake.Database.shakeRunDatabase'. The actions will be run with diagnostics-- etc as specified in the 'ShakeOptions'.shakeRunAfter ::ShakeOptions ->[IO()]->IO()shakeRunAfter :: ShakeOptions -> [IO ()] -> IO ()
shakeRunAfter ShakeOptions
_[]=() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()shakeRunAfter ShakeOptions
opts [IO ()]
after =ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO ())
-> IO ()
forall a.
ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a)
-> IO a
withInit ShakeOptions
opts ((ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO ())
 -> IO ())
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$\ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }IO String -> IO ()
diagnostic Verbosity -> String -> IO ()
_->doletn :: String
n =Int -> String
forall a. Show a => a -> String
show(Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$[IO ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[IO ()]
after IO String -> IO ()
diagnostic (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
"Running "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" after actions"(Seconds
time ,()
_)<-IO () -> IO (Seconds, ())
forall (m :: * -> *) a. MonadIO m => m a -> m (Seconds, a)
duration(IO () -> IO (Seconds, ())) -> IO () -> IO (Seconds, ())
forall a b. (a -> b) -> a -> b
$[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$[IO ()] -> [IO ()]
forall a. [a] -> [a]
reverse[IO ()]
after Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Bool
shakeTimings Bool -> Bool -> Bool
&&Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>=Verbosity
Info )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$String -> IO ()
putStrLn(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$String
"(+ running "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
n String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" after actions in "String -> String -> String
forall a. [a] -> [a] -> [a]
++Seconds -> String
showDurationSeconds
time String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"withInit ::ShakeOptions ->(ShakeOptions ->(IOString->IO())->(Verbosity ->String->IO())->IOa )->IOa withInit :: forall a.
ShakeOptions
-> (ShakeOptions
 -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a)
-> IO a
withInit ShakeOptions
opts ShakeOptions
-> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a
act =(Cleanup -> IO a) -> IO a
forall a. (Cleanup -> IO a) -> IO a
withCleanup ((Cleanup -> IO a) -> IO a) -> (Cleanup -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$\Cleanup
cleanup ->doopts :: ShakeOptions
opts @ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }<-Cleanup -> ShakeOptions -> IO ShakeOptions
usingShakeOptions Cleanup
cleanup ShakeOptions
opts (IO String -> IO ()
diagnostic ,Verbosity -> String -> IO ()
output )<-ShakeOptions
-> Lock -> (IO String -> IO (), Verbosity -> String -> IO ())
outputFunctions ShakeOptions
opts (Lock -> (IO String -> IO (), Verbosity -> String -> IO ()))
-> IO Lock -> IO (IO String -> IO (), Verbosity -> String -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>IO Lock
newLockShakeOptions
-> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a
act ShakeOptions
opts IO String -> IO ()
diagnostic Verbosity -> String -> IO ()
output usingShakeOptions ::Cleanup ->ShakeOptions ->IOShakeOptions usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions
usingShakeOptions Cleanup
cleanup ShakeOptions
opts =doopts :: ShakeOptions
opts @ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }<-ifShakeOptions -> Int
shakeThreads ShakeOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0thenShakeOptions -> IO ShakeOptions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureShakeOptions
opts elsedoInt
p <-IO Int
getProcessorCount ;ShakeOptions -> IO ShakeOptions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureShakeOptions
opts {shakeThreads =p }Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
shakeLineBuffering (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Cleanup -> IO ()
usingLineBuffering Cleanup
cleanup Cleanup -> Int -> IO ()
usingNumCapabilities Cleanup
cleanup Int
shakeThreads ShakeOptions -> IO ShakeOptions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureShakeOptions
opts outputFunctions ::ShakeOptions ->Lock->(IOString->IO(),Verbosity ->String->IO())outputFunctions :: ShakeOptions
-> Lock -> (IO String -> IO (), Verbosity -> String -> IO ())
outputFunctions opts :: ShakeOptions
opts @ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }Lock
outputLock =(IO String -> IO ()
diagnostic ,Verbosity -> String -> IO ()
output )whereoutputLocked :: Verbosity -> String -> IO ()
outputLocked Verbosity
v String
msg =Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLockLock
outputLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Verbosity -> String -> IO ()
shakeOutput Verbosity
v String
msg diagnostic :: IO String -> IO ()
diagnostic |Verbosity
shakeVerbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<Verbosity
Diagnostic =IO () -> IO String -> IO ()
forall a b. a -> b -> a
const(IO () -> IO String -> IO ()) -> IO () -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()|Bool
otherwise=\IO String
act ->doString
v <-IO String
act ;Verbosity -> String -> IO ()
outputLocked Verbosity
Diagnostic (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$String
"% "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
v output :: Verbosity -> String -> IO ()
output Verbosity
v =Verbosity -> String -> IO ()
outputLocked Verbosity
v (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShakeOptions -> String -> String
shakeAbbreviationsApply ShakeOptions
opts usingProgress ::Cleanup ->ShakeOptions ->Database ->Step ->IO(MaybeString)->IO(IOProgress )usingProgress :: Cleanup
-> ShakeOptions
-> Database
-> Step
-> IO (Maybe String)
-> IO (IO Progress)
usingProgress Cleanup
cleanup ShakeOptions {Bool
Int
String
[String]
[(String, String)]
[(Rebuild, String)]
[CmdOption]
Maybe Seconds
Maybe String
Maybe Lint
HashMap TypeRep Dynamic
Verbosity
Change
String -> String -> Bool -> IO ()
IO Progress -> IO ()
Verbosity -> String -> IO ()
shakeFiles :: ShakeOptions -> String
shakeThreads :: ShakeOptions -> Int
shakeVersion :: ShakeOptions -> String
shakeVerbosity :: ShakeOptions -> Verbosity
shakeStaunch :: ShakeOptions -> Bool
shakeReport :: ShakeOptions -> [String]
shakeLint :: ShakeOptions -> Maybe Lint
shakeLintInside :: ShakeOptions -> [String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintWatch :: ShakeOptions -> [String]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeFlush :: ShakeOptions -> Maybe Seconds
shakeRebuild :: ShakeOptions -> [(Rebuild, String)]
shakeAbbreviations :: ShakeOptions -> [(String, String)]
shakeStorageLog :: ShakeOptions -> Bool
shakeLineBuffering :: ShakeOptions -> Bool
shakeTimings :: ShakeOptions -> Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeChange :: ShakeOptions -> Change
shakeCreationCheck :: ShakeOptions -> Bool
shakeLiveFiles :: ShakeOptions -> [String]
shakeVersionIgnore :: ShakeOptions -> Bool
shakeColor :: ShakeOptions -> Bool
shakeShare :: ShakeOptions -> Maybe String
shakeCloud :: ShakeOptions -> [String]
shakeSymlink :: ShakeOptions -> Bool
shakeNeedDirectory :: ShakeOptions -> Bool
shakeAllowRedefineRules :: ShakeOptions -> Bool
shakeProgress :: ShakeOptions -> IO Progress -> IO ()
shakeOutput :: ShakeOptions -> Verbosity -> String -> IO ()
shakeTrace :: ShakeOptions -> String -> String -> Bool -> IO ()
shakeExtra :: ShakeOptions -> HashMap TypeRep Dynamic
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 Seconds
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
.. }Database
database Step
step IO (Maybe String)
getFailure =doletgetProgress :: IO Progress
getProgress =doMaybe String
failure <-IO (Maybe String)
getFailure Progress
stats <-Database -> Step -> IO Progress
progress Database
database Step
step Progress -> IO Progress
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureProgress
stats {isFailure =failure }Cleanup -> IO () -> IO ()
allocateThread Cleanup
cleanup (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IO Progress -> IO ()
shakeProgress IO Progress
getProgress IO Progress -> IO (IO Progress)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureIO Progress
getProgress checkShakeExtra ::Map.HashMapTypeRepDynamic->IO()checkShakeExtra :: HashMap TypeRep Dynamic -> IO ()
checkShakeExtra HashMap TypeRep Dynamic
mp =doletbad :: [(TypeRep, TypeRep)]
bad =[(TypeRep
k ,TypeRep
t )|(TypeRep
k ,Dynamic
v )<-HashMap TypeRep Dynamic -> [(TypeRep, Dynamic)]
forall k v. HashMap k v -> [(k, v)]
Map.toListHashMap TypeRep Dynamic
mp ,lett :: TypeRep
t =Dynamic -> TypeRep
dynTypeRepDynamic
v ,TypeRep
t TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/=TypeRep
k ]case[(TypeRep, TypeRep)]
bad of(TypeRep
k ,TypeRep
t ):[(TypeRep, TypeRep)]
xs ->SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO(SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$String -> [(String, Maybe String)] -> String -> SomeException
errorStructured String
"Invalid Map in shakeExtra"[(String
"Key",String -> Maybe String
forall a. a -> Maybe a
Just(String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$TypeRep -> String
forall a. Show a => a -> String
showTypeRep
k ),(String
"Value type",String -> Maybe String
forall a. a -> Maybe a
Just(String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$TypeRep -> String
forall a. Show a => a -> String
showTypeRep
t )](if[(TypeRep, TypeRep)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[(TypeRep, TypeRep)]
xs thenString
""elseString
"Plus "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show([(TypeRep, TypeRep)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[(TypeRep, TypeRep)]
xs )String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" other keys")[(TypeRep, TypeRep)]
_->() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure()runLint ::Map.HashMapTypeRepBuiltinRule ->Key ->Value ->IO(MaybeString)runLint :: HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)
runLint HashMap TypeRep BuiltinRule
mp Key
k Value
v =caseTypeRep -> 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 ofMaybe BuiltinRule
Nothing->Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe String
forall a. Maybe a
NothingJustBuiltinRule {String
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
Key -> Value -> IO (Maybe String)
builtinLint :: Key -> Value -> IO (Maybe String)
builtinIdentity :: BuiltinIdentity Key Value
builtinRun :: BuiltinRun Key Value
builtinKey :: BinaryOp Key
builtinVersion :: Ver
builtinLocation :: String
builtinLint :: BuiltinRule -> Key -> Value -> IO (Maybe String)
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinKey :: BuiltinRule -> BinaryOp Key
builtinVersion :: BuiltinRule -> Ver
builtinLocation :: BuiltinRule -> String
.. }->Key -> Value -> IO (Maybe String)
builtinLint Key
k Value
v assertFinishedDatabase ::Database ->IO()assertFinishedDatabase :: Database -> IO ()
assertFinishedDatabase Database
database =do-- if you have anyone Waiting, and are not exiting with an error, then must have a complex recursion (see #400)[(Key, Status)]
status <-Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database letbad :: [Key]
bad =[Key
key |(Key
key ,Running {})<-[(Key, Status)]
status ]Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when([Key]
bad [Key] -> [Key] -> Bool
forall a. Eq a => a -> a -> Bool
/=[])(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$[String] -> SomeException
errorComplexRecursion ((Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
mapKey -> String
forall a. Show a => a -> String
show[Key]
bad )liveFilesState ::RunState ->IO[FilePath]liveFilesState :: RunState -> IO [String]
liveFilesState RunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: RunState -> ShakeOptions
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
userRules :: RunState -> Map UserRuleVersioned
database :: RunState -> Database
curdir :: RunState -> String
shared :: RunState -> Maybe Shared
cloud :: RunState -> Maybe Cloud
actions :: RunState -> [(Stack, Action ())]
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
.. }=Database -> IO [String]
liveFiles Database
database profileState ::RunState ->FilePath->IO()profileState :: RunState -> String -> IO ()
profileState RunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: RunState -> ShakeOptions
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
userRules :: RunState -> Map UserRuleVersioned
database :: RunState -> Database
curdir :: RunState -> String
shared :: RunState -> Maybe Shared
cloud :: RunState -> Maybe Cloud
actions :: RunState -> [(Stack, Action ())]
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
.. }String
file =String -> Database -> IO ()
writeProfile String
file Database
database liveFiles ::Database ->IO[FilePath]liveFiles :: Database -> IO [String]
liveFiles Database
database =do[(Key, Status)]
status <-Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database letspecialIsFileKey :: TypeRep -> Bool
specialIsFileKey TypeRep
t =TyCon -> String
forall a. Show a => a -> String
show((TyCon, [TypeRep]) -> TyCon
forall a b. (a, b) -> a
fst((TyCon, [TypeRep]) -> TyCon) -> (TyCon, [TypeRep]) -> TyCon
forall a b. (a -> b) -> a -> b
$TypeRep -> (TyCon, [TypeRep])
splitTyConAppTypeRep
t )String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"FileQ"[String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[Key -> String
forall a. Show a => a -> String
showKey
k |(Key
k ,Ready {})<-[(Key, Status)]
status ,TypeRep -> Bool
specialIsFileKey (TypeRep -> Bool) -> TypeRep -> Bool
forall a b. (a -> b) -> a -> b
$Key -> TypeRep
typeKey Key
k ]errorsState ::RunState ->IO[(String,SomeException)]errorsState :: RunState -> IO [(String, SomeException)]
errorsState RunState {String
[(Stack, Action ())]
Maybe Shared
Maybe Cloud
HashMap TypeRep BuiltinRule
ShakeOptions
Database
Map UserRuleVersioned
opts :: RunState -> ShakeOptions
builtinRules :: RunState -> HashMap TypeRep BuiltinRule
userRules :: RunState -> Map UserRuleVersioned
database :: RunState -> Database
curdir :: RunState -> String
shared :: RunState -> Maybe Shared
cloud :: RunState -> Maybe Cloud
actions :: RunState -> [(Stack, Action ())]
opts :: ShakeOptions
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
database :: Database
curdir :: String
shared :: Maybe Shared
cloud :: Maybe Cloud
actions :: [(Stack, Action ())]
.. }=do[(Key, Status)]
status <-Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
database [(String, SomeException)] -> IO [(String, SomeException)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[(Key -> String
forall a. Show a => a -> String
showKey
k ,SomeException
e )|(Key
k ,Failed SomeException
e OneShot (Maybe (Result BS_Store))
_)<-[(Key, Status)]
status ]checkValid ::(IOString->IO())->Database ->(Key ->Value ->IO(MaybeString))->[(Key ,Key )]->IO()checkValid :: (IO String -> IO ())
-> Database
-> (Key -> Value -> IO (Maybe String))
-> [(Key, Key)]
-> IO ()
checkValid IO String -> IO ()
diagnostic Database
db Key -> Value -> IO (Maybe String)
check [(Key, Key)]
absent =do[(Key, Status)]
status <-Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
db IO String -> IO ()
diagnostic (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
pureString
"Starting validity/lint checking"-- TEST 1: Have values changed since being depended on-- Do not use a forM here as you use too much stack space[(Key, (Value, BS_Store), String)]
bad <-(\[(Key, (Value, BS_Store), String)]
-> (Key, Status) -> IO [(Key, (Value, BS_Store), String)]
f ->([(Key, (Value, BS_Store), String)]
 -> (Key, Status) -> IO [(Key, (Value, BS_Store), String)])
-> [(Key, (Value, BS_Store), String)]
-> [(Key, Status)]
-> IO [(Key, (Value, BS_Store), String)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM[(Key, (Value, BS_Store), String)]
-> (Key, Status) -> IO [(Key, (Value, BS_Store), String)]
f [][(Key, Status)]
status )(([(Key, (Value, BS_Store), String)]
 -> (Key, Status) -> IO [(Key, (Value, BS_Store), String)])
 -> IO [(Key, (Value, BS_Store), String)])
-> ([(Key, (Value, BS_Store), String)]
 -> (Key, Status) -> IO [(Key, (Value, BS_Store), String)])
-> IO [(Key, (Value, BS_Store), String)]
forall a b. (a -> b) -> a -> b
$\[(Key, (Value, BS_Store), String)]
seen (Key, Status)
v ->case(Key, Status)
v of(Key
key ,Ready Result {Float
[Depends]
[Trace]
(Value, BS_Store)
Step
result :: (Value, BS_Store)
built :: Step
changed :: Step
depends :: [Depends]
execution :: Float
traces :: [Trace]
result :: forall a. Result a -> a
built :: forall a. Result a -> Step
changed :: forall a. Result a -> Step
depends :: forall a. Result a -> [Depends]
execution :: forall a. Result a -> Float
traces :: forall a. Result a -> [Trace]
.. })->doMaybe String
good <-Key -> Value -> IO (Maybe String)
check Key
key (Value -> IO (Maybe String)) -> Value -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$(Value, BS_Store) -> Value
forall a b. (a, b) -> a
fst(Value, BS_Store)
result IO String -> IO ()
diagnostic (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
"Checking if "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key -> String
forall a. Show a => a -> String
showKey
key String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Value, BS_Store) -> String
forall a. Show a => a -> String
show(Value, BS_Store)
result String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", "String -> String -> String
forall a. [a] -> [a] -> [a]
++ifMaybe String -> Bool
forall a. Maybe a -> Bool
isNothingMaybe String
good thenString
"passed"elseString
"FAILED"[(Key, (Value, BS_Store), String)]
-> IO [(Key, (Value, BS_Store), String)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure([(Key, (Value, BS_Store), String)]
 -> IO [(Key, (Value, BS_Store), String)])
-> [(Key, (Value, BS_Store), String)]
-> IO [(Key, (Value, BS_Store), String)]
forall a b. (a -> b) -> a -> b
$[(Key
key ,(Value, BS_Store)
result ,String
now )|JustString
now <-[Maybe String
good ]][(Key, (Value, BS_Store), String)]
-> [(Key, (Value, BS_Store), String)]
-> [(Key, (Value, BS_Store), String)]
forall a. [a] -> [a] -> [a]
++[(Key, (Value, BS_Store), String)]
seen (Key, Status)
_->[(Key, (Value, BS_Store), String)]
-> IO [(Key, (Value, BS_Store), String)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[(Key, (Value, BS_Store), String)]
seen Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless([(Key, (Value, BS_Store), String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[(Key, (Value, BS_Store), String)]
bad )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doletn :: Int
n =[(Key, (Value, BS_Store), String)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[(Key, (Value, BS_Store), String)]
bad SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$String -> [(String, Maybe String)] -> String -> SomeException
errorStructured (String
"Lint checking error - "String -> String -> String
forall a. [a] -> [a] -> [a]
++(ifInt
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1thenString
"value has"elseInt -> String
forall a. Show a => a -> String
showInt
n String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" values have")String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" changed since being depended upon")([(String, Maybe String)]
-> [[(String, Maybe String)]] -> [(String, Maybe String)]
forall a. [a] -> [[a]] -> [a]
intercalate[(String
"",String -> Maybe String
forall a. a -> Maybe a
JustString
"")][[(String
"Key",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
showKey
key ),(String
"Old",String -> Maybe String
forall a. a -> Maybe a
Just(String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$(Value, BS_Store) -> String
forall a. Show a => a -> String
show(Value, BS_Store)
result ),(String
"New",String -> Maybe String
forall a. a -> Maybe a
JustString
now )]|(Key
key ,(Value, BS_Store)
result ,String
now )<-[(Key, (Value, BS_Store), String)]
bad ])String
""-- TEST 2: Is anything from lintTrackWrite which promised not to exist actually been createdKey -> Maybe Id
exists <-Database -> IO (Key -> Maybe Id)
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> IO (k -> Maybe Id)
getIdFromKey Database
db [(Key, Key)]
bad <-[(Key, Key)] -> IO [(Key, Key)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[(Key
parent ,Key
key )|(Key
parent ,Key
key )<-HashSet (Key, Key) -> [(Key, Key)]
forall a. HashSet a -> [a]
Set.toList(HashSet (Key, Key) -> [(Key, Key)])
-> HashSet (Key, Key) -> [(Key, Key)]
forall a b. (a -> b) -> a -> b
$[(Key, Key)] -> HashSet (Key, Key)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList[(Key, Key)]
absent ,Maybe Id -> Bool
forall a. Maybe a -> Bool
isJust(Maybe Id -> Bool) -> Maybe Id -> Bool
forall a b. (a -> b) -> a -> b
$Key -> Maybe Id
exists Key
key ]Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless([(Key, Key)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null[(Key, Key)]
bad )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doletn :: Int
n =[(Key, Key)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length[(Key, Key)]
bad SomeException -> IO ()
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO ()) -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$String -> [(String, Maybe String)] -> String -> SomeException
errorStructured (String
"Lint checking error - "String -> String -> String
forall a. [a] -> [a] -> [a]
++(ifInt
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1thenString
"value"elseInt -> String
forall a. Show a => a -> String
showInt
n String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" values")String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" did not have "String -> String -> String
forall a. [a] -> [a] -> [a]
++(ifInt
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1thenString
"its"elseString
"their")String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" creation tracked")([(String, Maybe String)]
-> [[(String, Maybe String)]] -> [(String, Maybe String)]
forall a. [a] -> [[a]] -> [a]
intercalate[(String
"",String -> Maybe String
forall a. a -> Maybe a
JustString
"")][[(String
"Rule",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
showKey
parent ),(String
"Created",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
showKey
key )]|(Key
parent ,Key
key )<-[(Key, Key)]
bad ])String
""IO String -> IO ()
diagnostic (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
pureString
"Validity/lint check passed"----------------------------------------------------------------------- STORAGEusingDatabase ::Cleanup ->ShakeOptions ->(IOString->IO())->Map.HashMapTypeRepBuiltinRule ->IODatabase usingDatabase :: Cleanup
-> ShakeOptions
-> (IO String -> IO ())
-> HashMap TypeRep BuiltinRule
-> IO Database
usingDatabase Cleanup
cleanup ShakeOptions
opts IO String -> IO ()
diagnostic HashMap TypeRep BuiltinRule
owitness =doletstep :: (TypeRep, (Ver, BinaryOp Key))
step =(Proxy StepKey -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep(Proxy StepKey
forall {k} (t :: k). Proxy t
Proxy::ProxyStepKey ),(Int -> Ver
Ver Int
0,(Key -> Builder) -> (BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (BS_Store -> v) -> BinaryOp v
BinaryOp (Builder -> Key -> Builder
forall a b. a -> b -> a
constBuilder
forall a. Monoid a => a
mempty)(Key -> BS_Store -> Key
forall a b. a -> b -> a
constKey
stepKey )))letroot :: (TypeRep, (Ver, BinaryOp Key))
root =(Proxy Root -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep(Proxy Root
forall {k} (t :: k). Proxy t
Proxy::ProxyRoot ),(Int -> Ver
Ver Int
0,(Key -> Builder) -> (BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (BS_Store -> v) -> BinaryOp v
BinaryOp (Builder -> Key -> Builder
forall a b. a -> b -> a
constBuilder
forall a. Monoid a => a
mempty)(Key -> BS_Store -> Key
forall a b. a -> b -> a
constKey
rootKey )))HashMap QTypeRep (Ver, BinaryOp (Key, Status))
witness <-HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(HashMap QTypeRep (Ver, BinaryOp (Key, Status))
 -> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status))))
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status)))
forall a b. (a -> b) -> a -> b
$[(QTypeRep, (Ver, BinaryOp (Key, Status)))]
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList[(TypeRep -> QTypeRep
QTypeRep TypeRep
t ,(Ver
version ,((Key, Status) -> Builder)
-> (BS_Store -> (Key, Status)) -> BinaryOp (Key, Status)
forall v. (v -> Builder) -> (BS_Store -> v) -> BinaryOp v
BinaryOp ((Key -> Builder) -> (Key, Status) -> Builder
putDatabase Key -> Builder
putOp )((BS_Store -> Key) -> BS_Store -> (Key, Status)
getDatabase BS_Store -> Key
getOp )))|(TypeRep
t ,(Ver
version ,BinaryOp {BS_Store -> Key
Key -> Builder
putOp :: Key -> Builder
getOp :: BS_Store -> Key
putOp :: forall v. BinaryOp v -> v -> Builder
getOp :: forall v. BinaryOp v -> BS_Store -> v
.. }))<-(TypeRep, (Ver, BinaryOp Key))
step (TypeRep, (Ver, BinaryOp Key))
-> [(TypeRep, (Ver, BinaryOp Key))]
-> [(TypeRep, (Ver, BinaryOp Key))]
forall a. a -> [a] -> [a]
:(TypeRep, (Ver, BinaryOp Key))
root (TypeRep, (Ver, BinaryOp Key))
-> [(TypeRep, (Ver, BinaryOp Key))]
-> [(TypeRep, (Ver, BinaryOp Key))]
forall a. a -> [a] -> [a]
:HashMap TypeRep (Ver, BinaryOp Key)
-> [(TypeRep, (Ver, BinaryOp Key))]
forall k v. HashMap k v -> [(k, v)]
Map.toList((BuiltinRule -> (Ver, BinaryOp Key))
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep (Ver, BinaryOp Key)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map(\BuiltinRule {String
BinaryOp Key
Ver
BuiltinRun Key Value
BuiltinIdentity Key Value
Key -> Value -> IO (Maybe String)
builtinLint :: BuiltinRule -> Key -> Value -> IO (Maybe String)
builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
builtinRun :: BuiltinRule -> BuiltinRun Key Value
builtinKey :: BuiltinRule -> BinaryOp Key
builtinVersion :: BuiltinRule -> Ver
builtinLocation :: BuiltinRule -> String
builtinLint :: Key -> Value -> IO (Maybe String)
builtinIdentity :: BuiltinIdentity Key Value
builtinRun :: BuiltinRun Key Value
builtinKey :: BinaryOp Key
builtinVersion :: Ver
builtinLocation :: String
.. }->(Ver
builtinVersion ,BinaryOp Key
builtinKey ))HashMap TypeRep BuiltinRule
owitness )](Ids (Key, Status)
status ,QTypeRep -> Id -> (Key, Status) -> IO ()
journal )<-Cleanup
-> ShakeOptions
-> (IO String -> IO ())
-> HashMap QTypeRep (Ver, BinaryOp (Key, Status))
-> IO (Ids (Key, Status), QTypeRep -> Id -> (Key, Status) -> IO ())
forall k v.
(Show k, Eq k, Hashable k, NFData k, Show v, NFData v) =>
Cleanup
-> ShakeOptions
-> (IO String -> IO ())
-> HashMap k (Ver, BinaryOp v)
-> IO (Ids v, k -> Id -> v -> IO ())
usingStorage Cleanup
cleanup ShakeOptions
opts IO String -> IO ()
diagnostic HashMap QTypeRep (Ver, BinaryOp (Key, Status))
witness Id -> Key -> Status -> IO ()
journal <-(Id -> Key -> Status -> IO ()) -> IO (Id -> Key -> Status -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure((Id -> Key -> Status -> IO ())
 -> IO (Id -> Key -> Status -> IO ()))
-> (Id -> Key -> Status -> IO ())
-> IO (Id -> Key -> Status -> IO ())
forall a b. (a -> b) -> a -> b
$\Id
i Key
k Status
v ->QTypeRep -> Id -> (Key, Status) -> IO ()
journal (TypeRep -> QTypeRep
QTypeRep (TypeRep -> QTypeRep) -> TypeRep -> QTypeRep
forall a b. (a -> b) -> a -> b
$Key -> TypeRep
typeKey Key
k )Id
i (Key
k ,Status
v )Ids (Key, Status)
-> (Id -> Key -> Status -> IO ()) -> Status -> IO Database
forall k v.
(Eq k, Hashable k) =>
Ids (k, v) -> (Id -> k -> v -> IO ()) -> v -> IO (DatabasePoly k v)
createDatabase Ids (Key, Status)
status Id -> Key -> Status -> IO ()
journal Status
Missing incrementStep ::Database ->IOStep incrementStep :: Database -> IO Step
incrementStep Database
db =Database -> Locked Step -> IO Step
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
db (Locked Step -> IO Step) -> Locked Step -> IO Step
forall a b. (a -> b) -> a -> b
$doId
stepId <-Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
db Key
stepKey Maybe (Key, Status)
v <-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
db Id
stepId Step
step <-IO Step -> Locked Step
forall a. IO a -> Locked a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO(IO Step -> Locked Step) -> IO Step -> Locked Step
forall a b. (a -> b) -> a -> b
$Step -> IO Step
forall a. a -> IO a
evaluate(Step -> IO Step) -> Step -> IO Step
forall a b. (a -> b) -> a -> b
$caseMaybe (Key, Status)
v ofJust(Key
_,Loaded Result BS_Store
r )->Step -> Step
incStep (Step -> Step) -> Step -> Step
forall a b. (a -> b) -> a -> b
$Result BS_Store -> Step
fromStepResult Result BS_Store
r Maybe (Key, Status)
_->Word32 -> Step
Step Word32
1letstepRes :: Result (Value, BS_Store)
stepRes =Step -> Result (Value, BS_Store)
toStepResult Step
step Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
db Id
stepId Key
stepKey (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$Result (Value, BS_Store) -> Status
Ready Result (Value, BS_Store)
stepRes 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
$Database -> Id -> Key -> Status -> IO ()
forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
db Id
stepId Key
stepKey (Status -> IO ()) -> Status -> IO ()
forall a b. (a -> b) -> a -> b
$Result BS_Store -> Status
Loaded (Result BS_Store -> Status) -> Result BS_Store -> Status
forall a b. (a -> b) -> a -> b
$((Value, BS_Store) -> BS_Store)
-> Result (Value, BS_Store) -> Result BS_Store
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(Value, BS_Store) -> BS_Store
forall a b. (a, b) -> b
sndResult (Value, BS_Store)
stepRes Step -> Locked Step
forall a. a -> Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pureStep
step toStepResult ::Step ->Result (Value ,BS_Store )toStepResult :: Step -> Result (Value, BS_Store)
toStepResult Step
i =(Value, BS_Store)
-> Step
-> Step
-> [Depends]
-> Float
-> [Trace]
-> Result (Value, BS_Store)
forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result (Step -> Value
forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue Step
i ,Builder -> BS_Store
runBuilder (Builder -> BS_Store) -> Builder -> BS_Store
forall a b. (a -> b) -> a -> b
$Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
i )Step
i Step
i []Float
0[]fromStepResult ::Result BS_Store ->Step fromStepResult :: Result BS_Store -> Step
fromStepResult =BS_Store -> Step
forall a. BinaryEx a => BS_Store -> a
getEx (BS_Store -> Step)
-> (Result BS_Store -> BS_Store) -> Result BS_Store -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Result BS_Store -> BS_Store
forall a. Result a -> a
result recordRoot ::Step ->[Local ]->Seconds->Database ->IO()recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()
recordRoot Step
step [Local]
locals (Seconds -> Float
doubleToFloat->Float
end )Database
db =Database -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked Database
db (Locked () -> IO ()) -> Locked () -> IO ()
forall a b. (a -> b) -> a -> b
$doId
rootId <-Database -> Key -> Locked Id
forall k v.
(Eq k, Hashable k) =>
DatabasePoly k v -> k -> Locked Id
mkId Database
db Key
rootKey letlocal :: Local
local =Local -> [Local] -> Local
localMergeMutable (Stack -> Verbosity -> Local
newLocal Stack
emptyStack Verbosity
Info )[Local]
locals letrootRes :: Result (Value, BS_Store)
rootRes =Result {result :: (Value, BS_Store)
result =(() -> Value
forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue (),BS_Store
BS.empty),changed :: Step
changed =Step
step ,built :: Step
built =Step
step ,depends :: [Depends]
depends =DependsList -> [Depends]
flattenDepends (DependsList -> [Depends]) -> DependsList -> [Depends]
forall a b. (a -> b) -> a -> b
$Local -> DependsList
localDepends Local
local ,execution :: Float
execution =Float
0,traces :: [Trace]
traces =Traces -> [Trace]
flattenTraces (Traces -> [Trace]) -> Traces -> [Trace]
forall a b. (a -> b) -> a -> b
$Traces -> Trace -> Traces
addTrace (Local -> Traces
localTraces Local
local )(Trace -> Traces) -> Trace -> Traces
forall a b. (a -> b) -> a -> b
$BS_Store -> Float -> Float -> Trace
Trace BS_Store
BS.emptyFloat
end Float
end }Database -> Id -> Key -> Status -> Locked ()
forall k v. DatabasePoly k v -> Id -> k -> v -> Locked ()
setMem Database
db Id
rootId Key
rootKey (Status -> Locked ()) -> Status -> Locked ()
forall a b. (a -> b) -> a -> b
$Result (Value, BS_Store) -> Status
Ready Result (Value, BS_Store)
rootRes 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
$Database -> Id -> Key -> Status -> IO ()
forall k v. DatabasePoly k v -> Id -> k -> v -> IO ()
setDisk Database
db Id
rootId Key
rootKey (Status -> IO ()) -> Status -> IO ()
forall a b. (a -> b) -> a -> b
$Result BS_Store -> Status
Loaded (Result BS_Store -> Status) -> Result BS_Store -> Status
forall a b. (a -> b) -> a -> b
$((Value, BS_Store) -> BS_Store)
-> Result (Value, BS_Store) -> Result BS_Store
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(Value, BS_Store) -> BS_Store
forall a b. (a, b) -> b
sndResult (Value, BS_Store)
rootRes loadSharedCloud ::DatabasePoly k v ->ShakeOptions ->Map.HashMapTypeRepBuiltinRule ->IO(MaybeShared ,MaybeCloud )loadSharedCloud :: forall k v.
DatabasePoly k v
-> ShakeOptions
-> HashMap TypeRep BuiltinRule
-> IO (Maybe Shared, Maybe Cloud)
loadSharedCloud DatabasePoly k v
var ShakeOptions
opts HashMap TypeRep BuiltinRule
owitness =doletmp :: HashMap String BuiltinRule
mp =[(String, BuiltinRule)] -> HashMap String BuiltinRule
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList([(String, BuiltinRule)] -> HashMap String BuiltinRule)
-> [(String, BuiltinRule)] -> HashMap String BuiltinRule
forall a b. (a -> b) -> a -> b
$((TypeRep, BuiltinRule) -> (String, BuiltinRule))
-> [(TypeRep, BuiltinRule)] -> [(String, BuiltinRule)]
forall a b. (a -> b) -> [a] -> [b]
map((TypeRep -> String)
-> (TypeRep, BuiltinRule) -> (String, BuiltinRule)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first((TypeRep -> String)
 -> (TypeRep, BuiltinRule) -> (String, BuiltinRule))
-> (TypeRep -> String)
-> (TypeRep, BuiltinRule)
-> (String, BuiltinRule)
forall a b. (a -> b) -> a -> b
$QTypeRep -> String
forall a. Show a => a -> String
show(QTypeRep -> String) -> (TypeRep -> QTypeRep) -> TypeRep -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TypeRep -> QTypeRep
QTypeRep )([(TypeRep, BuiltinRule)] -> [(String, BuiltinRule)])
-> [(TypeRep, BuiltinRule)] -> [(String, BuiltinRule)]
forall a b. (a -> b) -> a -> b
$HashMap TypeRep BuiltinRule -> [(TypeRep, BuiltinRule)]
forall k v. HashMap k v -> [(k, v)]
Map.toListHashMap TypeRep BuiltinRule
owitness letwit :: BinaryOp (String, Key)
wit =(String -> BinaryOp Key) -> BinaryOp (String, Key)
forall a b. BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
binaryOpMap ((String -> BinaryOp Key) -> BinaryOp (String, Key))
-> (String -> BinaryOp Key) -> BinaryOp (String, Key)
forall a b. (a -> b) -> a -> b
$\String
a ->BinaryOp Key
-> (BuiltinRule -> BinaryOp Key)
-> Maybe BuiltinRule
-> BinaryOp Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(String -> BinaryOp Key
forall a. Partial => String -> a
error(String -> BinaryOp Key) -> String -> BinaryOp Key
forall a b. (a -> b) -> a -> b
$String
"loadSharedCloud, couldn't find map for "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
a )BuiltinRule -> BinaryOp Key
builtinKey (Maybe BuiltinRule -> BinaryOp Key)
-> Maybe BuiltinRule -> BinaryOp Key
forall a b. (a -> b) -> a -> b
$String -> HashMap String BuiltinRule -> Maybe BuiltinRule
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookupString
a HashMap String BuiltinRule
mp letwit2 :: BinaryOp Key
wit2 =(Key -> Builder) -> (BS_Store -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (BS_Store -> v) -> BinaryOp v
BinaryOp (\Key
k ->BinaryOp (String, Key) -> (String, Key) -> Builder
forall v. BinaryOp v -> v -> Builder
putOp BinaryOp (String, Key)
wit (QTypeRep -> String
forall a. Show a => a -> String
show(QTypeRep -> String) -> QTypeRep -> String
forall a b. (a -> b) -> a -> b
$TypeRep -> QTypeRep
QTypeRep (TypeRep -> QTypeRep) -> TypeRep -> QTypeRep
forall a b. (a -> b) -> a -> b
$Key -> TypeRep
typeKey Key
k ,Key
k ))((String, Key) -> Key
forall a b. (a, b) -> b
snd((String, Key) -> Key)
-> (BS_Store -> (String, Key)) -> BS_Store -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BinaryOp (String, Key) -> BS_Store -> (String, Key)
forall v. BinaryOp v -> BS_Store -> v
getOp BinaryOp (String, Key)
wit )letkeyVers :: [(TypeRep, Ver)]
keyVers =[(TypeRep
k ,BuiltinRule -> Ver
builtinVersion BuiltinRule
v )|(TypeRep
k ,BuiltinRule
v )<-HashMap TypeRep BuiltinRule -> [(TypeRep, BuiltinRule)]
forall k v. HashMap k v -> [(k, v)]
Map.toListHashMap TypeRep BuiltinRule
owitness ]letver :: Ver
ver =String -> Ver
makeVer (String -> Ver) -> String -> Ver
forall a b. (a -> b) -> a -> b
$ShakeOptions -> String
shakeVersion ShakeOptions
opts Maybe Shared
shared <-caseShakeOptions -> Maybe String
shakeShare ShakeOptions
opts ofMaybe String
Nothing->Maybe Shared -> IO (Maybe Shared)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe Shared
forall a. Maybe a
NothingJustString
x ->Shared -> Maybe Shared
forall a. a -> Maybe a
Just(Shared -> Maybe Shared) -> IO Shared -> IO (Maybe Shared)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Bool -> BinaryOp Key -> Ver -> String -> IO Shared
newShared (ShakeOptions -> Bool
shakeSymlink ShakeOptions
opts )BinaryOp Key
wit2 Ver
ver String
x Maybe Cloud
cloud <-case(Locked () -> IO ())
-> HashMap TypeRep (BinaryOp Key)
-> Ver
-> [(TypeRep, Ver)]
-> [String]
-> Maybe (IO Cloud)
newCloud (DatabasePoly k v -> Locked () -> IO ()
forall k v b. DatabasePoly k v -> Locked b -> IO b
runLocked DatabasePoly k v
var )((BuiltinRule -> BinaryOp Key)
-> HashMap TypeRep BuiltinRule -> HashMap TypeRep (BinaryOp Key)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.mapBuiltinRule -> BinaryOp Key
builtinKey HashMap TypeRep BuiltinRule
owitness )Ver
ver [(TypeRep, Ver)]
keyVers ([String] -> Maybe (IO Cloud)) -> [String] -> Maybe (IO Cloud)
forall a b. (a -> b) -> a -> b
$ShakeOptions -> [String]
shakeCloud ShakeOptions
opts ofMaybe (IO Cloud)
_|[String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ShakeOptions -> [String]
shakeCloud ShakeOptions
opts ->Maybe Cloud -> IO (Maybe Cloud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe Cloud
forall a. Maybe a
NothingMaybe (IO Cloud)
Nothing->String -> IO (Maybe Cloud)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
failString
"shakeCloud set but Shake not compiled for cloud operation"JustIO Cloud
res ->Cloud -> Maybe Cloud
forall a. a -> Maybe a
Just(Cloud -> Maybe Cloud) -> IO Cloud -> IO (Maybe Cloud)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>IO Cloud
res (Maybe Shared, Maybe Cloud) -> IO (Maybe Shared, Maybe Cloud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Maybe Shared
shared ,Maybe Cloud
cloud )putDatabase ::(Key ->Builder )->((Key ,Status )->Builder )putDatabase :: (Key -> Builder) -> (Key, Status) -> Builder
putDatabase Key -> Builder
putKey (Key
key ,Loaded (Result BS_Store
x1 Step
x2 Step
x3 [Depends]
x4 Float
x5 [Trace]
x6 ))=Builder -> Builder
putExN (Key -> Builder
putKey Key
key )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder -> Builder
putExN (BS_Store -> Builder
forall a. BinaryEx a => a -> Builder
putEx BS_Store
x1 )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
x2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Step -> Builder
forall a. BinaryEx a => a -> Builder
putEx Step
x3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Float -> Builder
forall a. BinaryEx a => a -> Builder
putEx Float
x5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder -> Builder
putExN ([Depends] -> Builder
forall a. BinaryEx a => a -> Builder
putEx [Depends]
x4 )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>[Trace] -> Builder
forall a. BinaryEx a => a -> Builder
putEx [Trace]
x6 putDatabase Key -> Builder
_(Key
_,Status
x )=SomeException -> Builder
forall a. SomeException -> a
throwImpure (SomeException -> Builder) -> SomeException -> Builder
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
"putWith, Cannot write Status with constructor "String -> String -> String
forall a. [a] -> [a] -> [a]
++Status -> String
statusType Status
x getDatabase ::(BS.ByteString->Key )->BS.ByteString->(Key ,Status )getDatabase :: (BS_Store -> Key) -> BS_Store -> (Key, Status)
getDatabase BS_Store -> Key
getKey BS_Store
bs |(BS_Store
key ,BS_Store
bs )<-BS_Store -> (BS_Store, BS_Store)
getExN BS_Store
bs ,(BS_Store
x1 ,BS_Store
bs )<-BS_Store -> (BS_Store, BS_Store)
getExN BS_Store
bs ,(Step
x2 ,Step
x3 ,Float
x5 ,BS_Store
bs )<-BS_Store -> (Step, Step, Float, BS_Store)
forall a b c.
(Storable a, Storable b, Storable c) =>
BS_Store -> (a, b, c, BS_Store)
binarySplit3 BS_Store
bs ,(BS_Store
x4 ,BS_Store
x6 )<-BS_Store -> (BS_Store, BS_Store)
getExN BS_Store
bs =(BS_Store -> Key
getKey BS_Store
key ,Result BS_Store -> Status
Loaded (BS_Store
-> Step -> Step -> [Depends] -> Float -> [Trace] -> Result BS_Store
forall a.
a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
Result BS_Store
x1 Step
x2 Step
x3 (BS_Store -> [Depends]
forall a. BinaryEx a => BS_Store -> a
getEx BS_Store
x4 )Float
x5 (BS_Store -> [Trace]
forall a. BinaryEx a => BS_Store -> a
getEx BS_Store
x6 )))