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 channelGraphNew :: MonadIO m => GraphConfig -> BroadcastChan In a -> (a -> IO [Double]) -> m GI.Gtk.Widget channelGraphNew :: 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 -> WidgetRealizeCallback -> m SignalHandlerId forall a (m :: * -> *). (IsWidget a, MonadIO m) => a -> WidgetRealizeCallback -> m SignalHandlerId onWidgetRealize Widget graphWidget (WidgetRealizeCallback -> m SignalHandlerId) -> 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 (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 -> 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 -> m Widget forall (m :: * -> *) a. Monad m => a -> m a return Widget graphWidget