    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}
    {-# LANGUAGE ConstraintKinds, TupleSections, ViewPatterns #-}
    {-# LANGUAGE TypeFamilies, NamedFieldPuns #-}

    module Development.Shake.Internal.Core.Run(
        RunState,
        open,
        reset,
        run,
        shakeRunAfter,
        liveFilesState,
        profileState,
        errorsState
        ) where

    import Control.Exception
    import Data.Tuple.Extra
    import Control.Concurrent.Extra hiding (withNumCapabilities)
    import Development.Shake.Internal.Core.Database
    import Control.Monad.IO.Class
    import General.Binary
    import Development.Shake.Classes
    import Development.Shake.Internal.Core.Storage
    import Development.Shake.Internal.Core.Build
    import Development.Shake.Internal.History.Shared
    import Development.Shake.Internal.History.Cloud
    import qualified General.TypeMap as TMap
    import Control.Monad.Extra
    import Data.Typeable
    import Numeric.Extra
    import Data.List.Extra
    import qualified Data.HashMap.Strict as Map
    import qualified Data.HashSet as Set
    import Data.Dynamic
    import Data.Maybe
    import Data.IORef.Extra
    import System.Directory
    import System.Time.Extra
    import qualified Data.ByteString as BS

    import Development.Shake.Internal.Core.Types
    import Development.Shake.Internal.Core.Action
    import Development.Shake.Internal.Core.Rules
    import General.Pool
    import Development.Shake.Internal.Progress
    import Development.Shake.Internal.Value
    import Development.Shake.Internal.Profile
    import Development.Shake.Internal.Options
    import Development.Shake.Internal.Errors
    import General.Timing
    import General.Thread
    import General.Extra
    import General.Cleanup
    import Data.Monoid
    import Prelude

    ---------------------------------------------------------------------
    -- MAKE

    data RunState = RunState
        {RunState -> ShakeOptions
    opts :: ShakeOptions
        ,RunState -> HashMap TypeRep BuiltinRule
    builtinRules :: Map.HashMap TypeRep BuiltinRule
        ,RunState -> Map UserRuleVersioned
    userRules :: TMap.Map UserRuleVersioned
        ,RunState -> Database
    database :: Database
        ,RunState -> String
    curdir :: FilePath
        ,RunState -> Maybe Shared
    shared :: Maybe Shared
        ,RunState -> Maybe Cloud
    cloud :: Maybe Cloud
        ,RunState -> [(Stack, Action ())]
    actions :: [(Stack, Action ())]
        }

    open :: Cleanup -> ShakeOptions -> Rules () -> IO RunState
    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
    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 Seconds
    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
    ..} IO String -> IO ()
    diagnostic Verbosity -> String -> IO ()
    _ -> do
        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
    "Starting run"
        SRules{actions, builtinRules, userRules} <- ShakeOptions -> Rules () -> IO (SRules [])
    runRules ShakeOptions
    opts Rules ()
    rs

        diagnostic $ pure $ "Number of actions = " ++ show (length actions)
        diagnostic $ pure $ "Number of builtin rules = " ++ show (Map.size builtinRules) ++ " " ++ show (Map.keys builtinRules)
        diagnostic $ pure $ "Number of user rule types = " ++ show (TMap.size userRules)
        diagnostic $ pure $ "Number of user rules = " ++ show (sum (TMap.toList (userRuleSize . userRuleContents) userRules))

        checkShakeExtra shakeExtra
        curdir <- getCurrentDirectory

        database <- usingDatabase cleanup opts diagnostic builtinRules
        (shared, cloud) <- loadSharedCloud database opts builtinRules
        pure RunState{..}

    -- Prepare for a fresh run by changing Result to Loaded
    reset :: 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
        where
            f :: 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
    maybe Status
    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
    maybe Status
    Missing Result BS_Store -> Status
    Loaded OneShot (Maybe (Result BS_Store))
    x -- shouldn't ever happen, but Loaded is least worst
            f 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 ()
    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 Seconds
    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
    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 block
            timingsToShow <- Maybe [String] -> IO (IORef (Maybe [String]))
    forall a. a -> IO (IORef a)
    newIORef Maybe [String]
    forall a. Maybe a
    Nothing

            res <- withCleanup $ \Cleanup
    cleanup -> do
                Cleanup -> IO () -> IO ReleaseKey
    register Cleanup
    cleanup (IO () -> IO ReleaseKey) -> IO () -> IO ReleaseKey
    forall a b. (a -> b) -> a -> b
    $ do
                    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
    $
                        IORef (Maybe [String]) -> Maybe [String] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (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

                start <- IO (IO Seconds)
    offsetTime
                except <- newIORef (Nothing :: Maybe (String, ShakeException))
                let 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
    readIORef IORef (Maybe (String, ShakeException))
    except
                let raiseError ShakeException
    err
                        | Bool -> Bool
    not Bool
    shakeStaunch = ShakeException -> IO ()
    forall e a. (Partial, Exception e) => e -> IO a
    throwIO ShakeException
    err
                        | Bool
    otherwise = do
                            let named :: 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
    atomicModifyIORef IORef (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 wrapped

                after <- newIORef []
                absent <- newIORef []
                step <- incrementStep database
                getProgress <- usingProgress cleanup opts database step getFailure
                lintCurrentDirectory curdir "When running"

                watch <- lintWatch shakeLintWatch
                let ruleFinished
                        | Maybe Lint -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Lint
    shakeLint = \Key
    k -> 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
    $ 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
    show Key
    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
    show Key
    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
    show

                addTiming "Running rules"
                locals <- newIORef []
                runPool (shakeThreads == 1) shakeThreads $ \Pool
    pool -> do
                    let global :: 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) -> do
                        let local :: 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
    $ \case
                            Left SomeException
    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
                            Right Local
    local -> IORef [Local] -> ([Local] -> [Local]) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    atomicModifyIORef_ IORef [Local]
    locals (Local
    localLocal -> [Local] -> [Local]
    forall a. a -> [a] -> [a]
    :)

                whenJustM (readIORef except) (throwIO . snd)
                assertFinishedDatabase database
                let 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

                locals <- readIORef locals
                end <- start
                if null actions && null actions2 then
                    putWhen Info "Warning: No want/action statements, nothing to do"
                 else
                    recordRoot step locals end database

                when (isJust shakeLint) $ do
                    addTiming "Lint checking"
                    lintCurrentDirectory curdir "After completion"
                    checkValid diagnostic database (runLint builtinRules) =<< readIORef absent
                    putWhen Verbose "Lint checking succeeded"
                when (shakeReport /= []) $ do
                    addTiming "Profile report"
                    forM_ shakeReport $ \String
    file -> do
                        Verbosity -> 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
                when (shakeLiveFiles /= []) $ do
                    addTiming "Listing live"
                    diagnostic $ pure "Listing live keys"
                    xs <- liveFiles database
                    forM_ shakeLiveFiles $ \String
    file -> do
                        Verbosity -> 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
                        (if String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-" then String -> IO ()
    putStr else String -> String -> IO ()
    writeFile String
    file) (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    xs

                res <- readIORef after
                addTiming "Cleanup"
                pure res

            whenJustM (readIORef timingsToShow) $
                putStr . unlines
            pure 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 ()
    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 Seconds
    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
    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 ()
    _ -> do
        let n :: 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"
        (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
        when (shakeTimings && shakeVerbosity >= Info) $
            putStrLn $ "(+ running " ++ show n ++ " after actions in " ++ showDuration time ++ ")"

    withInit :: ShakeOptions -> (ShakeOptions -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a) -> IO a
    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 -> do
            opts@ShakeOptions{..} <- Cleanup -> ShakeOptions -> IO ShakeOptions
    usingShakeOptions Cleanup
    cleanup ShakeOptions
    opts
            (diagnostic, output) <- outputFunctions opts <$> newLock
            act opts diagnostic output

    usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions
    usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions
    usingShakeOptions Cleanup
    cleanup ShakeOptions
    opts = do
        opts@ShakeOptions{..} <- if ShakeOptions -> Int
    shakeThreads ShakeOptions
    opts Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 then ShakeOptions -> IO ShakeOptions
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ShakeOptions
    opts else do p <- IO Int
    getProcessorCount; pure opts{shakeThreads=p}
        when shakeLineBuffering $ usingLineBuffering cleanup
        usingNumCapabilities cleanup shakeThreads
        pure opts

    outputFunctions :: ShakeOptions -> Lock -> (IO String -> 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 ()
    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 Seconds
    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
    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)
        where
            outputLocked :: Verbosity -> String -> IO ()
    outputLocked Verbosity
    v String
    msg = Lock -> IO () -> IO ()
    forall a. Lock -> IO a -> IO a
    withLock Lock
    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 -> do v <- IO String
    act; outputLocked Diagnostic $ "% " ++ 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 (Maybe String) -> IO (IO Progress)
    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 ()
    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 Seconds
    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
    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 = do
        let getProgress :: IO Progress
    getProgress = do
                failure <- IO (Maybe String)
    getFailure
                stats <- progress database step
                pure 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
    pure IO Progress
    getProgress

    checkShakeExtra :: Map.HashMap TypeRep Dynamic -> IO ()
    checkShakeExtra :: HashMap TypeRep Dynamic -> IO ()
    checkShakeExtra HashMap TypeRep Dynamic
    mp = do
        let bad :: [(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.toList HashMap TypeRep Dynamic
    mp, let t :: TypeRep
    t = Dynamic -> TypeRep
    dynTypeRep Dynamic
    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. (Partial, 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
    show TypeRep
    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
    show TypeRep
    t)]
                (if [(TypeRep, TypeRep)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(TypeRep, TypeRep)]
    xs then String
    "" else String
    "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.HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)
    runLint :: HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)
    runLint HashMap TypeRep BuiltinRule
    mp Key
    k Value
    v = case 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 of
        Maybe BuiltinRule
    Nothing -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe String
    forall a. Maybe a
    Nothing
        Just BuiltinRule{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
    builtinLocation :: BuiltinRule -> String
    builtinVersion :: BuiltinRule -> Ver
    builtinKey :: BuiltinRule -> BinaryOp Key
    builtinRun :: BuiltinRule -> BuiltinRun Key Value
    builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
    builtinLint :: BuiltinRule -> Key -> Value -> IO (Maybe 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)
        status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    database
        let bad = [Key
    key | (Key
    key, Running{}) <- [(Key, Status)]
    status]
        when (bad /= []) $
            throwM $ errorComplexRecursion (map show 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
        status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    database
        let 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])
    splitTyConApp TypeRep
    t) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "FileQ"
        pure [show k | (k, Ready{}) <- status, specialIsFileKey $ typeKey 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
        status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    database
        pure [(show k, e) | (k, Failed e _) <- status]

    checkValid :: (IO String -> IO ()) -> Database -> (Key -> Value -> IO (Maybe String)) -> [(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
        status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    db
        diagnostic $ pure "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
        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)]
    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]
    traces :: forall a. Result a -> [Trace]
    execution :: forall a. Result a -> Float
    depends :: forall a. Result a -> [Depends]
    changed :: forall a. Result a -> Step
    built :: forall a. Result a -> Step
    result :: forall a. Result a -> a
    ..}) -> do
                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
                diagnostic $ pure $ "Checking if " ++ show key ++ " is " ++ show result ++ ", " ++ if isNothing good then "passed" else "FAILED"
                pure $ [(key, result, now) | Just now <- [good]] ++ 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
        unless (null bad) $ do
            let 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
            throwM $ errorStructured
                ("Lint checking error - " ++ (if n == 1 then "value has" else show n ++ " values have")  ++ " changed since being depended upon")
                (intercalate [("",Just "")] [ [("Key", Just $ show key),("Old", Just $ show result),("New", Just now)]
                                            | (key, result, now) <- bad])
                ""

        -- TEST 2: Is anything from lintTrackWrite which promised not to exist actually been created
        exists <- getIdFromKey db
        bad <- pure [(parent,key) | (parent, key) <- Set.toList $ Set.fromList absent, isJust $ exists key]
        unless (null bad) $ do
            let n = [(Key, Key)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Key, Key)]
    bad
            throwM $ errorStructured
                ("Lint checking error - " ++ (if n == 1 then "value" else show n ++ " values") ++ " did not have " ++ (if n == 1 then "its" else "their") ++ " creation tracked")
                (intercalate [("",Just "")] [ [("Rule", Just $ show parent), ("Created", Just $ show key)] | (parent,key) <- bad])
                ""

        diagnostic $ pure "Validity/lint check passed"

    ---------------------------------------------------------------------
    -- STORAGE

    usingDatabase :: Cleanup -> ShakeOptions -> (IO String -> IO ()) -> Map.HashMap TypeRep BuiltinRule -> IO Database
    usingDatabase :: Cleanup
    -> ShakeOptions
    -> (IO String -> IO ())
    -> HashMap TypeRep BuiltinRule
    -> IO Database
    usingDatabase Cleanup
    cleanup ShakeOptions
    opts IO String -> IO ()
    diagnostic HashMap TypeRep BuiltinRule
    owitness = do
        let step :: (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 :: Proxy StepKey), (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
    const Builder
    forall a. Monoid a => a
    mempty) (Key -> BS_Store -> Key
    forall a b. a -> b -> a
    const Key
    stepKey)))
        let root :: (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 :: Proxy Root), (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
    const Builder
    forall a. Monoid a => a
    mempty) (Key -> BS_Store -> Key
    forall a b. a -> b -> a
    const Key
    rootKey)))
        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
    getOp :: forall v. BinaryOp v -> BS_Store -> v
    putOp :: forall v. BinaryOp v -> v -> Builder
    ..})) <- (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)
    builtinLocation :: BuiltinRule -> String
    builtinVersion :: BuiltinRule -> Ver
    builtinKey :: BuiltinRule -> BinaryOp Key
    builtinRun :: BuiltinRule -> BuiltinRun Key Value
    builtinIdentity :: BuiltinRule -> BuiltinIdentity Key Value
    builtinLint :: BuiltinRule -> 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
    ..} -> (Ver
    builtinVersion, BinaryOp Key
    builtinKey)) HashMap TypeRep BuiltinRule
    owitness)]
        (status, journal) <- usingStorage cleanup opts diagnostic witness
        journal<- pure $ \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)
        createDatabase status journal Missing

    incrementStep :: Database -> IO Step
    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
    $ do
        stepId <- Database -> Key -> Locked Id
    forall k v.
    (Eq k, Hashable k) =>
    DatabasePoly k v -> k -> Locked Id
    mkId Database
    db Key
    stepKey
        v <- liftIO $ getKeyValueFromId db stepId
        step <- liftIO $ evaluate $ case v of
            Just (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
    1
        let stepRes = Step -> Result (Value, BS_Store)
    toStepResult Step
    step
        setMem db stepId stepKey $ Ready stepRes
        liftIO $ setDisk db stepId stepKey $ Loaded $ fmap snd stepRes
        pure 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
    $ do
        rootId <- Database -> Key -> Locked Id
    forall k v.
    (Eq k, Hashable k) =>
    DatabasePoly k v -> k -> Locked Id
    mkId Database
    db Key
    rootKey
        let local = Local -> [Local] -> Local
    localMergeMutable (Stack -> Verbosity -> Local
    newLocal Stack
    emptyStack Verbosity
    Info) [Local]
    locals
        let 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.empty Float
    end Float
    end}
        setMem db rootId rootKey $ Ready rootRes
        liftIO $ setDisk db rootId rootKey $ Loaded $ fmap snd rootRes

    loadSharedCloud :: DatabasePoly k v -> ShakeOptions -> Map.HashMap TypeRep BuiltinRule -> IO (Maybe Shared, Maybe Cloud)
    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 = do
        let mp :: 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.toList HashMap TypeRep BuiltinRule
    owitness
        let wit :: 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
    show String
    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.lookup String
    a HashMap String BuiltinRule
    mp
        let wit2 :: 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)
        let keyVers :: [(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.toList HashMap TypeRep BuiltinRule
    owitness]
        let ver :: Ver
    ver = String -> Ver
    makeVer (String -> Ver) -> String -> Ver
    forall a b. (a -> b) -> a -> b
    $ ShakeOptions -> String
    shakeVersion ShakeOptions
    opts

        shared <- case ShakeOptions -> Maybe String
    shakeShare ShakeOptions
    opts of
            Maybe String
    Nothing -> Maybe Shared -> IO (Maybe Shared)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Shared
    forall a. Maybe a
    Nothing
            Just String
    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
        cloud <- case newCloud (runLocked var) (Map.map builtinKey owitness) ver keyVers $ shakeCloud opts of
            Maybe (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
    pure Maybe Cloud
    forall a. Maybe a
    Nothing
            Maybe (IO Cloud)
    Nothing -> String -> IO (Maybe Cloud)
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "shakeCloud set but Shake not compiled for cloud operation"
            Just IO 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
        pure (shared, 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)))