-- | A variant of the Graph widget that automatically updates itself
-- with a callback at a fixed interval.
module System.Taffybar.Widget.Generic.PollingGraph (
  -- * Types
  GraphHandle,
  GraphConfig(..),
  GraphDirection(..),
  GraphStyle(..),
  -- * Constructors and accessors
  pollingGraphNew,
  defaultGraphConfig
  ) where

import           Control.Concurrent
import qualified Control.Exception.Enclosed as E
import           Control.Monad
import           Control.Monad.IO.Class
import           GI.Gtk
import           System.Taffybar.Util
import           System.Taffybar.Widget.Generic.Graph

pollingGraphNew
  :: MonadIO m
  => GraphConfig -> Double -> IO [Double] -> m GI.Gtk.Widget
pollingGraphNew :: GraphConfig -> Double -> IO [Double] -> m Widget
pollingGraphNew GraphConfig
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
$ do
  (Widget
graphWidget, GraphHandle
graphHandle) <- GraphConfig -> IO (Widget, GraphHandle)
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> m (Widget, GraphHandle)
graphNew GraphConfig
cfg

  SignalHandlerId
_ <- Widget -> WidgetRealizeCallback -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> WidgetRealizeCallback -> m SignalHandlerId
onWidgetRealize Widget
graphWidget (WidgetRealizeCallback -> IO SignalHandlerId)
-> WidgetRealizeCallback -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
       ThreadId
sampleThread <- Double -> WidgetRealizeCallback -> IO ThreadId
forall d a. RealFrac d => d -> IO a -> IO ThreadId
foreverWithDelay Double
pollSeconds (WidgetRealizeCallback -> IO ThreadId)
-> WidgetRealizeCallback -> IO ThreadId
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)
E.tryAny IO [Double]
action
         case Either SomeException [Double]
esample of
           Left SomeException
_ -> () -> WidgetRealizeCallback
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Right [Double]
sample -> GraphHandle -> [Double] -> WidgetRealizeCallback
graphAddSample GraphHandle
graphHandle [Double]
sample
       IO SignalHandlerId -> WidgetRealizeCallback
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> WidgetRealizeCallback)
-> IO SignalHandlerId -> WidgetRealizeCallback
forall a b. (a -> b) -> a -> b
$ Widget -> WidgetRealizeCallback -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> WidgetRealizeCallback -> m SignalHandlerId
onWidgetUnrealize Widget
graphWidget (WidgetRealizeCallback -> IO SignalHandlerId)
-> WidgetRealizeCallback -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ ThreadId -> WidgetRealizeCallback
killThread ThreadId
sampleThread

  Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
graphWidget