-- | 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 :: forall (m :: * -> *).
MonadIO m =>
BarConfig -> IO Double -> m Widget
verticalBarFromCallback BarConfig
cfg IO Double
action = IO Widget -> m Widget
forall a. IO a -> m a
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, h) <- BarConfig -> IO (Widget, VerticalBarHandle)
forall (m :: * -> *).
MonadIO m =>
BarConfig -> m (Widget, VerticalBarHandle)
verticalBarNew BarConfig
cfg
  _ <- GI.Gtk.onWidgetRealize drawArea $ backgroundLoop $ do
      esample <- tryAny action
      traverse (verticalBarSetPercent h) esample
  return drawArea

pollingBarNew :: MonadIO m
              => BarConfig -> Double -> IO Double -> m GI.Gtk.Widget
pollingBarNew :: forall (m :: * -> *).
MonadIO m =>
BarConfig -> Double -> IO Double -> m Widget
pollingBarNew BarConfig
cfg Double
pollSeconds IO Double
action =
  IO Widget -> m Widget
forall a. IO a -> m a
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 a b. IO a -> IO b -> IO a
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 b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
pollSeconds Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000)