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