module System.Taffybar.Widget.Generic.ChannelGraph where

import BroadcastChan
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable (traverse_)
import GI.Gtk
import System.Taffybar.Widget.Generic.Graph

-- | Given a 'BroadcastChan' 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 -> BroadcastChan In a -> (a -> IO [Double]) -> m GI.Gtk.Widget
channelGraphNew :: forall (m :: * -> *) a.
MonadIO m =>
GraphConfig -> BroadcastChan In a -> (a -> IO [Double]) -> m Widget
channelGraphNew GraphConfig
config BroadcastChan In 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
       BroadcastChan Out a
ourChan <- BroadcastChan In a -> IO (BroadcastChan Out a)
forall (m :: * -> *) (dir :: Direction) a.
MonadIO m =>
BroadcastChan dir a -> m (BroadcastChan Out a)
newBChanListener BroadcastChan In 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
$
         BroadcastChan Out a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan Out a -> m (Maybe a)
readBChan BroadcastChan Out a
ourChan IO (Maybe a)
-> (Maybe 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
>>=
         (a -> WidgetRealizeCallback) -> Maybe a -> WidgetRealizeCallback
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (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