module System.Taffybar.Widget.Generic.ChannelGraph where

import Control.Concurrent
import Control.Concurrent.STM.TChan
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.STM (atomically)
import GI.Gtk
import System.Taffybar.Widget.Generic.Graph

-- | Given a broadcast 'TChan' and an action to consume that broadcast chan and
-- turn it into graphable values, build a graph that will update as values are
-- broadcast over the channel.
channelGraphNew
  :: MonadIO m
  => GraphConfig -> TChan a -> (a -> IO [Double]) -> m GI.Gtk.Widget
channelGraphNew :: forall (m :: * -> *) a.
MonadIO m =>
GraphConfig -> TChan a -> (a -> IO [Double]) -> m Widget
channelGraphNew GraphConfig
config TChan a
chan a -> IO [Double]
sampleBuilder = do
  (Widget
graphWidget, GraphHandle
graphHandle) <- GraphConfig -> m (Widget, GraphHandle)
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> m (Widget, GraphHandle)
graphNew GraphConfig
config
  SignalHandlerId
_ <- Widget
-> ((?self::Widget) => WidgetRealizeCallback) -> m SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => WidgetRealizeCallback) -> m SignalHandlerId
onWidgetRealize Widget
graphWidget (((?self::Widget) => WidgetRealizeCallback) -> m SignalHandlerId)
-> ((?self::Widget) => WidgetRealizeCallback) -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
       TChan a
ourChan <- STM (TChan a) -> IO (TChan a)
forall a. STM a -> IO a
atomically (STM (TChan a) -> IO (TChan a)) -> STM (TChan a) -> IO (TChan a)
forall a b. (a -> b) -> a -> b
$ TChan a -> STM (TChan a)
forall a. TChan a -> STM (TChan a)
dupTChan TChan a
chan
       ThreadId
sampleThread <- WidgetRealizeCallback -> IO ThreadId
forkIO (WidgetRealizeCallback -> IO ThreadId)
-> WidgetRealizeCallback -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ WidgetRealizeCallback -> WidgetRealizeCallback
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (WidgetRealizeCallback -> WidgetRealizeCallback)
-> WidgetRealizeCallback -> WidgetRealizeCallback
forall a b. (a -> b) -> a -> b
$
         STM a -> IO a
forall a. STM a -> IO a
atomically (TChan a -> STM a
forall a. TChan a -> STM a
readTChan TChan a
ourChan) IO a -> (a -> WidgetRealizeCallback) -> WidgetRealizeCallback
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         (GraphHandle -> [Double] -> WidgetRealizeCallback
graphAddSample GraphHandle
graphHandle ([Double] -> WidgetRealizeCallback)
-> (a -> IO [Double]) -> a -> WidgetRealizeCallback
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> IO [Double]
sampleBuilder)
       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 -> m Widget
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
graphWidget