module System.Taffybar.Widget.Generic.ChannelWidget 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

-- | Given a widget, a broadcast 'TChan' and a function that consumes the values
-- yielded by the channel that is in 'IO', connect the function to the
-- 'TChan' on a dedicated haskell thread.
channelWidgetNew ::
  (MonadIO m, IsWidget w) =>
  w -> TChan a -> (a -> IO ()) -> m w
channelWidgetNew :: forall (m :: * -> *) w a.
(MonadIO m, IsWidget w) =>
w -> TChan a -> (a -> IO ()) -> m w
channelWidgetNew w
widget TChan 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 -> ((?self::w) => IO ()) -> m SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWidgetRealize w
widget (((?self::w) => IO ()) -> m SignalHandlerId)
-> ((?self::w) => IO ()) -> 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
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
$
      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 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 -> ((?self::w) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWidgetUnrealize w
widget (((?self::w) => IO ()) -> IO SignalHandlerId)
-> ((?self::w) => 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return w
widget