    {-# LANGUAGE CPP #-}
    -- | In a multithreaded environment, running actions on a regularly scheduled
    -- background thread can dramatically improve performance.
    -- For example, web servers need to return the current time with each HTTP response.
    -- For a high-volume server, it's much faster for a dedicated thread to run every
    -- second, and write the current time to a shared 'IORef', than it is for each
    -- request to make its own call to 'getCurrentTime'.
    --
    -- But for a low-volume server, whose request frequency is less than once per
    -- second, that approach will result in /more/ calls to 'getCurrentTime' than
    -- necessary, and worse, kills idle GC.
    --
    -- This library solves that problem by allowing you to define actions which will
    -- either be performed by a dedicated thread, or, in times of low volume, will
    -- be executed by the calling thread.
    --
    -- Example usage:
    --
    -- @
    -- import "Data.Time"
    -- import "Control.AutoUpdate"
    --
    -- getTime <- 'mkAutoUpdate' 'defaultUpdateSettings'
    --              { 'updateAction' = 'Data.Time.Clock.getCurrentTime'
    --              , 'updateFreq' = 1000000 -- The default frequency, once per second
    --              }
    -- currentTime <- getTime
    -- @
    --
    -- For more examples, <http://www.yesodweb.com/blog/2014/08/announcing-auto-update see the blog post introducing this library>.
    module Control.AutoUpdate (
          -- * Type
          UpdateSettings
        , defaultUpdateSettings
          -- * Accessors
        , updateAction
        , updateFreq
        , updateSpawnThreshold
          -- * Creation
        , mkAutoUpdate
        , mkAutoUpdateWithModify
        ) where

    #if __GLASGOW_HASKELL__ < 709
    import           Control.Applicative     ((<*>))
    #endif
    import           Control.Concurrent      (forkIO, threadDelay)
    import           Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar,
                                              takeMVar, tryPutMVar)
    import           Control.Exception       (SomeException, catch, mask_, throw,
                                              try)
    import           Control.Monad           (void)
    import           Data.IORef              (newIORef, readIORef, writeIORef)

    -- | Default value for creating an 'UpdateSettings'.
    --
    -- @since 0.1.0
    defaultUpdateSettings :: UpdateSettings ()
    defaultUpdateSettings :: UpdateSettings ()
    defaultUpdateSettings = $WUpdateSettings :: forall a. Int -> Int -> IO a -> UpdateSettings a
    UpdateSettings
        { updateFreq :: Int
    updateFreq = 1000000
        , updateSpawnThreshold :: Int
    updateSpawnThreshold = 3
        , updateAction :: IO ()
    updateAction = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        }

    -- | Settings to control how values are updated.
    --
    -- This should be constructed using 'defaultUpdateSettings' and record
    -- update syntax, e.g.:
    --
    -- @
    -- let settings = 'defaultUpdateSettings' { 'updateAction' = 'Data.Time.Clock.getCurrentTime' }
    -- @
    --
    -- @since 0.1.0
    data UpdateSettings a = UpdateSettings
        { UpdateSettings a -> Int
    updateFreq           :: Int
        -- ^ Microseconds between update calls. Same considerations as
        -- 'threadDelay' apply.
        --
        -- Default: 1 second (1000000)
        --
        -- @since 0.1.0
        , UpdateSettings a -> Int
    updateSpawnThreshold :: Int
        -- ^ NOTE: This value no longer has any effect, since worker threads are
        -- dedicated instead of spawned on demand.
        --
        -- Previously, this determined how many times the data must be requested
        -- before we decide to spawn a dedicated thread.
        --
        -- Default: 3
        --
        -- @since 0.1.0
        , UpdateSettings a -> IO a
    updateAction         :: IO a
        -- ^ Action to be performed to get the current value.
        --
        -- Default: does nothing.
        --
        -- @since 0.1.0
        }

    -- | Generate an action which will either read from an automatically
    -- updated value, or run the update action in the current thread.
    --
    -- @since 0.1.0
    mkAutoUpdate :: UpdateSettings a -> IO (IO a)
    mkAutoUpdate :: UpdateSettings a -> IO (IO a)
    mkAutoUpdate us :: UpdateSettings a
    us = UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    forall a. UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    mkAutoUpdateHelper UpdateSettings a
    us Maybe (a -> IO a)
    forall a. Maybe a
    Nothing

    -- | Generate an action which will either read from an automatically
    -- updated value, or run the update action in the current thread if
    -- the first time or the provided modify action after that.
    --
    -- @since 0.1.4
    mkAutoUpdateWithModify :: UpdateSettings a -> (a -> IO a) -> IO (IO a)
    mkAutoUpdateWithModify :: UpdateSettings a -> (a -> IO a) -> IO (IO a)
    mkAutoUpdateWithModify us :: UpdateSettings a
    us f :: a -> IO a
    f = UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    forall a. UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    mkAutoUpdateHelper UpdateSettings a
    us ((a -> IO a) -> Maybe (a -> IO a)
    forall a. a -> Maybe a
    Just a -> IO a
    f)

    mkAutoUpdateHelper :: UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    mkAutoUpdateHelper :: UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
    mkAutoUpdateHelper us :: UpdateSettings a
    us updateActionModify :: Maybe (a -> IO a)
    updateActionModify = do
        -- A baton to tell the worker thread to generate a new value.
        MVar ()
    needsRunning <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar

        -- The initial response variable. Response variables allow the requesting
        -- thread to block until a value is generated by the worker thread.
        MVar a
    responseVar0 <- IO (MVar a)
    forall a. IO (MVar a)
    newEmptyMVar

        -- The current value, if available. We start off with a Left value
        -- indicating no value is available, and the above-created responseVar0 to
        -- give a variable to block on.
        IORef (Either (MVar a) a)
    currRef <- Either (MVar a) a -> IO (IORef (Either (MVar a) a))
    forall a. a -> IO (IORef a)
    newIORef (Either (MVar a) a -> IO (IORef (Either (MVar a) a)))
    -> Either (MVar a) a -> IO (IORef (Either (MVar a) a))
    forall a b. (a -> b) -> a -> b
    $ MVar a -> Either (MVar a) a
    forall a b. a -> Either a b
    Left MVar a
    responseVar0

        -- This is used to set a value in the currRef variable when the worker
        -- thread exits. In reality, that value should never be used, since the
        -- worker thread exiting only occurs if an async exception is thrown, which
        -- should only occur if there are no references to needsRunning left.
        -- However, this handler will make error messages much clearer if there's a
        -- bug in the implementation.
        let fillRefOnExit :: IO () -> IO ()
    fillRefOnExit f :: IO ()
    f = do
                Either SomeException ()
    eres <- IO () -> IO (Either SomeException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO ()
    f
                case Either SomeException ()
    eres of
                    Left e :: SomeException
    e -> IORef (Either (MVar a) a) -> Either (MVar a) a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Either (MVar a) a)
    currRef (Either (MVar a) a -> IO ()) -> Either (MVar a) a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Either (MVar a) a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either (MVar a) a) -> [Char] -> Either (MVar a) a
    forall a b. (a -> b) -> a -> b
    $
                        "Control.AutoUpdate.mkAutoUpdate: worker thread exited with exception: "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show (SomeException
    e :: SomeException)
                    Right () -> IORef (Either (MVar a) a) -> Either (MVar a) a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Either (MVar a) a)
    currRef (Either (MVar a) a -> IO ()) -> Either (MVar a) a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Either (MVar a) a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either (MVar a) a) -> [Char] -> Either (MVar a) a
    forall a b. (a -> b) -> a -> b
    $
                        "Control.AutoUpdate.mkAutoUpdate: worker thread exited normally, "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ "which should be impossible due to usage of infinite loop"

        -- fork the worker thread immediately. Note that we mask async exceptions,
        -- but *not* in an uninterruptible manner. This will allow a
        -- BlockedIndefinitelyOnMVar exception to still be thrown, which will take
        -- down this thread when all references to the returned function are
        -- garbage collected, and therefore there is no thread that can fill the
        -- needsRunning MVar.
        --
        -- Note that since we throw away the ThreadId of this new thread and never
        -- calls myThreadId, normal async exceptions can never be thrown to it,
        -- only RTS exceptions.
        IO () -> IO ()
    forall a. IO a -> IO a
    mask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ()
    fillRefOnExit (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- This infinite loop makes up out worker thread. It takes an a
            -- responseVar value where the next value should be putMVar'ed to for
            -- the benefit of any requesters currently blocked on it.
            let loop :: MVar a -> Maybe a -> IO b
    loop responseVar :: MVar a
    responseVar maybea :: Maybe a
    maybea = do
                    -- block until a value is actually needed
                    MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    needsRunning

                    -- new value requested, so run the updateAction
                    a
    a <- IO a -> IO a
    forall a. IO a -> IO a
    catchSome (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a -> (IO a -> IO a) -> Maybe (IO a) -> IO a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (UpdateSettings a -> IO a
    forall a. UpdateSettings a -> IO a
    updateAction UpdateSettings a
    us) IO a -> IO a
    forall a. a -> a
    id (Maybe (a -> IO a)
    updateActionModify Maybe (a -> IO a) -> Maybe a -> Maybe (IO a)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe a
    maybea)

                    -- we got a new value, update currRef and lastValue
                    IORef (Either (MVar a) a) -> Either (MVar a) a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Either (MVar a) a)
    currRef (Either (MVar a) a -> IO ()) -> Either (MVar a) a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ a -> Either (MVar a) a
    forall a b. b -> Either a b
    Right a
    a
                    MVar a -> a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar a
    responseVar a
    a

                    -- delay until we're needed again
                    Int -> IO ()
    threadDelay (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ UpdateSettings a -> Int
    forall a. UpdateSettings a -> Int
    updateFreq UpdateSettings a
    us

                    -- delay's over. create a new response variable and set currRef
                    -- to use it, so that the next requester will block on that
                    -- variable. Then loop again with the updated response
                    -- variable.
                    MVar a
    responseVar' <- IO (MVar a)
    forall a. IO (MVar a)
    newEmptyMVar
                    IORef (Either (MVar a) a) -> Either (MVar a) a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Either (MVar a) a)
    currRef (Either (MVar a) a -> IO ()) -> Either (MVar a) a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MVar a -> Either (MVar a) a
    forall a b. a -> Either a b
    Left MVar a
    responseVar'
                    MVar a -> Maybe a -> IO b
    loop MVar a
    responseVar' (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)

            -- Kick off the loop, with the initial responseVar0 variable.
            MVar a -> Maybe a -> IO ()
    forall b. MVar a -> Maybe a -> IO b
    loop MVar a
    responseVar0 Maybe a
    forall a. Maybe a
    Nothing

        IO a -> IO (IO a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
    forall a b. (a -> b) -> a -> b
    $ do
            Either (MVar a) a
    mval <- IORef (Either (MVar a) a) -> IO (Either (MVar a) a)
    forall a. IORef a -> IO a
    readIORef IORef (Either (MVar a) a)
    currRef
            case Either (MVar a) a
    mval of
                Left responseVar :: MVar a
    responseVar -> do
                    -- no current value, force the worker thread to run...
                    IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MVar () -> () -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar MVar ()
    needsRunning ()

                    -- and block for the result from the worker
                    MVar a -> IO a
    forall a. MVar a -> IO a
    readMVar MVar a
    responseVar
                -- we have a current value, use it
                Right val :: a
    val -> a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    val

    -- | Turn a runtime exception into an impure exception, so that all 'IO'
    -- actions will complete successfully. This simply defers the exception until
    -- the value is forced.
    catchSome :: IO a -> IO a
    catchSome :: IO a -> IO a
    catchSome act :: IO a
    act = IO a -> (SomeException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch IO a
    act ((SomeException -> IO a) -> IO a)
    -> (SomeException -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \e :: SomeException
    e -> a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> a -> IO a
    forall a b. (a -> b) -> a -> b
    $ SomeException -> a
    forall a e. Exception e => e -> a
    throw (SomeException
    e :: SomeException)