-- | 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,
  pollingGraphNewWithTooltip,
  defaultGraphConfig
  ) where

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

pollingGraphNewWithTooltip
  :: MonadIO m
  => GraphConfig -> Double -> IO ([Double], Maybe T.Text) -> m GI.Gtk.Widget
pollingGraphNewWithTooltip :: forall (m :: * -> *).
MonadIO m =>
GraphConfig -> Double -> IO ([Double], Maybe Text) -> m Widget
pollingGraphNewWithTooltip GraphConfig
cfg Double
pollSeconds IO ([Double], Maybe Text)
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
  (Widget
graphWidget, GraphHandle
graphHandle) <- GraphConfig -> IO (Widget, GraphHandle)
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> m (Widget, GraphHandle)
graphNew GraphConfig
cfg

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

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

pollingGraphNew
  :: MonadIO m
  => GraphConfig -> Double -> IO [Double] -> m GI.Gtk.Widget
pollingGraphNew :: forall (m :: * -> *).
MonadIO m =>
GraphConfig -> Double -> IO [Double] -> m Widget
pollingGraphNew GraphConfig
cfg Double
pollSeconds IO [Double]
action =
  GraphConfig -> Double -> IO ([Double], Maybe Text) -> m Widget
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> Double -> IO ([Double], Maybe Text) -> m Widget
pollingGraphNewWithTooltip GraphConfig
cfg Double
pollSeconds (IO ([Double], Maybe Text) -> m Widget)
-> IO ([Double], Maybe Text) -> m Widget
forall a b. (a -> b) -> a -> b
$ ([Double] -> ([Double], Maybe Text))
-> IO [Double] -> IO ([Double], Maybe Text)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Maybe Text
forall a. Maybe a
Nothing) IO [Double]
action