    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE MonoLocalBinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ImpredicativeTypes #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Context
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- The "System.Taffybar.Context" module provides the core functionality of the
    -- taffybar library. It gets its name from the 'Context' record, which stores
    -- runtime information and objects, which are used by many of the widgets that
    -- taffybar provides. 'Context' is typically accessed through the 'Reader'
    -- interface of 'TaffyIO'.
    -----------------------------------------------------------------------------

    module System.Taffybar.Context
      ( Context(..)
      , TaffybarConfig(..)
      , Taffy
      , TaffyIO
      , BarConfig(..)
      , BarConfigGetter
      , appendHook
      , buildContext
      , buildEmptyContext
      , defaultTaffybarConfig
      , getState
      , getStateDefault
      , putState
      , forceRefreshTaffyWindows
      , refreshTaffyWindows
      , runX11
      , runX11Def
      , subscribeToAll
      , subscribeToPropertyEvents
      , taffyFork
      , unsubscribe
      ) where

    import           Control.Arrow ((&&&))
    import           Control.Concurrent (forkIO)
    import qualified Control.Concurrent.MVar as MV
    import           Control.Exception.Enclosed (catchAny)
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Maybe
    import           Control.Monad.Trans.Reader
    import qualified DBus.Client as DBus
    import           Data.Data
    import           Data.Default (Default(..))
    import           Data.GI.Base.ManagedPtr (unsafeCastTo)
    import           Data.Int
    import           Data.List
    import qualified Data.Map as M
    import qualified Data.Text as T
    import           Data.Tuple.Select
    import           Data.Tuple.Sequence
    import           Data.Unique
    import qualified GI.Gdk
    import qualified GI.GdkX11 as GdkX11
    import           GI.GdkX11.Objects.X11Window
    import qualified GI.Gtk as Gtk
    import           Graphics.UI.GIGtkStrut
    import           StatusNotifier.TransparentWindow
    import           System.Log.Logger
    import           System.Taffybar.Information.SafeX11
    import           System.Taffybar.Information.X11DesktopInfo
    import           System.Taffybar.Util
    import           System.Taffybar.Widget.Util
    import           Text.Printf
    import           Unsafe.Coerce

    logIO :: System.Log.Logger.Priority -> String -> IO ()
    logIO :: Priority -> String -> IO ()
    logIO = String -> Priority -> String -> IO ()
    logM String
    "System.Taffybar.Context"

    logC :: MonadIO m => System.Log.Logger.Priority -> String -> m ()
    logC :: forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    p = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Priority -> String -> IO ()
    logIO Priority
    p

    -- | 'Taffy' is a monad transformer that provides 'Reader' for 'Context'.
    type Taffy m v = ReaderT Context m v

    -- | 'TaffyIO' is 'IO' wrapped with a 'ReaderT' providing 'Context'. This is the
    -- type of most widgets and callback in taffybar.
    type TaffyIO v = ReaderT Context IO v

    type Listener = Event -> Taffy IO ()
    type SubscriptionList = [(Unique, Listener)]
    data Value = forall t. Typeable t => Value t

    fromValue :: forall t. Typeable t => Value -> Maybe t
    fromValue :: forall t. Typeable t => Value -> Maybe t
    fromValue (Value t
    v) =
      if t -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf t
    v TypeRep -> TypeRep -> Bool
    forall a. Eq a => a -> a -> Bool
    == Proxy t -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy t
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy t) then
        t -> Maybe t
    forall a. a -> Maybe a
    Just (t -> Maybe t) -> t -> Maybe t
    forall a b. (a -> b) -> a -> b
    $ t -> t
    forall a b. a -> b
    unsafeCoerce t
    v
      else
        Maybe t
    forall a. Maybe a
    Nothing

    -- | 'BarConfig' specifies the configuration for a single taffybar window.
    data BarConfig = BarConfig
      {
      -- | The strut configuration to use for the bar
        BarConfig -> StrutConfig
    strutConfig :: StrutConfig
      -- | The amount of spacing in pixels between bar widgets
      , BarConfig -> Int32
    widgetSpacing :: Int32
      -- | Constructors for widgets that should be placed at the beginning of the bar.
      , BarConfig -> [TaffyIO Widget]
    startWidgets :: [TaffyIO Gtk.Widget]
      -- | Constructors for widgets that should be placed in the center of the bar.
      , BarConfig -> [TaffyIO Widget]
    centerWidgets :: [TaffyIO Gtk.Widget]
      -- | Constructors for widgets that should be placed at the end of the bar.
      , BarConfig -> [TaffyIO Widget]
    endWidgets :: [TaffyIO Gtk.Widget]
      -- | A unique identifier for the bar, that can be used e.g. when toggling.
      , BarConfig -> Unique
    barId :: Unique
      }

    instance Eq BarConfig where
      BarConfig
    a == :: BarConfig -> BarConfig -> Bool
    == BarConfig
    b = BarConfig -> Unique
    barId BarConfig
    a Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == BarConfig -> Unique
    barId BarConfig
    b

    type BarConfigGetter = TaffyIO [BarConfig]

    -- | 'TaffybarConfig' provides an advanced interface for configuring taffybar.
    -- Through the 'getBarConfigsParam', it is possible to specify different
    -- taffybar configurations depending on the number of monitors present, and even
    -- to specify different taffybar configurations for each monitor.
    data TaffybarConfig = TaffybarConfig
      {
      -- | An optional dbus client to use.
        TaffybarConfig -> Maybe Client
    dbusClientParam :: Maybe DBus.Client
      -- | Hooks that should be executed at taffybar startup.
      , TaffybarConfig -> TaffyIO ()
    startupHook :: TaffyIO ()
      -- | A 'TaffyIO' action that returns a list of 'BarConfig' where each element
      -- describes a taffybar window that should be spawned.
      , TaffybarConfig -> BarConfigGetter
    getBarConfigsParam :: BarConfigGetter
      -- | A list of 'FilePath' each of which should be loaded as css files at
      -- startup.
      , TaffybarConfig -> [String]
    cssPaths :: [FilePath]
      -- | A field used (only) by dyre to provide an error message.
      , TaffybarConfig -> Maybe String
    errorMsg :: Maybe String
      }

    -- | Append the provided 'TaffyIO' hook to the 'startupHook' of the given
    -- 'TaffybarConfig'.
    appendHook :: TaffyIO () -> TaffybarConfig -> TaffybarConfig
    appendHook :: TaffyIO () -> TaffybarConfig -> TaffybarConfig
    appendHook TaffyIO ()
    hook TaffybarConfig
    config = TaffybarConfig
    config
      { startupHook :: TaffyIO ()
    startupHook = TaffybarConfig -> TaffyIO ()
    startupHook TaffybarConfig
    config TaffyIO () -> TaffyIO () -> TaffyIO ()
    forall a b.
    ReaderT Context IO a
    -> ReaderT Context IO b -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TaffyIO ()
    hook }

    -- | Default values for a 'TaffybarConfig'. Not usuable without at least
    -- properly setting 'getBarConfigsParam'.
    defaultTaffybarConfig :: TaffybarConfig
    defaultTaffybarConfig :: TaffybarConfig
    defaultTaffybarConfig = TaffybarConfig
      { dbusClientParam :: Maybe Client
    dbusClientParam = Maybe Client
    forall a. Maybe a
    Nothing
      , startupHook :: TaffyIO ()
    startupHook = () -> TaffyIO ()
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      , getBarConfigsParam :: BarConfigGetter
    getBarConfigsParam = [BarConfig] -> BarConfigGetter
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      , cssPaths :: [String]
    cssPaths = []
      , errorMsg :: Maybe String
    errorMsg = Maybe String
    forall a. Maybe a
    Nothing
      }

    instance Default TaffybarConfig where
      def :: TaffybarConfig
    def = TaffybarConfig
    defaultTaffybarConfig

    -- | A "Context" value holds all of the state associated with a single running
    -- instance of taffybar. It is typically accessed from a widget constructor
    -- through the "TaffyIO" monad transformer stack.
    data Context = Context
      {
      -- | The X11Context that will be used to service X11Property requests.
        Context -> MVar X11Context
    x11ContextVar :: MV.MVar X11Context
      -- | The handlers which will be evaluated against incoming X11 events.
      , Context -> MVar SubscriptionList
    listeners :: MV.MVar SubscriptionList
      -- | A collection of miscellaneous pieces of state which are keyed by their
      -- types. Most new pieces of state should go here, rather than in a new field
      -- in 'Context'. State stored here is typically accessed through
      -- 'getStateDefault'.
      , Context -> MVar (Map TypeRep Value)
    contextState :: MV.MVar (M.Map TypeRep Value)
      -- | Used to track the windows that taffybar is currently controlling, and
      -- which 'BarConfig' objects they are associated with.
      , Context -> MVar [(BarConfig, Window)]
    existingWindows :: MV.MVar [(BarConfig, Gtk.Window)]
      -- | The shared user session 'DBus.Client'.
      , Context -> Client
    sessionDBusClient :: DBus.Client
      -- | The shared system session 'DBus.Client'.
      , Context -> Client
    systemDBusClient :: DBus.Client
      -- | The action that will be evaluated to get the bar configs associated with
      -- each active monitor taffybar should run on.
      , Context -> BarConfigGetter
    getBarConfigs :: BarConfigGetter
      -- | Populated with the BarConfig that resulted in the creation of a given
      -- widget, when its constructor is called. This lets widgets access thing like
      -- who their neighbors are. Note that the value of 'contextBarConfig' is
      -- different for widgets belonging to bar windows on different monitors.
      , Context -> Maybe BarConfig
    contextBarConfig :: Maybe BarConfig
      }

    -- | Build the "Context" for a taffybar process.
    buildContext :: TaffybarConfig -> IO Context
    buildContext :: TaffybarConfig -> IO Context
    buildContext TaffybarConfig
                   { dbusClientParam :: TaffybarConfig -> Maybe Client
    dbusClientParam = Maybe Client
    maybeDBus
                   , getBarConfigsParam :: TaffybarConfig -> BarConfigGetter
    getBarConfigsParam = BarConfigGetter
    barConfigGetter
                   , startupHook :: TaffybarConfig -> TaffyIO ()
    startupHook = TaffyIO ()
    startup
                   } = do
      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Building context"
      Client
    dbusC <- IO Client -> (Client -> IO Client) -> Maybe Client -> IO Client
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO Client
    DBus.connectSession Client -> IO Client
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Client
    maybeDBus
      Client
    sDBusC <- IO Client
    DBus.connectSystem
      RequestNameReply
    _ <- Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
    DBus.requestName Client
    dbusC BusName
    "org.taffybar.Bar"
           [RequestNameFlag
    DBus.nameAllowReplacement, RequestNameFlag
    DBus.nameReplaceExisting]
      MVar SubscriptionList
    listenersVar <- SubscriptionList -> IO (MVar SubscriptionList)
    forall a. a -> IO (MVar a)
    MV.newMVar []
      MVar (Map TypeRep Value)
    state <- Map TypeRep Value -> IO (MVar (Map TypeRep Value))
    forall a. a -> IO (MVar a)
    MV.newMVar Map TypeRep Value
    forall k a. Map k a
    M.empty
      MVar X11Context
    x11Context <- IO X11Context
    getDefaultCtx IO X11Context
    -> (X11Context -> IO (MVar X11Context)) -> IO (MVar X11Context)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= X11Context -> IO (MVar X11Context)
    forall a. a -> IO (MVar a)
    MV.newMVar
      MVar [(BarConfig, Window)]
    windowsVar <- [(BarConfig, Window)] -> IO (MVar [(BarConfig, Window)])
    forall a. a -> IO (MVar a)
    MV.newMVar []
      let context :: Context
    context = Context
                    { x11ContextVar :: MVar X11Context
    x11ContextVar = MVar X11Context
    x11Context
                    , listeners :: MVar SubscriptionList
    listeners = MVar SubscriptionList
    listenersVar
                    , contextState :: MVar (Map TypeRep Value)
    contextState = MVar (Map TypeRep Value)
    state
                    , sessionDBusClient :: Client
    sessionDBusClient = Client
    dbusC
                    , systemDBusClient :: Client
    systemDBusClient = Client
    sDBusC
                    , getBarConfigs :: BarConfigGetter
    getBarConfigs = BarConfigGetter
    barConfigGetter
                    , existingWindows :: MVar [(BarConfig, Window)]
    existingWindows = MVar [(BarConfig, Window)]
    windowsVar
                    , contextBarConfig :: Maybe BarConfig
    contextBarConfig = Maybe BarConfig
    forall a. Maybe a
    Nothing
                    }
      Maybe CULong
    _ <- MaybeT IO CULong -> IO (Maybe CULong)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT IO CULong -> IO (Maybe CULong))
    -> MaybeT IO CULong -> IO (Maybe CULong)
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe Display) -> MaybeT IO Display
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT IO (Maybe Display)
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    m (Maybe Display)
    GI.Gdk.displayGetDefault MaybeT IO Display
    -> (Display -> MaybeT IO Screen) -> MaybeT IO Screen
    forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                  (IO Screen -> MaybeT IO Screen
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Screen -> MaybeT IO Screen)
    -> (Display -> IO Screen) -> Display -> MaybeT IO Screen
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Display -> IO Screen
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsDisplay a) =>
    a -> m Screen
    GI.Gdk.displayGetDefaultScreen) MaybeT IO Screen
    -> (Screen -> MaybeT IO CULong) -> MaybeT IO CULong
    forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                  (IO CULong -> MaybeT IO CULong
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO CULong -> MaybeT IO CULong)
    -> (Screen -> IO CULong) -> Screen -> MaybeT IO CULong
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Screen -> ((?self::Screen) => IO ()) -> IO CULong)
    -> ((?self::Screen) => IO ()) -> Screen -> IO CULong
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Screen -> ((?self::Screen) => IO ()) -> IO CULong
    forall a (m :: * -> *).
    (IsScreen a, MonadIO m) =>
    a -> ((?self::a) => IO ()) -> m CULong
    GI.Gdk.afterScreenMonitorsChanged
                   -- XXX: We have to do a force refresh here because there is no
                   -- way to reliably move windows, since the window manager can do
                   -- whatever it pleases.
                   (TaffyIO () -> Context -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT TaffyIO ()
    forceRefreshTaffyWindows Context
    context))
      (TaffyIO () -> Context -> IO ()) -> Context -> TaffyIO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TaffyIO () -> Context -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    context (TaffyIO () -> IO ()) -> TaffyIO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Priority -> String -> TaffyIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG String
    "Starting X11 Handler"
        TaffyIO ()
    startX11EventHandler
        Priority -> String -> TaffyIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG String
    "Running startup hook"
        TaffyIO ()
    startup
        Priority -> String -> TaffyIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG String
    "Queing build windows command"
        TaffyIO ()
    refreshTaffyWindows
      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Context build finished"
      Context -> IO Context
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Context
    context

    -- | Build an empty taffybar context. This function is mostly useful for
    -- invoking functions that yield 'TaffyIO' values in a testing setting (e.g. in
    -- a repl).
    buildEmptyContext :: IO Context
    buildEmptyContext :: IO Context
    buildEmptyContext = TaffybarConfig -> IO Context
    buildContext TaffybarConfig
    forall a. Default a => a
    def

    buildBarWindow :: Context -> BarConfig -> IO Gtk.Window
    buildBarWindow :: Context -> BarConfig -> IO Window
    buildBarWindow Context
    context BarConfig
    barConfig = do
      let thisContext :: Context
    thisContext = Context
    context { contextBarConfig :: Maybe BarConfig
    contextBarConfig = BarConfig -> Maybe BarConfig
    forall a. a -> Maybe a
    Just BarConfig
    barConfig }
      Priority -> String -> IO ()
    logIO Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Building bar window with StrutConfig: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
          StrutConfig -> String
    forall a. Show a => a -> String
    show (StrutConfig -> String) -> StrutConfig -> String
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> StrutConfig
    strutConfig BarConfig
    barConfig

      Window
    window <- WindowType -> IO Window
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    WindowType -> m Window
    Gtk.windowNew WindowType
    Gtk.WindowTypeToplevel
      Box
    box <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal (Int32 -> IO Box) -> Int32 -> IO Box
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int32) -> Int32 -> Int32
    forall a b. (a -> b) -> a -> b
    $
             BarConfig -> Int32
    widgetSpacing BarConfig
    barConfig
      Box
    _ <- Box -> Text -> IO Box
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Box
    box Text
    "taffy-box"
      Box
    centerBox <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal (Int32 -> IO Box) -> Int32 -> IO Box
    forall a b. (a -> b) -> a -> b
    $
                   Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int32) -> Int32 -> Int32
    forall a b. (a -> b) -> a -> b
    $ BarConfig -> Int32
    widgetSpacing BarConfig
    barConfig

      Box
    _ <- Box -> Text -> IO Box
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Box
    centerBox Text
    "center-box"
      Box -> Bool -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Bool -> m ()
    Gtk.widgetSetVexpand Box
    centerBox Bool
    True
      Box -> Align -> IO ()
    forall (m :: * -> *) o.
    (MonadIO m, IsWidget o) =>
    o -> Align -> m ()
    Gtk.setWidgetValign Box
    centerBox Align
    Gtk.AlignFill
      Box -> Align -> IO ()
    forall (m :: * -> *) o.
    (MonadIO m, IsWidget o) =>
    o -> Align -> m ()
    Gtk.setWidgetHalign Box
    centerBox Align
    Gtk.AlignCenter
      Box -> Maybe Box -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> Maybe b -> m ()
    Gtk.boxSetCenterWidget Box
    box (Box -> Maybe Box
    forall a. a -> Maybe a
    Just Box
    centerBox)

      StrutConfig -> Window -> IO ()
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    StrutConfig -> Window -> m ()
    setupStrutWindow (BarConfig -> StrutConfig
    strutConfig BarConfig
    barConfig) Window
    window
      Window -> Box -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Window
    window Box
    box

      Window
    _ <- Window -> Text -> IO Window
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Window
    window Text
    "taffy-window"

      let addWidgetWith :: (Int -> Widget -> IO ()) -> (Int, TaffyIO Widget) -> IO ()
    addWidgetWith Int -> Widget -> IO ()
    widgetAdd (Int
    count, TaffyIO Widget
    buildWidget) =
            TaffyIO Widget -> Context -> IO Widget
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT TaffyIO Widget
    buildWidget Context
    thisContext IO Widget -> (Widget -> 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
    >>= Int -> Widget -> IO ()
    widgetAdd Int
    count
          addToStart :: Int -> Widget -> IO ()
    addToStart Int
    count Widget
    widget = do
            Widget
    _ <- Widget -> Text -> IO Widget
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Widget
    widget (Text -> IO Widget) -> Text -> IO Widget
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "left-%d" (Int
    count :: Int)
            Box -> Widget -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    Gtk.boxPackStart Box
    box Widget
    widget Bool
    False Bool
    False Word32
    0
          addToEnd :: Int -> Widget -> IO ()
    addToEnd Int
    count Widget
    widget = do
            Widget
    _ <- Widget -> Text -> IO Widget
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Widget
    widget (Text -> IO Widget) -> Text -> IO Widget
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "right-%d" (Int
    count :: Int)
            Box -> Widget -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    Gtk.boxPackEnd Box
    box Widget
    widget Bool
    False Bool
    False Word32
    0
          addToCenter :: Int -> Widget -> IO ()
    addToCenter Int
    count Widget
    widget = do
            Widget
    _ <- Widget -> Text -> IO Widget
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Widget
    widget (Text -> IO Widget) -> Text -> IO Widget
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "center-%d" (Int
    count :: Int)
            Box -> Widget -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    Gtk.boxPackStart Box
    centerBox Widget
    widget Bool
    False Bool
    False Word32
    0

      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Building start widgets"
      ((Int, TaffyIO Widget) -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Int -> Widget -> IO ()) -> (Int, TaffyIO Widget) -> IO ()
    addWidgetWith Int -> Widget -> IO ()
    addToStart) ([(Int, TaffyIO Widget)] -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [TaffyIO Widget] -> [(Int, TaffyIO Widget)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] (BarConfig -> [TaffyIO Widget]
    startWidgets BarConfig
    barConfig)
      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Building center widgets"
      ((Int, TaffyIO Widget) -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Int -> Widget -> IO ()) -> (Int, TaffyIO Widget) -> IO ()
    addWidgetWith Int -> Widget -> IO ()
    addToCenter) ([(Int, TaffyIO Widget)] -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [TaffyIO Widget] -> [(Int, TaffyIO Widget)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] (BarConfig -> [TaffyIO Widget]
    centerWidgets BarConfig
    barConfig)
      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Building end widgets"
      ((Int, TaffyIO Widget) -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Int -> Widget -> IO ()) -> (Int, TaffyIO Widget) -> IO ()
    addWidgetWith Int -> Widget -> IO ()
    addToEnd) ([(Int, TaffyIO Widget)] -> IO ())
    -> [(Int, TaffyIO Widget)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [TaffyIO Widget] -> [(Int, TaffyIO Widget)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] (BarConfig -> [TaffyIO Widget]
    endWidgets BarConfig
    barConfig)

      Window -> IO ()
    forall (m :: * -> *). MonadIO m => Window -> m ()
    makeWindowTransparent Window
    window

      Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Showing window"
      Window -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShow Window
    window
      Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShow Box
    box
      Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShow Box
    centerBox

      Context -> () -> X11Property () -> IO ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Context -> a -> X11Property a -> m a
    runX11Context Context
    context () (X11Property () -> IO ()) -> X11Property () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ReaderT X11Context IO (Maybe ()) -> X11Property ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT X11Context IO (Maybe ()) -> X11Property ())
    -> ReaderT X11Context IO (Maybe ()) -> X11Property ()
    forall a b. (a -> b) -> a -> b
    $ MaybeT (ReaderT X11Context IO) ()
    -> ReaderT X11Context IO (Maybe ())
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (ReaderT X11Context IO) ()
     -> ReaderT X11Context IO (Maybe ()))
    -> MaybeT (ReaderT X11Context IO) ()
    -> ReaderT X11Context IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ do
        Window
    gdkWindow <- ReaderT X11Context IO (Maybe Window)
    -> MaybeT (ReaderT X11Context IO) Window
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (ReaderT X11Context IO (Maybe Window)
     -> MaybeT (ReaderT X11Context IO) Window)
    -> ReaderT X11Context IO (Maybe Window)
    -> MaybeT (ReaderT X11Context IO) Window
    forall a b. (a -> b) -> a -> b
    $ Window -> ReaderT X11Context IO (Maybe Window)
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m (Maybe Window)
    Gtk.widgetGetWindow Window
    window
        CULong
    xid <- X11Window -> MaybeT (ReaderT X11Context IO) CULong
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsX11Window a) =>
    a -> m CULong
    GdkX11.x11WindowGetXid (X11Window -> MaybeT (ReaderT X11Context IO) CULong)
    -> MaybeT (ReaderT X11Context IO) X11Window
    -> MaybeT (ReaderT X11Context IO) CULong
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO X11Window -> MaybeT (ReaderT X11Context IO) X11Window
    forall a. IO a -> MaybeT (ReaderT X11Context IO) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO ((ManagedPtr X11Window -> X11Window) -> Window -> IO X11Window
    forall o o'.
    (HasCallStack, ManagedPtrNewtype o, TypedObject o,
     ManagedPtrNewtype o', TypedObject o') =>
    (ManagedPtr o' -> o') -> o -> IO o'
    unsafeCastTo ManagedPtr X11Window -> X11Window
    X11Window Window
    gdkWindow)
        Priority -> String -> MaybeT (ReaderT X11Context IO) ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG (String -> MaybeT (ReaderT X11Context IO) ())
    -> String -> MaybeT (ReaderT X11Context IO) ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Lowering X11 window %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ CULong -> String
    forall a. Show a => a -> String
    show CULong
    xid
        X11Property () -> MaybeT (ReaderT X11Context IO) ()
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (X11Property () -> MaybeT (ReaderT X11Context IO) ())
    -> X11Property () -> MaybeT (ReaderT X11Context IO) ()
    forall a b. (a -> b) -> a -> b
    $ Atom -> X11Property ()
    doLowerWindow (CULong -> Atom
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CULong
    xid)

      Window -> IO Window
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Window
    window

    -- | Use the "barConfigGetter" field of "Context" to get the set of taffybar
    -- windows that should active. Will avoid recreating windows if there is already
    -- a window with the appropriate geometry and "BarConfig".
    refreshTaffyWindows :: TaffyIO ()
    refreshTaffyWindows :: TaffyIO ()
    refreshTaffyWindows = (IO () -> IO ()) -> TaffyIO () -> TaffyIO ()
    forall (m :: * -> *) (m1 :: * -> *) a b r.
    Monad m =>
    (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b
    liftReader IO () -> IO ()
    postGUIASync (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Priority -> String -> TaffyIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG String
    "Refreshing windows"
      Context
    ctx <- ReaderT Context IO Context
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      MVar [(BarConfig, Window)]
    windowsVar <- (Context -> MVar [(BarConfig, Window)])
    -> ReaderT Context IO (MVar [(BarConfig, Window)])
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> MVar [(BarConfig, Window)]
    existingWindows

      let rebuildWindows :: [(BarConfig, Window)] -> IO [(BarConfig, Window)]
    rebuildWindows [(BarConfig, Window)]
    currentWindows = (ReaderT Context IO [(BarConfig, Window)]
     -> Context -> IO [(BarConfig, Window)])
    -> Context
    -> ReaderT Context IO [(BarConfig, Window)]
    -> IO [(BarConfig, Window)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT Context IO [(BarConfig, Window)]
    -> Context -> IO [(BarConfig, Window)]
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    ctx (ReaderT Context IO [(BarConfig, Window)]
     -> IO [(BarConfig, Window)])
    -> ReaderT Context IO [(BarConfig, Window)]
    -> IO [(BarConfig, Window)]
    forall a b. (a -> b) -> a -> b
    $
            do
              [BarConfig]
    barConfigs <- ReaderT Context IO BarConfigGetter -> BarConfigGetter
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (ReaderT Context IO BarConfigGetter -> BarConfigGetter)
    -> ReaderT Context IO BarConfigGetter -> BarConfigGetter
    forall a b. (a -> b) -> a -> b
    $ (Context -> BarConfigGetter) -> ReaderT Context IO BarConfigGetter
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> BarConfigGetter
    getBarConfigs

              let currentConfigs :: [BarConfig]
    currentConfigs = ((BarConfig, Window) -> BarConfig)
    -> [(BarConfig, Window)] -> [BarConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map (BarConfig, Window) -> BarConfig
    forall a b. Sel1 a b => a -> b
    sel1 [(BarConfig, Window)]
    currentWindows
                  newConfs :: [BarConfig]
    newConfs = (BarConfig -> Bool) -> [BarConfig] -> [BarConfig]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BarConfig -> [BarConfig] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [BarConfig]
    currentConfigs) [BarConfig]
    barConfigs
                  ([(BarConfig, Window)]
    remainingWindows, [(BarConfig, Window)]
    removedWindows) =
                    ((BarConfig, Window) -> Bool)
    -> [(BarConfig, Window)]
    -> ([(BarConfig, Window)], [(BarConfig, Window)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((BarConfig -> [BarConfig] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [BarConfig]
    barConfigs) (BarConfig -> Bool)
    -> ((BarConfig, Window) -> BarConfig)
    -> (BarConfig, Window)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BarConfig, Window) -> BarConfig
    forall a b. Sel1 a b => a -> b
    sel1) [(BarConfig, Window)]
    currentWindows
                  setPropertiesFromPair :: (BarConfig, Window) -> m ()
    setPropertiesFromPair (BarConfig
    barConf, Window
    window) =
                    StrutConfig -> Window -> m ()
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    StrutConfig -> Window -> m ()
    setupStrutWindow (BarConfig -> StrutConfig
    strutConfig BarConfig
    barConf) Window
    window

              [(BarConfig, Window)]
    newWindowPairs <- IO [(BarConfig, Window)]
    -> ReaderT Context IO [(BarConfig, Window)]
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO [(BarConfig, Window)]
     -> ReaderT Context IO [(BarConfig, Window)])
    -> IO [(BarConfig, Window)]
    -> ReaderT Context IO [(BarConfig, Window)]
    forall a b. (a -> b) -> a -> b
    $ do
                Priority -> String -> IO ()
    logIO Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "removedWindows: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                      [StrutConfig] -> String
    forall a. Show a => a -> String
    show ([StrutConfig] -> String) -> [StrutConfig] -> String
    forall a b. (a -> b) -> a -> b
    $ ((BarConfig, Window) -> StrutConfig)
    -> [(BarConfig, Window)] -> [StrutConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map (BarConfig -> StrutConfig
    strutConfig (BarConfig -> StrutConfig)
    -> ((BarConfig, Window) -> BarConfig)
    -> (BarConfig, Window)
    -> StrutConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BarConfig, Window) -> BarConfig
    forall a b. Sel1 a b => a -> b
    sel1) [(BarConfig, Window)]
    removedWindows
                Priority -> String -> IO ()
    logIO Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "remainingWindows: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                      [StrutConfig] -> String
    forall a. Show a => a -> String
    show ([StrutConfig] -> String) -> [StrutConfig] -> String
    forall a b. (a -> b) -> a -> b
    $ ((BarConfig, Window) -> StrutConfig)
    -> [(BarConfig, Window)] -> [StrutConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map (BarConfig -> StrutConfig
    strutConfig (BarConfig -> StrutConfig)
    -> ((BarConfig, Window) -> BarConfig)
    -> (BarConfig, Window)
    -> StrutConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BarConfig, Window) -> BarConfig
    forall a b. Sel1 a b => a -> b
    sel1) [(BarConfig, Window)]
    remainingWindows
                Priority -> String -> IO ()
    logIO Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "newWindows: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                      [StrutConfig] -> String
    forall a. Show a => a -> String
    show ([StrutConfig] -> String) -> [StrutConfig] -> String
    forall a b. (a -> b) -> a -> b
    $ (BarConfig -> StrutConfig) -> [BarConfig] -> [StrutConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map BarConfig -> StrutConfig
    strutConfig [BarConfig]
    newConfs
                Priority -> String -> IO ()
    logIO Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "barConfigs: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                      [StrutConfig] -> String
    forall a. Show a => a -> String
    show ([StrutConfig] -> String) -> [StrutConfig] -> String
    forall a b. (a -> b) -> a -> b
    $ (BarConfig -> StrutConfig) -> [BarConfig] -> [StrutConfig]
    forall a b. (a -> b) -> [a] -> [b]
    map BarConfig -> StrutConfig
    strutConfig [BarConfig]
    barConfigs

                Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Removing windows"
                ((BarConfig, Window) -> IO ()) -> [(BarConfig, Window)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Window -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetDestroy (Window -> IO ())
    -> ((BarConfig, Window) -> Window) -> (BarConfig, Window) -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BarConfig, Window) -> Window
    forall a b. Sel2 a b => a -> b
    sel2) [(BarConfig, Window)]
    removedWindows

                -- TODO: This should actually use the config that is provided from
                -- getBarConfigs so that the strut properties of the window can be
                -- altered.
                Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Updating strut properties for existing windows"
                ((BarConfig, Window) -> IO ()) -> [(BarConfig, Window)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BarConfig, Window) -> IO ()
    forall {m :: * -> *}.
    (MonadFail m, MonadIO m) =>
    (BarConfig, Window) -> m ()
    setPropertiesFromPair [(BarConfig, Window)]
    remainingWindows

                Priority -> String -> IO ()
    logIO Priority
    DEBUG String
    "Constructing new windows"
                (BarConfig -> IO (BarConfig, Window))
    -> [BarConfig] -> IO [(BarConfig, Window)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((IO BarConfig, IO Window) -> IO (BarConfig, Window)
    forall a b. SequenceT a b => a -> b
    sequenceT ((IO BarConfig, IO Window) -> IO (BarConfig, Window))
    -> (BarConfig -> (IO BarConfig, IO Window))
    -> BarConfig
    -> IO (BarConfig, Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return :: a -> IO a) (BarConfig -> IO BarConfig)
    -> (BarConfig -> IO Window)
    -> BarConfig
    -> (IO BarConfig, IO Window)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Context -> BarConfig -> IO Window
    buildBarWindow Context
    ctx))
                     [BarConfig]
    newConfs

              [(BarConfig, Window)] -> ReaderT Context IO [(BarConfig, Window)]
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(BarConfig, Window)] -> ReaderT Context IO [(BarConfig, Window)])
    -> [(BarConfig, Window)]
    -> ReaderT Context IO [(BarConfig, Window)]
    forall a b. (a -> b) -> a -> b
    $ [(BarConfig, Window)]
    newWindowPairs [(BarConfig, Window)]
    -> [(BarConfig, Window)] -> [(BarConfig, Window)]
    forall a. [a] -> [a] -> [a]
    ++ [(BarConfig, Window)]
    remainingWindows

      IO () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ MVar [(BarConfig, Window)]
    -> ([(BarConfig, Window)] -> IO [(BarConfig, Window)]) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar [(BarConfig, Window)]
    windowsVar [(BarConfig, Window)] -> IO [(BarConfig, Window)]
    rebuildWindows
      Priority -> String -> TaffyIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    logC Priority
    DEBUG String
    "Finished refreshing windows"
      () -> TaffyIO ()
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Forcibly refresh taffybar windows, even if there are existing windows that
    -- correspond to the uniques in the bar configs yielded by 'barConfigGetter'.
    forceRefreshTaffyWindows :: TaffyIO ()
    forceRefreshTaffyWindows :: TaffyIO ()
    forceRefreshTaffyWindows =
      (Context -> MVar [(BarConfig, Window)])
    -> ReaderT Context IO (MVar [(BarConfig, Window)])
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> MVar [(BarConfig, Window)]
    existingWindows ReaderT Context IO (MVar [(BarConfig, Window)])
    -> (MVar [(BarConfig, Window)] -> TaffyIO ()) -> TaffyIO ()
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> TaffyIO ())
    -> (MVar [(BarConfig, Window)] -> IO ())
    -> MVar [(BarConfig, Window)]
    -> TaffyIO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (MVar [(BarConfig, Window)]
     -> ([(BarConfig, Window)] -> IO [(BarConfig, Window)]) -> IO ())
    -> ([(BarConfig, Window)] -> IO [(BarConfig, Window)])
    -> MVar [(BarConfig, Window)]
    -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip MVar [(BarConfig, Window)]
    -> ([(BarConfig, Window)] -> IO [(BarConfig, Window)]) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ [(BarConfig, Window)] -> IO [(BarConfig, Window)]
    forall {b} {t :: * -> *} {m :: * -> *} {a} {a}.
    (IsDescendantOf Widget b, Foldable t, MonadIO m, GObject b,
     Sel2 a b) =>
    t a -> m [a]
    deleteWindows TaffyIO () -> TaffyIO () -> TaffyIO ()
    forall a b.
    ReaderT Context IO a
    -> ReaderT Context IO b -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
           TaffyIO ()
    refreshTaffyWindows
        where deleteWindows :: t a -> m [a]
    deleteWindows t a
    windows =
                do
                  (a -> m ()) -> t a -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (b -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetDestroy (b -> m ()) -> (a -> b) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    forall a b. Sel2 a b => a -> b
    sel2) t a
    windows
                  [a] -> m [a]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    asksContextVar :: (r -> MV.MVar b) -> ReaderT r IO b
    asksContextVar :: forall r b. (r -> MVar b) -> ReaderT r IO b
    asksContextVar r -> MVar b
    getter = (r -> MVar b) -> ReaderT r IO (MVar b)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks r -> MVar b
    getter ReaderT r IO (MVar b)
    -> (MVar b -> ReaderT r IO b) -> ReaderT r IO b
    forall a b.
    ReaderT r IO a -> (a -> ReaderT r IO b) -> ReaderT r IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO b -> ReaderT r IO b
    forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO b -> ReaderT r IO b)
    -> (MVar b -> IO b) -> MVar b -> ReaderT r IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MVar b -> IO b
    forall a. MVar a -> IO a
    MV.readMVar

    -- | Run a function needing an X11 connection in 'TaffyIO'.
    runX11 :: X11Property a -> TaffyIO a
    runX11 :: forall a. X11Property a -> TaffyIO a
    runX11 X11Property a
    action =
      (Context -> MVar X11Context) -> ReaderT Context IO X11Context
    forall r b. (r -> MVar b) -> ReaderT r IO b
    asksContextVar Context -> MVar X11Context
    x11ContextVar ReaderT Context IO X11Context
    -> (X11Context -> ReaderT Context IO a) -> ReaderT Context IO a
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO a -> ReaderT Context IO a)
    -> (X11Context -> IO a) -> X11Context -> ReaderT Context IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X11Property a -> X11Context -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT X11Property a
    action

    -- | Use 'runX11' together with 'postX11RequestSyncProp' on the provided
    -- property. Return the provided default if 'Nothing' is returned
    -- 'postX11RequestSyncProp'.
    runX11Def :: a -> X11Property a -> TaffyIO a
    runX11Def :: forall a. a -> X11Property a -> TaffyIO a
    runX11Def a
    dflt X11Property a
    prop = X11Property a -> TaffyIO a
    forall a. X11Property a -> TaffyIO a
    runX11 (X11Property a -> TaffyIO a) -> X11Property a -> TaffyIO a
    forall a b. (a -> b) -> a -> b
    $ X11Property a -> a -> X11Property a
    forall a. X11Property a -> a -> X11Property a
    postX11RequestSyncProp X11Property a
    prop a
    dflt

    runX11Context :: MonadIO m => Context -> a -> X11Property a -> m a
    runX11Context :: forall (m :: * -> *) a.
    MonadIO m =>
    Context -> a -> X11Property a -> m a
    runX11Context Context
    context a
    dflt X11Property a
    prop =
      IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ ReaderT Context IO a -> Context -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (a -> X11Property a -> ReaderT Context IO a
    forall a. a -> X11Property a -> TaffyIO a
    runX11Def a
    dflt X11Property a
    prop) Context
    context

    -- | Get a state value by type from the 'contextState' field of 'Context'.
    getState :: forall t. Typeable t => Taffy IO (Maybe t)
    getState :: forall t. Typeable t => Taffy IO (Maybe t)
    getState = do
      Map TypeRep Value
    stateMap <- (Context -> MVar (Map TypeRep Value))
    -> ReaderT Context IO (Map TypeRep Value)
    forall r b. (r -> MVar b) -> ReaderT r IO b
    asksContextVar Context -> MVar (Map TypeRep Value)
    contextState
      let maybeValue :: Maybe Value
    maybeValue = TypeRep -> Map TypeRep Value -> Maybe Value
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Proxy t -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy t
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy t)) Map TypeRep Value
    stateMap
      Maybe t -> Taffy IO (Maybe t)
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe t -> Taffy IO (Maybe t)) -> Maybe t -> Taffy IO (Maybe t)
    forall a b. (a -> b) -> a -> b
    $ Maybe Value
    maybeValue Maybe Value -> (Value -> Maybe t) -> Maybe t
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Value -> Maybe t
    forall t. Typeable t => Value -> Maybe t
    fromValue

    -- | Like "putState", but avoids aquiring a lock if the value is already in the
    -- map.
    getStateDefault :: Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault :: forall t. Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault Taffy IO t
    defaultGetter =
      Taffy IO (Maybe t)
    forall t. Typeable t => Taffy IO (Maybe t)
    getState Taffy IO (Maybe t) -> (Maybe t -> Taffy IO t) -> Taffy IO t
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Taffy IO t -> (t -> Taffy IO t) -> Maybe t -> Taffy IO t
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Taffy IO t -> Taffy IO t
    forall t. Typeable t => Taffy IO t -> Taffy IO t
    putState Taffy IO t
    defaultGetter) t -> Taffy IO t
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | Get a value of the type returned by the provided action from the the
    -- current taffybar state, unless the state does not exist, in which case the
    -- action will be called to populate the state map.
    putState :: forall t. Typeable t => Taffy IO t -> Taffy IO t
    putState :: forall t. Typeable t => Taffy IO t -> Taffy IO t
    putState Taffy IO t
    getValue = do
      MVar (Map TypeRep Value)
    contextVar <- (Context -> MVar (Map TypeRep Value))
    -> ReaderT Context IO (MVar (Map TypeRep Value))
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> MVar (Map TypeRep Value)
    contextState
      Context
    ctx <- ReaderT Context IO Context
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      IO t -> Taffy IO t
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO t -> Taffy IO t) -> IO t -> Taffy IO t
    forall a b. (a -> b) -> a -> b
    $ MVar (Map TypeRep Value)
    -> (Map TypeRep Value -> IO (Map TypeRep Value, t)) -> IO t
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MV.modifyMVar MVar (Map TypeRep Value)
    contextVar ((Map TypeRep Value -> IO (Map TypeRep Value, t)) -> IO t)
    -> (Map TypeRep Value -> IO (Map TypeRep Value, t)) -> IO t
    forall a b. (a -> b) -> a -> b
    $ \Map TypeRep Value
    contextStateMap ->
        let theType :: TypeRep
    theType = Proxy t -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy t
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy t)
            currentValue :: Maybe Value
    currentValue = TypeRep -> Map TypeRep Value -> Maybe Value
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup TypeRep
    theType Map TypeRep Value
    contextStateMap
            insertAndReturn :: t -> (Map TypeRep Value, t)
    insertAndReturn t
    value =
              (TypeRep -> Value -> Map TypeRep Value -> Map TypeRep Value
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert TypeRep
    theType (t -> Value
    forall t. Typeable t => t -> Value
    Value t
    value) Map TypeRep Value
    contextStateMap, t
    value)
        in (ReaderT Context IO (Map TypeRep Value, t)
     -> Context -> IO (Map TypeRep Value, t))
    -> Context
    -> ReaderT Context IO (Map TypeRep Value, t)
    -> IO (Map TypeRep Value, t)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT Context IO (Map TypeRep Value, t)
    -> Context -> IO (Map TypeRep Value, t)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    ctx (ReaderT Context IO (Map TypeRep Value, t)
     -> IO (Map TypeRep Value, t))
    -> ReaderT Context IO (Map TypeRep Value, t)
    -> IO (Map TypeRep Value, t)
    forall a b. (a -> b) -> a -> b
    $  ReaderT Context IO (Map TypeRep Value, t)
    -> (t -> ReaderT Context IO (Map TypeRep Value, t))
    -> Maybe t
    -> ReaderT Context IO (Map TypeRep Value, t)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
             (t -> (Map TypeRep Value, t)
    insertAndReturn  (t -> (Map TypeRep Value, t))
    -> Taffy IO t -> ReaderT Context IO (Map TypeRep Value, t)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Taffy IO t
    getValue)
             ((Map TypeRep Value, t) -> ReaderT Context IO (Map TypeRep Value, t)
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Map TypeRep Value, t)
     -> ReaderT Context IO (Map TypeRep Value, t))
    -> (t -> (Map TypeRep Value, t))
    -> t
    -> ReaderT Context IO (Map TypeRep Value, t)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map TypeRep Value
    contextStateMap,))
             (Maybe Value
    currentValue Maybe Value -> (Value -> Maybe t) -> Maybe t
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Value -> Maybe t
    forall t. Typeable t => Value -> Maybe t
    fromValue)

    -- | A version of "forkIO" in "TaffyIO".
    taffyFork :: ReaderT r IO () -> ReaderT r IO ()
    taffyFork :: forall r. ReaderT r IO () -> ReaderT r IO ()
    taffyFork = ReaderT r IO ThreadId -> ReaderT r IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT r IO ThreadId -> ReaderT r IO ())
    -> (ReaderT r IO () -> ReaderT r IO ThreadId)
    -> ReaderT r IO ()
    -> ReaderT r IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IO () -> IO ThreadId) -> ReaderT r IO () -> ReaderT r IO ThreadId
    forall (m :: * -> *) (m1 :: * -> *) a b r.
    Monad m =>
    (m1 a -> m b) -> ReaderT r m1 a -> ReaderT r m b
    liftReader IO () -> IO ThreadId
    forkIO

    startX11EventHandler :: Taffy IO ()
    startX11EventHandler :: TaffyIO ()
    startX11EventHandler = TaffyIO () -> TaffyIO ()
    forall r. ReaderT r IO () -> ReaderT r IO ()
    taffyFork (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Context
    c <- ReaderT Context IO Context
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      -- XXX: The event loop needs its own X11Context to separately handle
      -- communications from the X server. We deliberately avoid using the context
      -- from x11ContextVar here.
      IO () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ X11Property () -> IO ()
    forall a. X11Property a -> IO a
    withDefaultCtx (X11Property () -> IO ()) -> X11Property () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Event -> IO ()) -> X11Property ()
    eventLoop
             (\Event
    e -> TaffyIO () -> Context -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (Event -> TaffyIO ()
    handleX11Event Event
    e) Context
    c)

    -- | Remove the listener associated with the provided "Unique" from the
    -- collection of listeners.
    unsubscribe :: Unique -> Taffy IO ()
    unsubscribe :: Unique -> TaffyIO ()
    unsubscribe Unique
    identifier = do
      MVar SubscriptionList
    listenersVar <- (Context -> MVar SubscriptionList)
    -> ReaderT Context IO (MVar SubscriptionList)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> MVar SubscriptionList
    listeners
      IO () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ MVar SubscriptionList
    -> (SubscriptionList -> IO SubscriptionList) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar SubscriptionList
    listenersVar ((SubscriptionList -> IO SubscriptionList) -> IO ())
    -> (SubscriptionList -> IO SubscriptionList) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ SubscriptionList -> IO SubscriptionList
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SubscriptionList -> IO SubscriptionList)
    -> (SubscriptionList -> SubscriptionList)
    -> SubscriptionList
    -> IO SubscriptionList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Unique, Event -> TaffyIO ()) -> Bool)
    -> SubscriptionList -> SubscriptionList
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    identifier) (Unique -> Bool)
    -> ((Unique, Event -> TaffyIO ()) -> Unique)
    -> (Unique, Event -> TaffyIO ())
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unique, Event -> TaffyIO ()) -> Unique
    forall a b. (a, b) -> a
    fst)

    -- | Subscribe to all incoming events on the X11 event loop. The returned
    -- "Unique" value can be used to unregister the listener using "unsuscribe".
    subscribeToAll :: Listener -> Taffy IO Unique
    subscribeToAll :: (Event -> TaffyIO ()) -> Taffy IO Unique
    subscribeToAll Event -> TaffyIO ()
    listener = do
      Unique
    identifier <- IO Unique -> Taffy IO Unique
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift IO Unique
    newUnique
      MVar SubscriptionList
    listenersVar <- (Context -> MVar SubscriptionList)
    -> ReaderT Context IO (MVar SubscriptionList)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Context -> MVar SubscriptionList
    listeners
      let
        -- XXX: This type annotation probably has something to do with the warnings
        -- that occur without MonoLocalBinds, but it still seems to be necessary
        addListener :: SubscriptionList -> SubscriptionList
        addListener :: SubscriptionList -> SubscriptionList
    addListener = ((Unique
    identifier, Event -> TaffyIO ()
    listener)(Unique, Event -> TaffyIO ())
    -> SubscriptionList -> SubscriptionList
    forall a. a -> [a] -> [a]
    :)
      IO () -> TaffyIO ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ MVar SubscriptionList
    -> (SubscriptionList -> IO SubscriptionList) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar SubscriptionList
    listenersVar (SubscriptionList -> IO SubscriptionList
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SubscriptionList -> IO SubscriptionList)
    -> (SubscriptionList -> SubscriptionList)
    -> SubscriptionList
    -> IO SubscriptionList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SubscriptionList -> SubscriptionList
    addListener)
      Unique -> Taffy IO Unique
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unique
    identifier

    -- | Subscribe to X11 "PropertyEvent"s where the property changed is in the
    -- provided list.
    subscribeToPropertyEvents :: [String] -> Listener -> Taffy IO Unique
    subscribeToPropertyEvents :: [String] -> (Event -> TaffyIO ()) -> Taffy IO Unique
    subscribeToPropertyEvents [String]
    eventNames Event -> TaffyIO ()
    listener = do
      [Atom]
    eventAtoms <- (String -> ReaderT Context IO Atom)
    -> [String] -> ReaderT Context IO [Atom]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (X11Property Atom -> ReaderT Context IO Atom
    forall a. X11Property a -> TaffyIO a
    runX11 (X11Property Atom -> ReaderT Context IO Atom)
    -> (String -> X11Property Atom)
    -> String
    -> ReaderT Context IO Atom
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> X11Property Atom
    getAtom) [String]
    eventNames
      let filteredListener :: Event -> TaffyIO ()
    filteredListener event :: Event
    event@PropertyEvent { ev_atom :: Event -> Atom
    ev_atom = Atom
    atom } =
            Bool -> TaffyIO () -> TaffyIO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Atom
    atom Atom -> [Atom] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Atom]
    eventAtoms) (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $
                 TaffyIO () -> (SomeException -> TaffyIO ()) -> TaffyIO ()
    forall (m :: * -> *) a.
    MonadBaseControl IO m =>
    m a -> (SomeException -> m a) -> m a
    catchAny (Event -> TaffyIO ()
    listener Event
    event) (TaffyIO () -> SomeException -> TaffyIO ()
    forall a b. a -> b -> a
    const (TaffyIO () -> SomeException -> TaffyIO ())
    -> TaffyIO () -> SomeException -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ () -> TaffyIO ()
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
          filteredListener Event
    _ = () -> TaffyIO ()
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      (Event -> TaffyIO ()) -> Taffy IO Unique
    subscribeToAll Event -> TaffyIO ()
    filteredListener

    handleX11Event :: Event -> Taffy IO ()
    handleX11Event :: Event -> TaffyIO ()
    handleX11Event Event
    event =
      (Context -> MVar SubscriptionList)
    -> ReaderT Context IO SubscriptionList
    forall r b. (r -> MVar b) -> ReaderT r IO b
    asksContextVar Context -> MVar SubscriptionList
    listeners ReaderT Context IO SubscriptionList
    -> (SubscriptionList -> TaffyIO ()) -> TaffyIO ()
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ((Unique, Event -> TaffyIO ()) -> TaffyIO ())
    -> SubscriptionList -> TaffyIO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Unique, Event -> TaffyIO ()) -> TaffyIO ()
    applyListener
      where applyListener :: (Unique, Listener) -> Taffy IO ()
            applyListener :: (Unique, Event -> TaffyIO ()) -> TaffyIO ()
    applyListener (Unique
    _, Event -> TaffyIO ()
    listener) = TaffyIO () -> TaffyIO ()
    forall r. ReaderT r IO () -> ReaderT r IO ()
    taffyFork (TaffyIO () -> TaffyIO ()) -> TaffyIO () -> TaffyIO ()
    forall a b. (a -> b) -> a -> b
    $ Event -> TaffyIO ()
    listener Event
    event