    -- | Like the vertical bar, but this widget automatically updates
    -- itself with a callback at fixed intervals.
    module System.Taffybar.Widget.Generic.PollingBar (
      -- * Types
      VerticalBarHandle,
      BarConfig(..),
      BarDirection(..),
      -- * Constructors and accessors
      pollingBarNew,
      verticalBarFromCallback,
      defaultBarConfig
      ) where

    import Control.Concurrent
    import Control.Exception.Enclosed ( tryAny )
    import qualified GI.Gtk
    import System.Taffybar.Widget.Util ( backgroundLoop )
    import Control.Monad.IO.Class

    import System.Taffybar.Widget.Generic.VerticalBar

    verticalBarFromCallback :: MonadIO m
                            => BarConfig -> IO Double -> m GI.Gtk.Widget
    verticalBarFromCallback :: BarConfig -> IO Double -> m Widget
    verticalBarFromCallback cfg :: BarConfig
    cfg action :: IO Double
    action = IO Widget -> m Widget
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $ do
      (drawArea :: Widget
    drawArea, h :: VerticalBarHandle
    h) <- BarConfig -> IO (Widget, VerticalBarHandle)
    forall (m :: * -> *).
    MonadIO m =>
    BarConfig -> m (Widget, VerticalBarHandle)
    verticalBarNew BarConfig
    cfg
      SignalHandlerId
    _ <- Widget -> WidgetRealizeCallback -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> WidgetRealizeCallback -> m SignalHandlerId
    GI.Gtk.onWidgetRealize Widget
    drawArea (WidgetRealizeCallback -> IO SignalHandlerId)
    -> WidgetRealizeCallback -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ IO (Either SomeException ()) -> WidgetRealizeCallback
    forall a. IO a -> WidgetRealizeCallback
    backgroundLoop (IO (Either SomeException ()) -> WidgetRealizeCallback)
    -> IO (Either SomeException ()) -> WidgetRealizeCallback
    forall a b. (a -> b) -> a -> b
    $ do
          Either SomeException Double
    esample <- IO Double -> IO (Either SomeException Double)
    forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> m (Either SomeException a)
    tryAny IO Double
    action
          (Double -> WidgetRealizeCallback)
    -> Either SomeException Double -> IO (Either SomeException ())
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (VerticalBarHandle -> Double -> WidgetRealizeCallback
    verticalBarSetPercent VerticalBarHandle
    h) Either SomeException Double
    esample
      Widget -> IO Widget
    forall (m :: * -> *) a. Monad m => a -> m a
    return Widget
    drawArea

    pollingBarNew :: MonadIO m
                  => BarConfig -> Double -> IO Double -> m GI.Gtk.Widget
    pollingBarNew :: BarConfig -> Double -> IO Double -> m Widget
    pollingBarNew cfg :: BarConfig
    cfg pollSeconds :: Double
    pollSeconds action :: IO Double
    action =
      IO Widget -> m Widget
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $
      BarConfig -> IO Double -> IO Widget
    forall (m :: * -> *).
    MonadIO m =>
    BarConfig -> IO Double -> m Widget
    verticalBarFromCallback BarConfig
    cfg (IO Double -> IO Widget) -> IO Double -> IO Widget
    forall a b. (a -> b) -> a -> b
    $ IO Double
    action IO Double -> WidgetRealizeCallback -> IO Double
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* WidgetRealizeCallback
    delay
      where delay :: WidgetRealizeCallback
    delay = Int -> WidgetRealizeCallback
    threadDelay (Int -> WidgetRealizeCallback) -> Int -> WidgetRealizeCallback
    forall a b. (a -> b) -> a -> b
    $ Double -> Int
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double
    pollSeconds Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * 1000000)