    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RecordWildCards #-}

    -- | Lower-level primitives to drive Shake, which are wrapped into the
    --   'Development.Shake.shake' function. Useful if you want to perform multiple Shake
    --   runs in a row without reloading from the database.
    --   Sometimes used in conjunction with @'shakeFiles'=\"\/dev\/null\"@.
    --   Using these functions you can approximate the 'Development.Shake.shake' experience with:
    --
    -- @
    -- shake opts rules = do
    --     (_, after) \<- 'shakeWithDatabase' opts rules $ \\db -> do
    --         'shakeOneShotDatabase' db
    --         'shakeRunDatabase' db []
    --     'shakeRunAfter' opts after
    -- @
    module Development.Shake.Database(
        ShakeDatabase,
        shakeOpenDatabase,
        shakeWithDatabase,
        shakeOneShotDatabase,
        shakeRunDatabase,
        shakeLiveFilesDatabase,
        shakeProfileDatabase,
        shakeErrorsDatabase,
        shakeRunAfter
        ) where

    import Control.Concurrent.Extra
    import Control.Exception
    import Control.Monad
    import Control.Monad.IO.Class
    import Data.IORef
    import General.Cleanup
    import Development.Shake.Internal.Errors
    import Development.Shake.Internal.Options
    import Development.Shake.Internal.Core.Rules
    import Development.Shake.Internal.Core.Run
    import Development.Shake.Internal.Core.Types
    import Development.Shake.Internal.Rules.Default

    data UseState
        = Closed
        | Using String
        | Open {UseState -> Bool
    openOneShot :: Bool, UseState -> Bool
    openRequiresReset :: Bool}

    -- | The type of an open Shake database. Created with
    --   'shakeOpenDatabase' or 'shakeWithDatabase'. Used with
    --   'shakeRunDatabase'. You may not execute simultaneous calls using 'ShakeDatabase'
    --   on separate threads (it will raise an error).
    data ShakeDatabase = ShakeDatabase (Var UseState) RunState

    -- | Given some options and rules, return a pair. The first component opens the database,
    --   the second cleans it up. The creation /does not/ need to be run masked, because the
    --   cleanup is able to run at any point. Most users should prefer 'shakeWithDatabase'
    --   which handles exceptions duration creation properly.
    shakeOpenDatabase :: ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ())
    shakeOpenDatabase :: ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ())
    shakeOpenDatabase ShakeOptions
    opts Rules ()
    rules = do
        (Cleanup
    cleanup, IO ()
    clean) <- IO (Cleanup, IO ())
    newCleanup
        Var UseState
    use <- UseState -> IO (Var UseState)
    forall a. a -> IO (Var a)
    newVar (UseState -> IO (Var UseState)) -> UseState -> IO (Var UseState)
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool -> UseState
    Open Bool
    False Bool
    False
        let alloc :: IO ShakeDatabase
    alloc =
                Var UseState
    -> String
    -> (UseState -> UseState)
    -> (UseState -> IO ShakeDatabase)
    -> IO ShakeDatabase
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeOpenDatabase" UseState -> UseState
    forall a. a -> a
    id ((UseState -> IO ShakeDatabase) -> IO ShakeDatabase)
    -> (UseState -> IO ShakeDatabase) -> IO ShakeDatabase
    forall a b. (a -> b) -> a -> b
    $ \UseState
    _ ->
                    Var UseState -> RunState -> ShakeDatabase
    ShakeDatabase Var UseState
    use (RunState -> ShakeDatabase) -> IO RunState -> IO ShakeDatabase
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cleanup -> ShakeOptions -> Rules () -> IO RunState
    open Cleanup
    cleanup ShakeOptions
    opts (Rules ()
    rules Rules () -> Rules () -> Rules ()
    forall a b. Rules a -> Rules b -> Rules b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Rules ()
    defaultRules)
        let free :: IO ()
    free = do
                Var UseState -> (UseState -> IO UseState) -> IO ()
    forall a. Var a -> (a -> IO a) -> IO ()
    modifyVar_ Var UseState
    use ((UseState -> IO UseState) -> IO ())
    -> (UseState -> IO UseState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \case
                        Using String
    s -> SomeException -> IO UseState
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO UseState) -> SomeException -> IO UseState
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Maybe String)] -> String -> SomeException
    errorStructured String
    "Error when calling shakeOpenDatabase close function, currently running" [(String
    "Existing call", String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s)] String
    ""
                        UseState
    _ -> UseState -> IO UseState
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure UseState
    Closed
                IO ()
    clean
        (IO ShakeDatabase, IO ()) -> IO (IO ShakeDatabase, IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO ShakeDatabase
    alloc, IO ()
    free)

    withOpen :: Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen :: forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    var String
    name UseState -> UseState
    final UseState -> IO a
    act = ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
    -> ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> do
        UseState
    o <- Var UseState
    -> (UseState -> IO (UseState, UseState)) -> IO UseState
    forall a b. Var a -> (a -> IO (a, b)) -> IO b
    modifyVar Var UseState
    var ((UseState -> IO (UseState, UseState)) -> IO UseState)
    -> (UseState -> IO (UseState, UseState)) -> IO UseState
    forall a b. (a -> b) -> a -> b
    $ \case
            Using String
    s -> SomeException -> IO (UseState, UseState)
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO (UseState, UseState))
    -> SomeException -> IO (UseState, UseState)
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Maybe String)] -> String -> SomeException
    errorStructured (String
    "Error when calling " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", currently running") [(String
    "Existing call", String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s)] String
    ""
            UseState
    Closed -> SomeException -> IO (UseState, UseState)
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO (UseState, UseState))
    -> SomeException -> IO (UseState, UseState)
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Maybe String)] -> String -> SomeException
    errorStructured (String
    "Error when calling " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", already closed") [] String
    ""
            o :: UseState
    o@Open{} -> (UseState, UseState) -> IO (UseState, UseState)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> UseState
    Using String
    name, UseState
    o)
        let clean :: IO ()
    clean = Var UseState -> UseState -> IO ()
    forall a. Var a -> a -> IO ()
    writeVar Var UseState
    var (UseState -> IO ()) -> UseState -> IO ()
    forall a b. (a -> b) -> a -> b
    $ UseState -> UseState
    final UseState
    o
        a
    res <- IO a -> IO a
    forall a. IO a -> IO a
    restore (UseState -> IO a
    act UseState
    o) IO a -> IO () -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` IO ()
    clean
        IO ()
    clean
        a -> IO a
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    res

    -- | Declare that a just-openned database will be used to call 'shakeRunDatabase' at most once.
    --   If so, an optimisation can be applied to retain less memory.
    shakeOneShotDatabase :: ShakeDatabase -> IO ()
    shakeOneShotDatabase :: ShakeDatabase -> IO ()
    shakeOneShotDatabase (ShakeDatabase Var UseState
    use RunState
    _) =
        Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO ()) -> IO ()
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeOneShotDatabase" (\UseState
    o -> UseState
    o{openOneShot=True}) ((UseState -> IO ()) -> IO ()) -> (UseState -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \UseState
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    -- | Given some options and rules, create a 'ShakeDatabase' that can be used to run
    --   executions.
    shakeWithDatabase :: ShakeOptions -> Rules () -> (ShakeDatabase -> IO a) -> IO a
    shakeWithDatabase :: forall a.
    ShakeOptions -> Rules () -> (ShakeDatabase -> IO a) -> IO a
    shakeWithDatabase ShakeOptions
    opts Rules ()
    rules ShakeDatabase -> IO a
    act = do
        (IO ShakeDatabase
    db, IO ()
    clean) <- ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ())
    shakeOpenDatabase ShakeOptions
    opts Rules ()
    rules
        (ShakeDatabase -> IO a
    act (ShakeDatabase -> IO a) -> IO ShakeDatabase -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO ShakeDatabase
    db) IO a -> IO () -> IO a
    forall a b. IO a -> IO b -> IO a
    `finally` IO ()
    clean

    -- | Given a 'ShakeDatabase', what files did the execution ensure were up-to-date
    --   in the previous call to 'shakeRunDatabase'. Corresponds to the list of files
    --   written out to 'shakeLiveFiles'.
    shakeLiveFilesDatabase :: ShakeDatabase -> IO [FilePath]
    shakeLiveFilesDatabase :: ShakeDatabase -> IO [String]
    shakeLiveFilesDatabase (ShakeDatabase Var UseState
    use RunState
    s) =
        Var UseState
    -> String
    -> (UseState -> UseState)
    -> (UseState -> IO [String])
    -> IO [String]
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeLiveFilesDatabase" UseState -> UseState
    forall a. a -> a
    id ((UseState -> IO [String]) -> IO [String])
    -> (UseState -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \UseState
    _ ->
            RunState -> IO [String]
    liveFilesState RunState
    s

    -- | Given a 'ShakeDatabase', generate profile information to the given file about the latest run.
    --   See 'shakeReport' for the types of file that can be generated.
    shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()
    shakeProfileDatabase :: ShakeDatabase -> String -> IO ()
    shakeProfileDatabase (ShakeDatabase Var UseState
    use RunState
    s) String
    file =
        Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO ()) -> IO ()
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeProfileDatabase" UseState -> UseState
    forall a. a -> a
    id ((UseState -> IO ()) -> IO ()) -> (UseState -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \UseState
    _ ->
            RunState -> String -> IO ()
    profileState RunState
    s String
    file

    -- | Given a 'ShakeDatabase', what files did the execution reach an error on last time.
    --   Some special considerations when using this function:
    --
    -- * The presence of an error does not mean the build will fail, specifically if a
    --   previously required dependency was run and raised an error, then the thing that previously
    --   required it will be run. If the build system has changed in an untracked manner,
    --   the build may succeed this time round.
    --
    -- * If the previous run actually failed then 'shakeRunDatabase' will have thrown an exception.
    --   You probably want to catch that exception so you can make the call to 'shakeErrorsDatabase'.
    --
    -- * You may see a single failure reported multiple times, with increasingly large call stacks, showing
    --   the ways in which the error lead to further errors throughout.
    --
    -- * The 'SomeException' values are highly likely to be of type 'ShakeException'.
    --
    -- * If you want as many errors as possible in one run set @'shakeStaunch'=True@.
    shakeErrorsDatabase :: ShakeDatabase -> IO [(String, SomeException)]
    shakeErrorsDatabase :: ShakeDatabase -> IO [(String, SomeException)]
    shakeErrorsDatabase (ShakeDatabase Var UseState
    use RunState
    s) =
        Var UseState
    -> String
    -> (UseState -> UseState)
    -> (UseState -> IO [(String, SomeException)])
    -> IO [(String, SomeException)]
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeErrorsDatabase" UseState -> UseState
    forall a. a -> a
    id ((UseState -> IO [(String, SomeException)])
     -> IO [(String, SomeException)])
    -> (UseState -> IO [(String, SomeException)])
    -> IO [(String, SomeException)]
    forall a b. (a -> b) -> a -> b
    $ \UseState
    _ ->
            RunState -> IO [(String, SomeException)]
    errorsState RunState
    s

    -- | Given an open 'ShakeDatabase', run both whatever actions were added to the 'Rules',
    --   plus the list of 'Action' given here. Returns the results from the explicitly passed
    --   actions along with a list of actions to run after the database was closed, as added with
    --   'Development.Shake.runAfter' and 'Development.Shake.removeFilesAfter'.
    shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO ([a], [IO ()])
    shakeRunDatabase :: forall a. ShakeDatabase -> [Action a] -> IO ([a], [IO ()])
    shakeRunDatabase (ShakeDatabase Var UseState
    use RunState
    s) [Action a]
    as =
        Var UseState
    -> String
    -> (UseState -> UseState)
    -> (UseState -> IO ([a], [IO ()]))
    -> IO ([a], [IO ()])
    forall a.
    Var UseState
    -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a
    withOpen Var UseState
    use String
    "shakeRunDatabase" (\UseState
    o -> UseState
    o{openRequiresReset=True}) ((UseState -> IO ([a], [IO ()])) -> IO ([a], [IO ()]))
    -> (UseState -> IO ([a], [IO ()])) -> IO ([a], [IO ()])
    forall a b. (a -> b) -> a -> b
    $ \Open{Bool
    openOneShot :: UseState -> Bool
    openRequiresReset :: UseState -> Bool
    openOneShot :: Bool
    openRequiresReset :: Bool
    ..} -> do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    openRequiresReset (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    openOneShot (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    SomeException -> IO ()
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO ()) -> SomeException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Maybe String)] -> String -> SomeException
    errorStructured String
    "Error when calling shakeRunDatabase twice, after calling shakeOneShotDatabase" [] String
    ""
                RunState -> IO ()
    reset RunState
    s
            ([IORef (Maybe a)]
    refs, [Action ()]
    as) <- ([(IORef (Maybe a), Action ())]
     -> ([IORef (Maybe a)], [Action ()]))
    -> IO [(IORef (Maybe a), Action ())]
    -> IO ([IORef (Maybe a)], [Action ()])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(IORef (Maybe a), Action ())] -> ([IORef (Maybe a)], [Action ()])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (IO [(IORef (Maybe a), Action ())]
     -> IO ([IORef (Maybe a)], [Action ()]))
    -> IO [(IORef (Maybe a), Action ())]
    -> IO ([IORef (Maybe a)], [Action ()])
    forall a b. (a -> b) -> a -> b
    $ [Action a]
    -> (Action a -> IO (IORef (Maybe a), Action ()))
    -> IO [(IORef (Maybe a), Action ())]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Action a]
    as ((Action a -> IO (IORef (Maybe a), Action ()))
     -> IO [(IORef (Maybe a), Action ())])
    -> (Action a -> IO (IORef (Maybe a), Action ()))
    -> IO [(IORef (Maybe a), Action ())]
    forall a b. (a -> b) -> a -> b
    $ \Action a
    a -> do
                IORef (Maybe a)
    ref <- Maybe a -> IO (IORef (Maybe a))
    forall a. a -> IO (IORef a)
    newIORef Maybe a
    forall a. Maybe a
    Nothing
                (IORef (Maybe a), Action ()) -> IO (IORef (Maybe a), Action ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IORef (Maybe a)
    ref, IO () -> Action ()
    forall a. IO a -> Action a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Action ()) -> (a -> IO ()) -> a -> Action ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef (Maybe a) -> Maybe a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe a)
    ref (Maybe a -> IO ()) -> (a -> Maybe a) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Action ()) -> Action a -> Action ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Action a
    a)
            [IO ()]
    after <- RunState -> Bool -> [Action ()] -> IO [IO ()]
    run RunState
    s Bool
    openOneShot ([Action ()] -> IO [IO ()]) -> [Action ()] -> IO [IO ()]
    forall a b. (a -> b) -> a -> b
    $ (Action () -> Action ()) -> [Action ()] -> [Action ()]
    forall a b. (a -> b) -> [a] -> [b]
    map Action () -> Action ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void [Action ()]
    as
            [Maybe a]
    results <- (IORef (Maybe a) -> IO (Maybe a))
    -> [IORef (Maybe a)] -> IO [Maybe a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM IORef (Maybe a) -> IO (Maybe a)
    forall a. IORef a -> IO a
    readIORef [IORef (Maybe a)]
    refs
            case [Maybe a] -> Maybe [a]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Maybe a]
    results of
                Just [a]
    result -> ([a], [IO ()]) -> IO ([a], [IO ()])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([a]
    result, [IO ()]
    after)
                Maybe [a]
    Nothing -> SomeException -> IO ([a], [IO ()])
    forall (m :: * -> *) a. MonadIO m => SomeException -> m a
    throwM (SomeException -> IO ([a], [IO ()]))
    -> SomeException -> IO ([a], [IO ()])
    forall a b. (a -> b) -> a -> b
    $ Partial => String -> SomeException
    String -> SomeException
    errorInternal String
    "Expected all results were written, but some where not"