module System.Taffybar.Widget.Generic.ChannelWidget where import BroadcastChan import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Data.Foldable (traverse_) import GI.Gtk channelWidgetNew :: (MonadIO m, IsWidget w) => w -> BroadcastChan In a -> (a -> IO ()) -> m w channelWidgetNew :: w -> BroadcastChan In a -> (a -> IO ()) -> m w channelWidgetNew w widget BroadcastChan In a channel a -> IO () updateWidget = do m SignalHandlerId -> m () forall (f :: * -> *) a. Functor f => f a -> f () void (m SignalHandlerId -> m ()) -> m SignalHandlerId -> m () forall a b. (a -> b) -> a -> b $ w -> IO () -> m SignalHandlerId forall a (m :: * -> *). (IsWidget a, MonadIO m) => a -> IO () -> m SignalHandlerId onWidgetRealize w widget (IO () -> m SignalHandlerId) -> IO () -> 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 channel ThreadId processingThreadId <- IO () -> IO ThreadId forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId forall a b. (a -> b) -> a -> b $ IO () -> IO () forall (f :: * -> *) a b. Applicative f => f a -> f b forever (IO () -> IO ()) -> IO () -> IO () 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 -> IO ()) -> IO () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (a -> IO ()) -> Maybe a -> IO () forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ a -> IO () updateWidget IO SignalHandlerId -> IO () forall (f :: * -> *) a. Functor f => f a -> f () void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO () forall a b. (a -> b) -> a -> b $ w -> IO () -> IO SignalHandlerId forall a (m :: * -> *). (IsWidget a, MonadIO m) => a -> IO () -> m SignalHandlerId onWidgetUnrealize w widget (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId forall a b. (a -> b) -> a -> b $ ThreadId -> IO () killThread ThreadId processingThreadId w -> m () forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsWidget a) => a -> m () widgetShowAll w widget w -> m w forall (m :: * -> *) a. Monad m => a -> m a return w widget