module Control.AutoUpdate.Types where

-- | 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
    { forall a. UpdateSettings a -> Int
updateFreq :: Int
    -- ^ Microseconds between update calls. Same considerations as
    -- 'threadDelay' apply.
    --
    -- Default: 1000000 microseconds (1 second)
    --
    -- @since 0.1.0
    , forall a. UpdateSettings a -> Int
updateSpawnThreshold :: Int
    -- ^ Obsoleted field.
    --
    -- @since 0.1.0
    , forall a. UpdateSettings a -> IO a
updateAction :: IO a
    -- ^ Action to be performed to get the current value.
    --
    -- Default: does nothing.
    --
    -- @since 0.1.0
    , forall a. UpdateSettings a -> String
updateThreadName :: String
    -- ^ Label of the thread being forked.
    --
    -- Default: @"AutoUpdate"@
    --
    -- @since 0.2.2
    }

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