    {-# 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 -> FilePath
    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
    cleanup opts :: ShakeOptions
    opts rs :: Rules ()
    rs = ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO RunState)
    -> IO RunState
    forall a.
    ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO a)
    -> IO a
    withInit ShakeOptions
    opts ((ShakeOptions
      -> (IO FilePath -> IO ())
      -> (Verbosity -> FilePath -> IO ())
      -> IO RunState)
     -> IO RunState)
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO RunState)
    -> IO RunState
    forall a b. (a -> b) -> a -> b
    $ \opts :: ShakeOptions
    opts@ShakeOptions{..} diagnostic :: IO FilePath -> IO ()
    diagnostic _ -> do
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "Starting run"
        SRules{[(Stack, Action ())]
    actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
    actions :: [(Stack, Action ())]
    actions, HashMap TypeRep BuiltinRule
    builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
    builtinRules :: HashMap TypeRep BuiltinRule
    builtinRules, Map UserRuleVersioned
    userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
    userRules :: Map UserRuleVersioned
    userRules} <- ShakeOptions -> Rules () -> IO (SRules [])
    runRules ShakeOptions
    opts Rules ()
    rs

        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Number of actions = " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show ([(Stack, Action ())] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Stack, Action ())]
    actions)
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Number of builtin rules = " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show (HashMap TypeRep BuiltinRule -> Int
    forall k v. HashMap k v -> Int
    Map.size HashMap TypeRep BuiltinRule
    builtinRules) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ [TypeRep] -> FilePath
    forall a. Show a => a -> FilePath
    show (HashMap TypeRep BuiltinRule -> [TypeRep]
    forall k v. HashMap k v -> [k]
    Map.keys HashMap TypeRep BuiltinRule
    builtinRules)
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Number of user rule types = " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Map UserRuleVersioned -> Int
    forall (f :: * -> *). Map f -> Int
    TMap.size Map UserRuleVersioned
    userRules)
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Number of user rules = " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show ([Int] -> Int
    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
        FilePath
    curdir <- IO FilePath
    getCurrentDirectory

        Database
    database <- Cleanup
    -> ShakeOptions
    -> (IO FilePath -> IO ())
    -> HashMap TypeRep BuiltinRule
    -> IO Database
    usingDatabase Cleanup
    cleanup ShakeOptions
    opts IO FilePath -> IO ()
    diagnostic HashMap TypeRep BuiltinRule
    builtinRules
        (shared :: Maybe Shared
    shared, cloud :: 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 (f :: * -> *) a. Applicative f => a -> f a
    pure RunState :: ShakeOptions
    -> HashMap TypeRep BuiltinRule
    -> Map UserRuleVersioned
    -> Database
    -> FilePath
    -> Maybe Shared
    -> Maybe Cloud
    -> [(Stack, Action ())]
    -> RunState
    RunState{..}

    -- Prepare for a fresh run by changing Result to Loaded
    reset :: RunState -> IO ()
    reset :: RunState -> IO ()
    reset RunState{..} = 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 r :: Result (Value, OneShot BS_Store)
    r) = Result (OneShot BS_Store) -> Status
    Loaded ((Value, OneShot BS_Store) -> OneShot BS_Store
    forall a b. (a, b) -> b
    snd ((Value, OneShot BS_Store) -> OneShot BS_Store)
    -> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Result (Value, OneShot BS_Store)
    r)
            f (Failed _ x :: OneShot (Maybe (Result (OneShot BS_Store)))
    x) = Status
    -> (Result (OneShot BS_Store) -> Status)
    -> OneShot (Maybe (Result (OneShot BS_Store)))
    -> Status
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Status
    Missing Result (OneShot BS_Store) -> Status
    Loaded OneShot (Maybe (Result (OneShot BS_Store)))
    x
            f (Running _ x :: OneShot (Maybe (Result (OneShot BS_Store)))
    x) = Status
    -> (Result (OneShot BS_Store) -> Status)
    -> OneShot (Maybe (Result (OneShot BS_Store)))
    -> Status
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Status
    Missing Result (OneShot BS_Store) -> Status
    Loaded OneShot (Maybe (Result (OneShot BS_Store)))
    x -- shouldn't ever happen, but Loaded is least worst
            f x :: Status
    x = Status
    x

    run :: RunState -> Bool -> [Action ()] -> IO [IO ()]
    run :: RunState -> Bool -> [Action ()] -> IO [IO ()]
    run RunState{..} oneshot :: Bool
    oneshot actions2 :: [Action ()]
    actions2 =
        ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO [IO ()])
    -> IO [IO ()]
    forall a.
    ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO a)
    -> IO a
    withInit ShakeOptions
    opts ((ShakeOptions
      -> (IO FilePath -> IO ())
      -> (Verbosity -> FilePath -> IO ())
      -> IO [IO ()])
     -> IO [IO ()])
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO [IO ()])
    -> IO [IO ()]
    forall a b. (a -> b) -> a -> b
    $ \opts :: ShakeOptions
    opts@ShakeOptions{..} diagnostic :: IO FilePath -> IO ()
    diagnostic output :: Verbosity -> FilePath -> 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
            IORef (Maybe [FilePath])
    timingsToShow <- Maybe [FilePath] -> IO (IORef (Maybe [FilePath]))
    forall a. a -> IO (IORef a)
    newIORef Maybe [FilePath]
    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
    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 [FilePath]) -> Maybe [FilePath] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe [FilePath])
    timingsToShow (Maybe [FilePath] -> IO ())
    -> ([FilePath] -> Maybe [FilePath]) -> [FilePath] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FilePath] -> Maybe [FilePath]
    forall a. a -> Maybe a
    Just ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO [FilePath]
    getTimings
                    IO ()
    resetTimings

                IO Seconds
    start <- IO (IO Seconds)
    offsetTime
                IORef (Maybe (FilePath, ShakeException))
    except <- Maybe (FilePath, ShakeException)
    -> IO (IORef (Maybe (FilePath, ShakeException)))
    forall a. a -> IO (IORef a)
    newIORef (Maybe (FilePath, ShakeException)
    forall a. Maybe a
    Nothing :: Maybe (String, ShakeException))
                let getFailure :: IO (Maybe FilePath)
    getFailure = ((FilePath, ShakeException) -> FilePath)
    -> Maybe (FilePath, ShakeException) -> Maybe FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FilePath, ShakeException) -> FilePath
    forall a b. (a, b) -> a
    fst (Maybe (FilePath, ShakeException) -> Maybe FilePath)
    -> IO (Maybe (FilePath, ShakeException)) -> IO (Maybe FilePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Maybe (FilePath, ShakeException))
    -> IO (Maybe (FilePath, ShakeException))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (FilePath, ShakeException))
    except
                let raiseError :: ShakeException -> IO ()
    raiseError err :: ShakeException
    err
                        | Bool -> Bool
    not Bool
    shakeStaunch = ShakeException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO ShakeException
    err
                        | Bool
    otherwise = do
                            let named :: ShakeException -> FilePath
    named = ShakeOptions -> FilePath -> FilePath
    shakeAbbreviationsApply ShakeOptions
    opts (FilePath -> FilePath)
    -> (ShakeException -> FilePath) -> ShakeException -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShakeException -> FilePath
    shakeExceptionTarget
                            IORef (Maybe (FilePath, ShakeException))
    -> (Maybe (FilePath, ShakeException)
        -> (Maybe (FilePath, ShakeException), ()))
    -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef (Maybe (FilePath, ShakeException))
    except ((Maybe (FilePath, ShakeException)
      -> (Maybe (FilePath, ShakeException), ()))
     -> IO ())
    -> (Maybe (FilePath, ShakeException)
        -> (Maybe (FilePath, ShakeException), ()))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \v :: Maybe (FilePath, ShakeException)
    v -> ((FilePath, ShakeException) -> Maybe (FilePath, ShakeException)
    forall a. a -> Maybe a
    Just ((FilePath, ShakeException) -> Maybe (FilePath, ShakeException))
    -> (FilePath, ShakeException) -> Maybe (FilePath, ShakeException)
    forall a b. (a -> b) -> a -> b
    $ (FilePath, ShakeException)
    -> Maybe (FilePath, ShakeException) -> (FilePath, ShakeException)
    forall a. a -> Maybe a -> a
    fromMaybe (ShakeException -> FilePath
    named ShakeException
    err, ShakeException
    err) Maybe (FilePath, ShakeException)
    v, ())
                            -- no need to print exceptions here, they get printed when they are wrapped

                IORef [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 FilePath)
    -> IO (IO Progress)
    usingProgress Cleanup
    cleanup ShakeOptions
    opts Database
    database Step
    step IO (Maybe FilePath)
    getFailure
                FilePath -> FilePath -> IO ()
    lintCurrentDirectory FilePath
    curdir "When running"

                FilePath -> IO ()
    watch <- [FilePath] -> IO (FilePath -> IO ())
    lintWatch [FilePath]
    shakeLintWatch
                let ruleFinished :: Key -> Action ()
    ruleFinished
                        | Maybe Lint -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Lint
    shakeLint = \k :: Key
    k -> do
                            IO () -> Action ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> IO () -> Action ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> IO ()
    lintCurrentDirectory FilePath
    curdir (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    k
                            Action ()
    lintTrackFinished
                            IO () -> Action ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> IO () -> Action ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ()
    watch (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    k
                        | Bool
    otherwise = IO () -> Action ()
    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
    . FilePath -> IO ()
    watch (FilePath -> IO ()) -> (Key -> FilePath) -> Key -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key -> FilePath
    forall a. Show a => a -> FilePath
    show

                FilePath -> IO ()
    addTiming "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
    == 1) Int
    shakeThreads ((Pool -> IO ()) -> IO ()) -> (Pool -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \pool :: Pool
    pool -> do
                    let global :: Global
    global = ([FilePath] -> [Key] -> Action [Value])
    -> Database
    -> Pool
    -> Cleanup
    -> IO Seconds
    -> HashMap TypeRep BuiltinRule
    -> (Verbosity -> FilePath -> IO ())
    -> ShakeOptions
    -> (IO FilePath -> IO ())
    -> (Key -> Action ())
    -> IORef [IO ()]
    -> IORef [(Key, Key)]
    -> IO Progress
    -> Map UserRuleVersioned
    -> Maybe Shared
    -> Maybe Cloud
    -> Step
    -> Bool
    -> Global
    Global [FilePath] -> [Key] -> Action [Value]
    applyKeyValue Database
    database Pool
    pool Cleanup
    cleanup IO Seconds
    start HashMap TypeRep BuiltinRule
    builtinRules Verbosity -> FilePath -> IO ()
    output ShakeOptions
    opts IO FilePath -> 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
    stack, act :: 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 (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 e :: 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
    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]
    :)

                IO (Maybe (FilePath, ShakeException))
    -> ((FilePath, ShakeException) -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    m (Maybe a) -> (a -> m ()) -> m ()
    whenJustM (IORef (Maybe (FilePath, ShakeException))
    -> IO (Maybe (FilePath, ShakeException))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (FilePath, ShakeException))
    except) (ShakeException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (ShakeException -> IO ())
    -> ((FilePath, ShakeException) -> ShakeException)
    -> (FilePath, ShakeException)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath, ShakeException) -> ShakeException
    forall a b. (a, b) -> b
    snd)
                Database -> IO ()
    assertFinishedDatabase Database
    database
                let putWhen :: Verbosity -> FilePath -> IO ()
    putWhen lvl :: Verbosity
    lvl msg :: FilePath
    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 -> FilePath -> IO ()
    output Verbosity
    lvl FilePath
    msg

                [Local]
    locals <- IORef [Local] -> IO [Local]
    forall a. IORef a -> IO a
    readIORef IORef [Local]
    locals
                Seconds
    end <- IO Seconds
    start
                if [(Stack, Action ())] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Stack, Action ())]
    actions Bool -> Bool -> Bool
    && [Action ()] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Action ()]
    actions2 then
                    Verbosity -> FilePath -> IO ()
    putWhen Verbosity
    Info "Warning: No want/action statements, nothing to do"
                 else
                    Step -> [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
    isJust Maybe Lint
    shakeLint) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    FilePath -> IO ()
    addTiming "Lint checking"
                    FilePath -> FilePath -> IO ()
    lintCurrentDirectory FilePath
    curdir "After completion"
                    (IO FilePath -> IO ())
    -> Database
    -> (Key -> Value -> IO (Maybe FilePath))
    -> [(Key, Key)]
    -> IO ()
    checkValid IO FilePath -> IO ()
    diagnostic Database
    database (HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe FilePath)
    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
    readIORef IORef [(Key, Key)]
    absent
                    Verbosity -> FilePath -> IO ()
    putWhen Verbosity
    Verbose "Lint checking succeeded"
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([FilePath]
    shakeReport [FilePath] -> [FilePath] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    FilePath -> IO ()
    addTiming "Profile report"
                    [FilePath] -> (FilePath -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FilePath]
    shakeReport ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \file :: FilePath
    file -> do
                        Verbosity -> FilePath -> IO ()
    putWhen Verbosity
    Info (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Writing report to " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    file
                        FilePath -> Database -> IO ()
    writeProfile FilePath
    file Database
    database
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([FilePath]
    shakeLiveFiles [FilePath] -> [FilePath] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    FilePath -> IO ()
    addTiming "Listing live"
                    IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "Listing live keys"
                    [FilePath]
    xs <- Database -> IO [FilePath]
    liveFiles Database
    database
                    [FilePath] -> (FilePath -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FilePath]
    shakeLiveFiles ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \file :: FilePath
    file -> do
                        Verbosity -> FilePath -> IO ()
    putWhen Verbosity
    Info (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Writing live list to " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    file
                        (if FilePath
    file FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == "-" then FilePath -> IO ()
    putStr else FilePath -> FilePath -> IO ()
    writeFile FilePath
    file) (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unlines [FilePath]
    xs

                [IO ()]
    res <- IORef [IO ()] -> IO [IO ()]
    forall a. IORef a -> IO a
    readIORef IORef [IO ()]
    after
                FilePath -> IO ()
    addTiming "Cleanup"
                [IO ()] -> IO [IO ()]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [IO ()]
    res

            IO (Maybe [FilePath]) -> ([FilePath] -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    m (Maybe a) -> (a -> m ()) -> m ()
    whenJustM (IORef (Maybe [FilePath]) -> IO (Maybe [FilePath])
    forall a. IORef a -> IO a
    readIORef IORef (Maybe [FilePath])
    timingsToShow) (([FilePath] -> IO ()) -> IO ()) -> ([FilePath] -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                FilePath -> IO ()
    putStr (FilePath -> IO ())
    -> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FilePath] -> FilePath
    unlines
            [IO ()] -> IO [IO ()]
    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 _ [] = () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    shakeRunAfter opts :: ShakeOptions
    opts after :: [IO ()]
    after = ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO ())
    -> IO ()
    forall a.
    ShakeOptions
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO a)
    -> IO a
    withInit ShakeOptions
    opts ((ShakeOptions
      -> (IO FilePath -> IO ())
      -> (Verbosity -> FilePath -> IO ())
      -> IO ())
     -> IO ())
    -> (ShakeOptions
        -> (IO FilePath -> IO ())
        -> (Verbosity -> FilePath -> IO ())
        -> IO ())
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ShakeOptions{..} diagnostic :: IO FilePath -> IO ()
    diagnostic _ -> do
        let n :: FilePath
    n = Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Int -> FilePath) -> Int -> FilePath
    forall a b. (a -> b) -> a -> b
    $ [IO ()] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [IO ()]
    after
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Running " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " after actions"
        (time :: 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
    $
            FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "(+ running " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " after actions in " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> FilePath
    showDuration Seconds
    time FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ")"

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

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

    outputFunctions :: ShakeOptions -> Lock -> (IO String -> IO (), Verbosity -> String -> IO ())
    outputFunctions :: ShakeOptions
    -> Lock -> (IO FilePath -> IO (), Verbosity -> FilePath -> IO ())
    outputFunctions opts :: ShakeOptions
    opts@ShakeOptions{..} outputLock :: Lock
    outputLock = (IO FilePath -> IO ()
    diagnostic, Verbosity -> FilePath -> IO ()
    output)
        where
            outputLocked :: Verbosity -> FilePath -> IO ()
    outputLocked v :: Verbosity
    v msg :: FilePath
    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 -> FilePath -> IO ()
    shakeOutput Verbosity
    v FilePath
    msg

            diagnostic :: IO FilePath -> IO ()
    diagnostic | Verbosity
    shakeVerbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    < Verbosity
    Diagnostic = IO () -> IO FilePath -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO FilePath -> IO ()) -> IO () -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                       | Bool
    otherwise = \act :: IO FilePath
    act -> do FilePath
    v <- IO FilePath
    act; Verbosity -> FilePath -> IO ()
    outputLocked Verbosity
    Diagnostic (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "% " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    v
            output :: Verbosity -> FilePath -> IO ()
    output v :: Verbosity
    v = Verbosity -> FilePath -> IO ()
    outputLocked Verbosity
    v (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShakeOptions -> FilePath -> FilePath
    shakeAbbreviationsApply ShakeOptions
    opts

    usingProgress :: Cleanup -> ShakeOptions -> Database -> Step -> IO (Maybe String) -> IO (IO Progress)
    usingProgress :: Cleanup
    -> ShakeOptions
    -> Database
    -> Step
    -> IO (Maybe FilePath)
    -> IO (IO Progress)
    usingProgress cleanup :: Cleanup
    cleanup ShakeOptions{..} database :: Database
    database step :: Step
    step getFailure :: IO (Maybe FilePath)
    getFailure = do
        let getProgress :: IO Progress
    getProgress = do
                Maybe FilePath
    failure <- IO (Maybe FilePath)
    getFailure
                Progress
    stats <- Database -> Step -> IO Progress
    progress Database
    database Step
    step
                Progress -> IO Progress
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Progress
    stats{isFailure :: Maybe FilePath
    isFailure=Maybe FilePath
    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 (f :: * -> *) a. Applicative f => a -> f a
    pure IO Progress
    getProgress

    checkShakeExtra :: Map.HashMap TypeRep Dynamic -> IO ()
    checkShakeExtra :: HashMap TypeRep Dynamic -> IO ()
    checkShakeExtra mp :: HashMap TypeRep Dynamic
    mp = do
        let bad :: [(TypeRep, TypeRep)]
    bad = [(TypeRep
    k,TypeRep
    t) | (k :: TypeRep
    k,v :: 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
            (k :: TypeRep
    k,t :: TypeRep
    t):xs :: [(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
    $ FilePath
    -> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
    errorStructured "Invalid Map in shakeExtra"
                [("Key",FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> FilePath
    forall a. Show a => a -> FilePath
    show TypeRep
    k),("Value type",FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> FilePath
    forall a. Show a => a -> FilePath
    show TypeRep
    t)]
                (if [(TypeRep, TypeRep)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(TypeRep, TypeRep)]
    xs then "" else "Plus " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show ([(TypeRep, TypeRep)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(TypeRep, TypeRep)]
    xs) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " other keys")
            _ -> () -> IO ()
    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 FilePath)
    runLint mp :: HashMap TypeRep BuiltinRule
    mp k :: Key
    k v :: 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
        Nothing -> Maybe FilePath -> IO (Maybe FilePath)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe FilePath
    forall a. Maybe a
    Nothing
        Just BuiltinRule{..} -> Key -> Value -> IO (Maybe FilePath)
    builtinLint Key
    k Value
    v

    assertFinishedDatabase :: Database -> IO ()
    assertFinishedDatabase :: Database -> IO ()
    assertFinishedDatabase database :: 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
        let bad :: [Key]
    bad = [Key
    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
    $ [FilePath] -> SomeException
    errorComplexRecursion ((Key -> FilePath) -> [Key] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Key -> FilePath
    forall a. Show a => a -> FilePath
    show [Key]
    bad)

    liveFilesState :: RunState -> IO [FilePath]
    liveFilesState :: RunState -> IO [FilePath]
    liveFilesState RunState{..} = Database -> IO [FilePath]
    liveFiles Database
    database

    profileState :: RunState -> FilePath -> IO ()
    profileState :: RunState -> FilePath -> IO ()
    profileState RunState{..} file :: FilePath
    file = FilePath -> Database -> IO ()
    writeProfile FilePath
    file Database
    database

    liveFiles :: Database -> IO [FilePath]
    liveFiles :: Database -> IO [FilePath]
    liveFiles database :: Database
    database = do
        [(Key, Status)]
    status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    database
        let specialIsFileKey :: TypeRep -> Bool
    specialIsFileKey t :: TypeRep
    t = TyCon -> FilePath
    forall a. Show a => a -> FilePath
    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) FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == "FileQ"
        [FilePath] -> IO [FilePath]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    k | (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 [(FilePath, SomeException)]
    errorsState RunState{..} = do
        [(Key, Status)]
    status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    database
        [(FilePath, SomeException)] -> IO [(FilePath, SomeException)]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [(Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    k, SomeException
    e) | (k :: Key
    k, Failed e :: SomeException
    e _) <- [(Key, Status)]
    status]

    checkValid :: (IO String -> IO ()) -> Database -> (Key -> Value -> IO (Maybe String)) -> [(Key, Key)] -> IO ()
    checkValid :: (IO FilePath -> IO ())
    -> Database
    -> (Key -> Value -> IO (Maybe FilePath))
    -> [(Key, Key)]
    -> IO ()
    checkValid diagnostic :: IO FilePath -> IO ()
    diagnostic db :: Database
    db check :: Key -> Value -> IO (Maybe FilePath)
    check absent :: [(Key, Key)]
    absent = do
        [(Key, Status)]
    status <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    db
        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    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
        [(Key, (Value, OneShot BS_Store), FilePath)]
    bad <- (\f :: [(Key, (Value, OneShot BS_Store), FilePath)]
    -> (Key, Status) -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    f -> ([(Key, (Value, OneShot BS_Store), FilePath)]
     -> (Key, Status)
     -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
    -> [(Key, (Value, OneShot BS_Store), FilePath)]
    -> [(Key, Status)]
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM [(Key, (Value, OneShot BS_Store), FilePath)]
    -> (Key, Status) -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    f [] [(Key, Status)]
    status) (([(Key, (Value, OneShot BS_Store), FilePath)]
      -> (Key, Status)
      -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
     -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
    -> ([(Key, (Value, OneShot BS_Store), FilePath)]
        -> (Key, Status)
        -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    forall a b. (a -> b) -> a -> b
    $ \seen :: [(Key, (Value, OneShot BS_Store), FilePath)]
    seen v :: (Key, Status)
    v -> case (Key, Status)
    v of
            (key :: Key
    key, Ready Result{..}) -> do
                Maybe FilePath
    good <- Key -> Value -> IO (Maybe FilePath)
    check Key
    key (Value -> IO (Maybe FilePath)) -> Value -> IO (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ (Value, OneShot BS_Store) -> Value
    forall a b. (a, b) -> a
    fst (Value, OneShot BS_Store)
    result
                IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ "Checking if " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    key FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " is " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (Value, OneShot BS_Store) -> FilePath
    forall a. Show a => a -> FilePath
    show (Value, OneShot BS_Store)
    result FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ", " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ if Maybe FilePath -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe FilePath
    good then "passed" else "FAILED"
                [(Key, (Value, OneShot BS_Store), FilePath)]
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(Key, (Value, OneShot BS_Store), FilePath)]
     -> IO [(Key, (Value, OneShot BS_Store), FilePath)])
    -> [(Key, (Value, OneShot BS_Store), FilePath)]
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    forall a b. (a -> b) -> a -> b
    $ [(Key
    key, (Value, OneShot BS_Store)
    result, FilePath
    now) | Just now :: FilePath
    now <- [Maybe FilePath
    good]] [(Key, (Value, OneShot BS_Store), FilePath)]
    -> [(Key, (Value, OneShot BS_Store), FilePath)]
    -> [(Key, (Value, OneShot BS_Store), FilePath)]
    forall a. [a] -> [a] -> [a]
    ++ [(Key, (Value, OneShot BS_Store), FilePath)]
    seen
            _ -> [(Key, (Value, OneShot BS_Store), FilePath)]
    -> IO [(Key, (Value, OneShot BS_Store), FilePath)]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [(Key, (Value, OneShot BS_Store), FilePath)]
    seen
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(Key, (Value, OneShot BS_Store), FilePath)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Key, (Value, OneShot BS_Store), FilePath)]
    bad) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let n :: Int
    n = [(Key, (Value, OneShot BS_Store), FilePath)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Key, (Value, OneShot BS_Store), FilePath)]
    bad
            SomeException -> IO ()
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO ()) -> SomeException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
    errorStructured
                ("Lint checking error - " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then "value has" else Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " values have")  FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " changed since being depended upon")
                ([(FilePath, Maybe FilePath)]
    -> [[(FilePath, Maybe FilePath)]] -> [(FilePath, Maybe FilePath)]
    forall a. [a] -> [[a]] -> [a]
    intercalate [("",FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "")] [ [("Key", FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    key),("Old", FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ (Value, OneShot BS_Store) -> FilePath
    forall a. Show a => a -> FilePath
    show (Value, OneShot BS_Store)
    result),("New", FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    now)]
                                            | (key :: Key
    key, result :: (Value, OneShot BS_Store)
    result, now :: FilePath
    now) <- [(Key, (Value, OneShot BS_Store), FilePath)]
    bad])
                ""

        -- TEST 2: Is anything from lintTrackWrite which promised not to exist actually been created
        Key -> 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 (f :: * -> *) a. Applicative f => a -> f a
    pure [(Key
    parent,Key
    key) | (parent :: Key
    parent, key :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Key, Key)]
    bad) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let n :: Int
    n = [(Key, Key)] -> 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
    $ FilePath
    -> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
    errorStructured
                ("Lint checking error - " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then "value" else Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " values") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " did not have " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then "its" else "their") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " creation tracked")
                ([(FilePath, Maybe FilePath)]
    -> [[(FilePath, Maybe FilePath)]] -> [(FilePath, Maybe FilePath)]
    forall a. [a] -> [[a]] -> [a]
    intercalate [("",FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just "")] [ [("Rule", FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    parent), ("Created", FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ Key -> FilePath
    forall a. Show a => a -> FilePath
    show Key
    key)] | (parent :: Key
    parent,key :: Key
    key) <- [(Key, Key)]
    bad])
                ""

        IO FilePath -> IO ()
    diagnostic (IO FilePath -> IO ()) -> IO FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "Validity/lint check passed"

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

    usingDatabase :: Cleanup -> ShakeOptions -> (IO String -> IO ()) -> Map.HashMap TypeRep BuiltinRule -> IO Database
    usingDatabase :: Cleanup
    -> ShakeOptions
    -> (IO FilePath -> IO ())
    -> HashMap TypeRep BuiltinRule
    -> IO Database
    usingDatabase cleanup :: Cleanup
    cleanup opts :: ShakeOptions
    opts diagnostic :: IO FilePath -> IO ()
    diagnostic owitness :: 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 0, (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
    forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
    BinaryOp (Builder -> Key -> Builder
    forall a b. a -> b -> a
    const Builder
    forall a. Monoid a => a
    mempty) (Key -> OneShot 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 0, (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
    forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
    BinaryOp (Builder -> Key -> Builder
    forall a b. a -> b -> a
    const Builder
    forall a. Monoid a => a
    mempty) (Key -> OneShot BS_Store -> Key
    forall a b. a -> b -> a
    const Key
    rootKey)))
        HashMap QTypeRep (Ver, BinaryOp (Key, Status))
    witness<- HashMap QTypeRep (Ver, BinaryOp (Key, Status))
    -> IO (HashMap QTypeRep (Ver, BinaryOp (Key, Status)))
    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)
    -> (OneShot BS_Store -> (Key, Status)) -> BinaryOp (Key, Status)
    forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
    BinaryOp ((Key -> Builder) -> (Key, Status) -> Builder
    putDatabase Key -> Builder
    putOp) ((OneShot BS_Store -> Key) -> OneShot BS_Store -> (Key, Status)
    getDatabase OneShot BS_Store -> Key
    getOp)))
            | (t :: TypeRep
    t,(version :: Ver
    version, BinaryOp{..})) <- (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{..} -> (Ver
    builtinVersion, BinaryOp Key
    builtinKey)) HashMap TypeRep BuiltinRule
    owitness)]
        (status :: Ids (Key, Status)
    status, journal :: QTypeRep -> Id -> (Key, Status) -> IO ()
    journal) <- Cleanup
    -> ShakeOptions
    -> (IO FilePath -> 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 FilePath -> IO ())
    -> HashMap k (Ver, BinaryOp v)
    -> IO (Ids v, k -> Id -> v -> IO ())
    usingStorage Cleanup
    cleanup ShakeOptions
    opts IO FilePath -> IO ()
    diagnostic HashMap QTypeRep (Ver, BinaryOp (Key, Status))
    witness
        Id -> Key -> Status -> IO ()
    journal<- (Id -> Key -> Status -> IO ()) -> IO (Id -> Key -> Status -> IO ())
    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
    $ \i :: Id
    i k :: Key
    k v :: 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 -> IO Step
    incrementStep :: Database -> IO Step
    incrementStep db :: 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
        Id
    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 (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 (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
    $ case Maybe (Key, Status)
    v of
            Just (_, Loaded r :: Result (OneShot BS_Store)
    r) -> Step -> Step
    incStep (Step -> Step) -> Step -> Step
    forall a b. (a -> b) -> a -> b
    $ Result (OneShot BS_Store) -> Step
    fromStepResult Result (OneShot BS_Store)
    r
            _ -> Word32 -> Step
    Step 1
        let stepRes :: Result (Value, OneShot BS_Store)
    stepRes = Step -> Result (Value, OneShot 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, OneShot BS_Store) -> Status
    Ready Result (Value, OneShot BS_Store)
    stepRes
        IO () -> Locked ()
    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 (OneShot BS_Store) -> Status
    Loaded (Result (OneShot BS_Store) -> Status)
    -> Result (OneShot BS_Store) -> Status
    forall a b. (a -> b) -> a -> b
    $ ((Value, OneShot BS_Store) -> OneShot BS_Store)
    -> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Value, OneShot BS_Store) -> OneShot BS_Store
    forall a b. (a, b) -> b
    snd Result (Value, OneShot BS_Store)
    stepRes
        Step -> Locked Step
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Step
    step

    toStepResult :: Step -> Result (Value, BS_Store)
    toStepResult :: Step -> Result (Value, OneShot BS_Store)
    toStepResult i :: Step
    i = (Value, OneShot BS_Store)
    -> Step
    -> Step
    -> [Depends]
    -> Float
    -> [Trace]
    -> Result (Value, OneShot 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 -> OneShot BS_Store
    runBuilder (Builder -> OneShot BS_Store) -> Builder -> OneShot BS_Store
    forall a b. (a -> b) -> a -> b
    $ Step -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx Step
    i) Step
    i Step
    i [] 0 []

    fromStepResult :: Result BS_Store -> Step
    fromStepResult :: Result (OneShot BS_Store) -> Step
    fromStepResult = OneShot BS_Store -> Step
    forall a. BinaryEx a => OneShot BS_Store -> a
    getEx (OneShot BS_Store -> Step)
    -> (Result (OneShot BS_Store) -> OneShot BS_Store)
    -> Result (OneShot BS_Store)
    -> Step
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result (OneShot BS_Store) -> OneShot BS_Store
    forall a. Result a -> a
    result

    recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()
    recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()
    recordRoot step :: Step
    step locals :: [Local]
    locals (Seconds -> Float
    doubleToFloat -> Float
    end) db :: 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
        Id
    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 -> [Local] -> Local
    localMergeMutable (Stack -> Verbosity -> Local
    newLocal Stack
    emptyStack Verbosity
    Info) [Local]
    locals
        let rootRes :: Result (Value, OneShot BS_Store)
    rootRes = $WResult :: forall a.
    a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
    Result
                {result :: (Value, OneShot BS_Store)
    result = (() -> Value
    forall a. (Typeable a, Show a, NFData a) => a -> Value
    newValue (), OneShot BS_Store
    BS.empty)
                ,changed :: Step
    changed = Step
    step
                ,built :: Step
    built = Step
    step
                ,depends :: [Depends]
    depends = [Depends] -> [Depends]
    nubDepends ([Depends] -> [Depends]) -> [Depends] -> [Depends]
    forall a b. (a -> b) -> a -> b
    $ [Depends] -> [Depends]
    forall a. [a] -> [a]
    reverse ([Depends] -> [Depends]) -> [Depends] -> [Depends]
    forall a b. (a -> b) -> a -> b
    $ Local -> [Depends]
    localDepends Local
    local
                ,execution :: Float
    execution = 0
                ,traces :: [Trace]
    traces = [Trace] -> [Trace]
    forall a. [a] -> [a]
    reverse ([Trace] -> [Trace]) -> [Trace] -> [Trace]
    forall a b. (a -> b) -> a -> b
    $ OneShot BS_Store -> Float -> Float -> Trace
    Trace OneShot BS_Store
    BS.empty Float
    end Float
    end Trace -> [Trace] -> [Trace]
    forall a. a -> [a] -> [a]
    : Local -> [Trace]
    localTraces Local
    local}
        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, OneShot BS_Store) -> Status
    Ready Result (Value, OneShot BS_Store)
    rootRes
        IO () -> Locked ()
    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 (OneShot BS_Store) -> Status
    Loaded (Result (OneShot BS_Store) -> Status)
    -> Result (OneShot BS_Store) -> Status
    forall a b. (a -> b) -> a -> b
    $ ((Value, OneShot BS_Store) -> OneShot BS_Store)
    -> Result (Value, OneShot BS_Store) -> Result (OneShot BS_Store)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Value, OneShot BS_Store) -> OneShot BS_Store
    forall a b. (a, b) -> b
    snd Result (Value, OneShot BS_Store)
    rootRes

    loadSharedCloud :: DatabasePoly k v -> ShakeOptions -> Map.HashMap TypeRep BuiltinRule -> IO (Maybe Shared, Maybe Cloud)
    loadSharedCloud :: DatabasePoly k v
    -> ShakeOptions
    -> HashMap TypeRep BuiltinRule
    -> IO (Maybe Shared, Maybe Cloud)
    loadSharedCloud var :: DatabasePoly k v
    var opts :: ShakeOptions
    opts owitness :: HashMap TypeRep BuiltinRule
    owitness = do
        let mp :: HashMap FilePath BuiltinRule
    mp = [(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList ([(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule)
    -> [(FilePath, BuiltinRule)] -> HashMap FilePath BuiltinRule
    forall a b. (a -> b) -> a -> b
    $ ((TypeRep, BuiltinRule) -> (FilePath, BuiltinRule))
    -> [(TypeRep, BuiltinRule)] -> [(FilePath, BuiltinRule)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TypeRep -> FilePath)
    -> (TypeRep, BuiltinRule) -> (FilePath, BuiltinRule)
    forall a a' b. (a -> a') -> (a, b) -> (a', b)
    first ((TypeRep -> FilePath)
     -> (TypeRep, BuiltinRule) -> (FilePath, BuiltinRule))
    -> (TypeRep -> FilePath)
    -> (TypeRep, BuiltinRule)
    -> (FilePath, BuiltinRule)
    forall a b. (a -> b) -> a -> b
    $ QTypeRep -> FilePath
    forall a. Show a => a -> FilePath
    show (QTypeRep -> FilePath)
    -> (TypeRep -> QTypeRep) -> TypeRep -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeRep -> QTypeRep
    QTypeRep) ([(TypeRep, BuiltinRule)] -> [(FilePath, BuiltinRule)])
    -> [(TypeRep, BuiltinRule)] -> [(FilePath, 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 (FilePath, Key)
    wit = (FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key)
    forall a b. BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
    binaryOpMap ((FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key))
    -> (FilePath -> BinaryOp Key) -> BinaryOp (FilePath, Key)
    forall a b. (a -> b) -> a -> b
    $ \a :: FilePath
    a -> BinaryOp Key
    -> (BuiltinRule -> BinaryOp Key)
    -> Maybe BuiltinRule
    -> BinaryOp Key
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (FilePath -> BinaryOp Key
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> BinaryOp Key) -> FilePath -> BinaryOp Key
    forall a b. (a -> b) -> a -> b
    $ "loadSharedCloud, couldn't find map for " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    a) BuiltinRule -> BinaryOp Key
    builtinKey (Maybe BuiltinRule -> BinaryOp Key)
    -> Maybe BuiltinRule -> BinaryOp Key
    forall a b. (a -> b) -> a -> b
    $ FilePath -> HashMap FilePath BuiltinRule -> Maybe BuiltinRule
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup FilePath
    a HashMap FilePath BuiltinRule
    mp
        let wit2 :: BinaryOp Key
    wit2 = (Key -> Builder) -> (OneShot BS_Store -> Key) -> BinaryOp Key
    forall v. (v -> Builder) -> (OneShot BS_Store -> v) -> BinaryOp v
    BinaryOp (\k :: Key
    k -> BinaryOp (FilePath, Key) -> (FilePath, Key) -> Builder
    forall v. BinaryOp v -> v -> Builder
    putOp BinaryOp (FilePath, Key)
    wit (QTypeRep -> FilePath
    forall a. Show a => a -> FilePath
    show (QTypeRep -> FilePath) -> QTypeRep -> FilePath
    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)) ((FilePath, Key) -> Key
    forall a b. (a, b) -> b
    snd ((FilePath, Key) -> Key)
    -> (OneShot BS_Store -> (FilePath, Key)) -> OneShot BS_Store -> Key
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BinaryOp (FilePath, Key) -> OneShot BS_Store -> (FilePath, Key)
    forall v. BinaryOp v -> OneShot BS_Store -> v
    getOp BinaryOp (FilePath, Key)
    wit)
        let keyVers :: [(TypeRep, Ver)]
    keyVers = [(TypeRep
    k, BuiltinRule -> Ver
    builtinVersion BuiltinRule
    v) | (k :: TypeRep
    k,v :: 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 = FilePath -> Ver
    makeVer (FilePath -> Ver) -> FilePath -> Ver
    forall a b. (a -> b) -> a -> b
    $ ShakeOptions -> FilePath
    shakeVersion ShakeOptions
    opts

        Maybe Shared
    shared <- case ShakeOptions -> Maybe FilePath
    shakeShare ShakeOptions
    opts of
            Nothing -> Maybe Shared -> IO (Maybe Shared)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Shared
    forall a. Maybe a
    Nothing
            Just x :: FilePath
    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 -> FilePath -> IO Shared
    newShared (ShakeOptions -> Bool
    shakeSymlink ShakeOptions
    opts) BinaryOp Key
    wit2 Ver
    ver FilePath
    x
        Maybe Cloud
    cloud <- case (Locked () -> IO ())
    -> HashMap TypeRep (BinaryOp Key)
    -> Ver
    -> [(TypeRep, Ver)]
    -> [FilePath]
    -> 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.map BuiltinRule -> BinaryOp Key
    builtinKey HashMap TypeRep BuiltinRule
    owitness) Ver
    ver [(TypeRep, Ver)]
    keyVers ([FilePath] -> Maybe (IO Cloud)) -> [FilePath] -> Maybe (IO Cloud)
    forall a b. (a -> b) -> a -> b
    $ ShakeOptions -> [FilePath]
    shakeCloud ShakeOptions
    opts of
            _ | [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([FilePath] -> Bool) -> [FilePath] -> Bool
    forall a b. (a -> b) -> a -> b
    $ ShakeOptions -> [FilePath]
    shakeCloud ShakeOptions
    opts -> Maybe Cloud -> IO (Maybe Cloud)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Cloud
    forall a. Maybe a
    Nothing
            Nothing -> FilePath -> IO (Maybe Cloud)
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail "shakeCloud set but Shake not compiled for cloud operation"
            Just res :: 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
        (Maybe Shared, Maybe Cloud) -> IO (Maybe Shared, Maybe Cloud)
    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 putKey :: Key -> Builder
    putKey (key :: Key
    key, Loaded (Result x1 :: OneShot BS_Store
    x1 x2 :: Step
    x2 x3 :: Step
    x3 x4 :: [Depends]
    x4 x5 :: Float
    x5 x6 :: [Trace]
    x6)) =
        Builder -> Builder
    putExN (Key -> Builder
    putKey Key
    key) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder -> Builder
    putExN (OneShot BS_Store -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx OneShot 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 _ (_, x :: Status
    x) = SomeException -> Builder
    forall a. SomeException -> a
    throwImpure (SomeException -> Builder) -> SomeException -> Builder
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => FilePath -> SomeException
    FilePath -> SomeException
    errorInternal (FilePath -> SomeException) -> FilePath -> SomeException
    forall a b. (a -> b) -> a -> b
    $ "putWith, Cannot write Status with constructor " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Status -> FilePath
    statusType Status
    x

    getDatabase :: (BS.ByteString -> Key) -> BS.ByteString -> (Key, Status)
    getDatabase :: (OneShot BS_Store -> Key) -> OneShot BS_Store -> (Key, Status)
    getDatabase getKey :: OneShot BS_Store -> Key
    getKey bs :: OneShot BS_Store
    bs
        | (key :: OneShot BS_Store
    key, bs :: OneShot BS_Store
    bs) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
    getExN OneShot BS_Store
    bs
        , (x1 :: OneShot BS_Store
    x1, bs :: OneShot BS_Store
    bs) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
    getExN OneShot BS_Store
    bs
        , (x2 :: Step
    x2, x3 :: Step
    x3, x5 :: Float
    x5, bs :: OneShot BS_Store
    bs) <- OneShot BS_Store -> (Step, Step, Float, OneShot BS_Store)
    forall a b c.
    (Storable a, Storable b, Storable c) =>
    OneShot BS_Store -> (a, b, c, OneShot BS_Store)
    binarySplit3 OneShot BS_Store
    bs
        , (x4 :: OneShot BS_Store
    x4, x6 :: OneShot BS_Store
    x6) <- OneShot BS_Store -> (OneShot BS_Store, OneShot BS_Store)
    getExN OneShot BS_Store
    bs
        = (OneShot BS_Store -> Key
    getKey OneShot BS_Store
    key, Result (OneShot BS_Store) -> Status
    Loaded (OneShot BS_Store
    -> Step
    -> Step
    -> [Depends]
    -> Float
    -> [Trace]
    -> Result (OneShot BS_Store)
    forall a.
    a -> Step -> Step -> [Depends] -> Float -> [Trace] -> Result a
    Result OneShot BS_Store
    x1 Step
    x2 Step
    x3 (OneShot BS_Store -> [Depends]
    forall a. BinaryEx a => OneShot BS_Store -> a
    getEx OneShot BS_Store
    x4) Float
    x5 (OneShot BS_Store -> [Trace]
    forall a. BinaryEx a => OneShot BS_Store -> a
    getEx OneShot BS_Store
    x6)))