-- | 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 BarConfig
cfg 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
  (Widget
drawArea, 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 BarConfig
cfg Double
pollSeconds 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
* Double
1000000)