    {-# LANGUAGE RecordWildCards #-}

    module Control.AutoUpdate.Event (
        -- * Creation
        mkAutoUpdate,
        mkAutoUpdateWithModify,

        -- * Internal
        UpdateState (..),
        mkClosableAutoUpdate,
        mkClosableAutoUpdate',
    )
    where

    import Control.Concurrent.STM
    import Control.Monad
    import Data.IORef
    import GHC.Event (getSystemTimerManager, registerTimeout, unregisterTimeout)

    import Control.AutoUpdate.Types

    --------------------------------------------------------------------------------

    -- | 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 :: forall a. UpdateSettings a -> IO (IO a)
    mkAutoUpdate = (IO a -> IO () -> UpdateState a -> IO a)
    -> UpdateSettings a -> IO (IO a)
    forall a b.
    (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> IO b
    mkAutoUpdateThings ((IO a -> IO () -> UpdateState a -> IO a)
     -> UpdateSettings a -> IO (IO a))
    -> (IO a -> IO () -> UpdateState a -> IO a)
    -> UpdateSettings a
    -> IO (IO a)
    forall a b. (a -> b) -> a -> b
    $ \IO a
    g IO ()
    _ UpdateState a
    _ -> IO a
    g

    -- | 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 :: forall a. UpdateSettings a -> (a -> IO a) -> IO (IO a)
    mkAutoUpdateWithModify UpdateSettings a
    us a -> IO a
    f = (IO a -> IO () -> UpdateState a -> IO a)
    -> UpdateSettings a -> (a -> IO a) -> IO (IO a)
    forall a b.
    (IO a -> IO () -> UpdateState a -> b)
    -> UpdateSettings a -> (a -> IO a) -> IO b
    mkAutoUpdateThingsWithModify (\IO a
    g IO ()
    _ UpdateState a
    _ -> IO a
    g) UpdateSettings a
    us a -> IO a
    f

    --------------------------------------------------------------------------------

    {- FOURMOLU_DISABLE -}
    data UpdateState a =
        UpdateState
        { forall a. UpdateState a -> a -> IO a
    usUpdateAction_   :: a -> IO a
        , forall a. UpdateState a -> IORef a
    usLastResult_     :: IORef a
        , forall a. UpdateState a -> Int
    usIntervalMicro_  :: Int
        , forall a. UpdateState a -> TVar Bool
    usTimeHasCome_    :: TVar Bool
        , forall a. UpdateState a -> IORef (IO ())
    usDeleteTimeout_  :: IORef (IO ())
        }
    {- FOURMOLU_ENABLE -}

    --------------------------------------------------------------------------------

    mkAutoUpdateThings
        :: (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> IO b
    mkAutoUpdateThings :: forall a b.
    (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> IO b
    mkAutoUpdateThings IO a -> IO () -> UpdateState a -> b
    mk settings :: UpdateSettings a
    settings@UpdateSettings{Int
    String
    IO a
    updateFreq :: Int
    updateSpawnThreshold :: Int
    updateAction :: IO a
    updateThreadName :: String
    updateThreadName :: forall a. UpdateSettings a -> String
    updateAction :: forall a. UpdateSettings a -> IO a
    updateSpawnThreshold :: forall a. UpdateSettings a -> Int
    updateFreq :: forall a. UpdateSettings a -> Int
    ..} =
        (IO a -> IO () -> UpdateState a -> b)
    -> UpdateSettings a -> (a -> IO a) -> IO b
    forall a b.
    (IO a -> IO () -> UpdateState a -> b)
    -> UpdateSettings a -> (a -> IO a) -> IO b
    mkAutoUpdateThingsWithModify IO a -> IO () -> UpdateState a -> b
    mk UpdateSettings a
    settings (IO a -> a -> IO a
    forall a b. a -> b -> a
    const IO a
    updateAction)

    mkAutoUpdateThingsWithModify
        :: (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> (a -> IO a) -> IO b
    mkAutoUpdateThingsWithModify :: forall a b.
    (IO a -> IO () -> UpdateState a -> b)
    -> UpdateSettings a -> (a -> IO a) -> IO b
    mkAutoUpdateThingsWithModify IO a -> IO () -> UpdateState a -> b
    mk UpdateSettings a
    settings a -> IO a
    update1 = do
        us <- UpdateSettings a -> (a -> IO a) -> IO (UpdateState a)
    forall a. UpdateSettings a -> (a -> IO a) -> IO (UpdateState a)
    openUpdateState UpdateSettings a
    settings a -> IO a
    update1
        pure $ mk (getUpdateResult us) (closeUpdateState us) us

    --------------------------------------------------------------------------------

    -- $setup
    -- >>> :set -XNumericUnderscores
    -- >>> import Control.Concurrent

    -- |
    -- >>> iref <- newIORef (0 :: Int)
    -- >>> action = modifyIORef iref (+ 1) >> readIORef iref
    -- >>> (getValue, closeState) <- mkClosableAutoUpdate $ defaultUpdateSettings { updateFreq = 200_000, updateAction = action }
    -- >>> getValue
    -- 1
    -- >>> threadDelay 100_000 >> getValue
    -- 1
    -- >>> threadDelay 200_000 >> getValue
    -- 2
    -- >>> closeState
    mkClosableAutoUpdate :: UpdateSettings a -> IO (IO a, IO ())
    mkClosableAutoUpdate :: forall a. UpdateSettings a -> IO (IO a, IO ())
    mkClosableAutoUpdate = (IO a -> IO () -> UpdateState a -> (IO a, IO ()))
    -> UpdateSettings a -> IO (IO a, IO ())
    forall a b.
    (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> IO b
    mkAutoUpdateThings ((IO a -> IO () -> UpdateState a -> (IO a, IO ()))
     -> UpdateSettings a -> IO (IO a, IO ()))
    -> (IO a -> IO () -> UpdateState a -> (IO a, IO ()))
    -> UpdateSettings a
    -> IO (IO a, IO ())
    forall a b. (a -> b) -> a -> b
    $ \IO a
    g IO ()
    c UpdateState a
    _ -> (IO a
    g, IO ()
    c)

    -- | provide `UpdateState` for debugging
    mkClosableAutoUpdate' :: UpdateSettings a -> IO (IO a, IO (), UpdateState a)
    mkClosableAutoUpdate' :: forall a. UpdateSettings a -> IO (IO a, IO (), UpdateState a)
    mkClosableAutoUpdate' = (IO a -> IO () -> UpdateState a -> (IO a, IO (), UpdateState a))
    -> UpdateSettings a -> IO (IO a, IO (), UpdateState a)
    forall a b.
    (IO a -> IO () -> UpdateState a -> b) -> UpdateSettings a -> IO b
    mkAutoUpdateThings (,,)

    --------------------------------------------------------------------------------

    mkDeleteTimeout :: TVar Bool -> Int -> IO (IO ())
    mkDeleteTimeout :: TVar Bool -> Int -> IO (IO ())
    mkDeleteTimeout TVar Bool
    thc Int
    micro = do
        mgr <- IO TimerManager
    getSystemTimerManager
        key <- registerTimeout mgr micro (atomically $ writeTVar thc True)
        pure $ unregisterTimeout mgr key

    openUpdateState :: UpdateSettings a -> (a -> IO a) -> IO (UpdateState a)
    openUpdateState :: forall a. UpdateSettings a -> (a -> IO a) -> IO (UpdateState a)
    openUpdateState UpdateSettings{Int
    String
    IO a
    updateThreadName :: forall a. UpdateSettings a -> String
    updateAction :: forall a. UpdateSettings a -> IO a
    updateSpawnThreshold :: forall a. UpdateSettings a -> Int
    updateFreq :: forall a. UpdateSettings a -> Int
    updateFreq :: Int
    updateSpawnThreshold :: Int
    updateAction :: IO a
    updateThreadName :: String
    ..} a -> IO a
    update1 = do
        thc <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        UpdateState update1
            <$> (newIORef =<< updateAction)
            <*> pure updateFreq
            <*> pure thc
            <*> (newIORef =<< mkDeleteTimeout thc updateFreq)

    closeUpdateState :: UpdateState a -> IO ()
    closeUpdateState :: forall a. UpdateState a -> IO ()
    closeUpdateState UpdateState{Int
    TVar Bool
    IORef a
    IORef (IO ())
    a -> IO a
    usUpdateAction_ :: forall a. UpdateState a -> a -> IO a
    usLastResult_ :: forall a. UpdateState a -> IORef a
    usIntervalMicro_ :: forall a. UpdateState a -> Int
    usTimeHasCome_ :: forall a. UpdateState a -> TVar Bool
    usDeleteTimeout_ :: forall a. UpdateState a -> IORef (IO ())
    usUpdateAction_ :: a -> IO a
    usLastResult_ :: IORef a
    usIntervalMicro_ :: Int
    usTimeHasCome_ :: TVar Bool
    usDeleteTimeout_ :: IORef (IO ())
    ..} = do
        delete <- IORef (IO ()) -> IO (IO ())
    forall a. IORef a -> IO a
    readIORef IORef (IO ())
    usDeleteTimeout_
        delete

    onceOnTimeHasCome :: UpdateState a -> IO () -> IO ()
    onceOnTimeHasCome :: forall a. UpdateState a -> IO () -> IO ()
    onceOnTimeHasCome UpdateState{Int
    TVar Bool
    IORef a
    IORef (IO ())
    a -> IO a
    usUpdateAction_ :: forall a. UpdateState a -> a -> IO a
    usLastResult_ :: forall a. UpdateState a -> IORef a
    usIntervalMicro_ :: forall a. UpdateState a -> Int
    usTimeHasCome_ :: forall a. UpdateState a -> TVar Bool
    usDeleteTimeout_ :: forall a. UpdateState a -> IORef (IO ())
    usUpdateAction_ :: a -> IO a
    usLastResult_ :: IORef a
    usIntervalMicro_ :: Int
    usTimeHasCome_ :: TVar Bool
    usDeleteTimeout_ :: IORef (IO ())
    ..} IO ()
    action = do
        action' <- STM (IO ()) -> IO (IO ())
    forall a. STM a -> IO a
    atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
            timeHasCome <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    usTimeHasCome_
            when timeHasCome $ writeTVar usTimeHasCome_ False
            pure $ when timeHasCome action
        action'

    getUpdateResult :: UpdateState a -> IO a
    getUpdateResult :: forall a. UpdateState a -> IO a
    getUpdateResult us :: UpdateState a
    us@UpdateState{Int
    TVar Bool
    IORef a
    IORef (IO ())
    a -> IO a
    usUpdateAction_ :: forall a. UpdateState a -> a -> IO a
    usLastResult_ :: forall a. UpdateState a -> IORef a
    usIntervalMicro_ :: forall a. UpdateState a -> Int
    usTimeHasCome_ :: forall a. UpdateState a -> TVar Bool
    usDeleteTimeout_ :: forall a. UpdateState a -> IORef (IO ())
    usUpdateAction_ :: a -> IO a
    usLastResult_ :: IORef a
    usIntervalMicro_ :: Int
    usTimeHasCome_ :: TVar Bool
    usDeleteTimeout_ :: IORef (IO ())
    ..} = do
        UpdateState a -> IO () -> IO ()
    forall a. UpdateState a -> IO () -> IO ()
    onceOnTimeHasCome UpdateState a
    us (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    usLastResult_ (a -> IO ()) -> IO a -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< a -> IO a
    usUpdateAction_ (a -> IO a) -> IO a -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    usLastResult_
            IORef (IO ()) -> IO () -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (IO ())
    usDeleteTimeout_ (IO () -> IO ()) -> IO (IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TVar Bool -> Int -> IO (IO ())
    mkDeleteTimeout TVar Bool
    usTimeHasCome_ Int
    usIntervalMicro_
        IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    usLastResult_