    {-# OPTIONS_GHC -fno-warn-type-defaults #-}
    {-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, RankNTypes, OverloadedStrings #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Widget.Workspaces
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    -----------------------------------------------------------------------------

    module System.Taffybar.Widget.Workspaces where

    import           Control.Applicative
    import           Control.Arrow ((&&&))
    import           Control.Concurrent
    import qualified Control.Concurrent.MVar as MV
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Maybe
    import           Control.Monad.Trans.Reader
    import           Control.RateLimit
    import qualified Data.Foldable as F
    import           Data.GI.Base.ManagedPtr (unsafeCastTo)
    import           Data.Int
    import           Data.List (intersect, sortBy, (\\))
    import qualified Data.Map as M
    import           Data.Maybe
    import qualified Data.MultiMap as MM
    import           Data.Ord
    import qualified Data.Set as Set
    import qualified Data.Text as T
    import           Data.Time.Units
    import           Data.Tuple.Select
    import           Data.Tuple.Sequence
    import qualified GI.Gdk.Enums as Gdk
    import qualified GI.Gdk.Structs.EventScroll as Gdk
    import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
    import qualified GI.Gtk as Gtk
    import           Prelude
    import           StatusNotifier.Tray (scalePixbufToSize)
    import           System.Log.Logger
    import           System.Taffybar.Context
    import           System.Taffybar.Information.EWMHDesktopInfo
    import           System.Taffybar.Information.SafeX11
    import           System.Taffybar.Information.X11DesktopInfo
    import           System.Taffybar.Util
    import           System.Taffybar.Widget.Decorators
    import           System.Taffybar.Widget.Generic.AutoSizeImage (autoSizeImage)
    import           System.Taffybar.Widget.Util
    import           System.Taffybar.WindowIcon
    import           Text.Printf

    data WorkspaceState
      = Active
      | Visible
      | Hidden
      | Empty
      | Urgent
      deriving (Int -> WorkspaceState -> ShowS
    [WorkspaceState] -> ShowS
    WorkspaceState -> String
    (Int -> WorkspaceState -> ShowS)
    -> (WorkspaceState -> String)
    -> ([WorkspaceState] -> ShowS)
    -> Show WorkspaceState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [WorkspaceState] -> ShowS
    $cshowList :: [WorkspaceState] -> ShowS
    show :: WorkspaceState -> String
    $cshow :: WorkspaceState -> String
    showsPrec :: Int -> WorkspaceState -> ShowS
    $cshowsPrec :: Int -> WorkspaceState -> ShowS
    Show, WorkspaceState -> WorkspaceState -> Bool
    (WorkspaceState -> WorkspaceState -> Bool)
    -> (WorkspaceState -> WorkspaceState -> Bool) -> Eq WorkspaceState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: WorkspaceState -> WorkspaceState -> Bool
    $c/= :: WorkspaceState -> WorkspaceState -> Bool
    == :: WorkspaceState -> WorkspaceState -> Bool
    $c== :: WorkspaceState -> WorkspaceState -> Bool
    Eq)

    getCSSClass :: (Show s) => s -> T.Text
    getCSSClass :: s -> Text
    getCSSClass = Text -> Text
    T.toLower (Text -> Text) -> (s -> Text) -> s -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Text) -> (s -> String) -> s -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> String
    forall a. Show a => a -> String
    show

    cssWorkspaceStates :: [T.Text]
    cssWorkspaceStates :: [Text]
    cssWorkspaceStates = (WorkspaceState -> Text) -> [WorkspaceState] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map WorkspaceState -> Text
    forall s. Show s => s -> Text
    getCSSClass [WorkspaceState
    Active, WorkspaceState
    Visible, WorkspaceState
    Hidden, WorkspaceState
    Empty, WorkspaceState
    Urgent]

    data WindowData = WindowData
      { WindowData -> X11Window
    windowId :: X11Window
      , WindowData -> String
    windowTitle :: String
      , WindowData -> String
    windowClass :: String
      , WindowData -> Bool
    windowUrgent :: Bool
      , WindowData -> Bool
    windowActive :: Bool
      , WindowData -> Bool
    windowMinimized :: Bool
      } deriving (Int -> WindowData -> ShowS
    [WindowData] -> ShowS
    WindowData -> String
    (Int -> WindowData -> ShowS)
    -> (WindowData -> String)
    -> ([WindowData] -> ShowS)
    -> Show WindowData
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [WindowData] -> ShowS
    $cshowList :: [WindowData] -> ShowS
    show :: WindowData -> String
    $cshow :: WindowData -> String
    showsPrec :: Int -> WindowData -> ShowS
    $cshowsPrec :: Int -> WindowData -> ShowS
    Show, WindowData -> WindowData -> Bool
    (WindowData -> WindowData -> Bool)
    -> (WindowData -> WindowData -> Bool) -> Eq WindowData
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: WindowData -> WindowData -> Bool
    $c/= :: WindowData -> WindowData -> Bool
    == :: WindowData -> WindowData -> Bool
    $c== :: WindowData -> WindowData -> Bool
    Eq)

    data WidgetUpdate = WorkspaceUpdate Workspace | IconUpdate [X11Window]

    data Workspace = Workspace
      { Workspace -> WorkspaceId
    workspaceIdx :: WorkspaceId
      , Workspace -> String
    workspaceName :: String
      , Workspace -> WorkspaceState
    workspaceState :: WorkspaceState
      , Workspace -> [WindowData]
    windows :: [WindowData]
      } deriving (Int -> Workspace -> ShowS
    [Workspace] -> ShowS
    Workspace -> String
    (Int -> Workspace -> ShowS)
    -> (Workspace -> String)
    -> ([Workspace] -> ShowS)
    -> Show Workspace
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Workspace] -> ShowS
    $cshowList :: [Workspace] -> ShowS
    show :: Workspace -> String
    $cshow :: Workspace -> String
    showsPrec :: Int -> Workspace -> ShowS
    $cshowsPrec :: Int -> Workspace -> ShowS
    Show, Workspace -> Workspace -> Bool
    (Workspace -> Workspace -> Bool)
    -> (Workspace -> Workspace -> Bool) -> Eq Workspace
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Workspace -> Workspace -> Bool
    $c/= :: Workspace -> Workspace -> Bool
    == :: Workspace -> Workspace -> Bool
    $c== :: Workspace -> Workspace -> Bool
    Eq)

    data WorkspacesContext = WorkspacesContext
      { WorkspacesContext -> MVar (Map WorkspaceId WWC)
    controllersVar :: MV.MVar (M.Map WorkspaceId WWC)
      , WorkspacesContext -> MVar (Map WorkspaceId Workspace)
    workspacesVar :: MV.MVar (M.Map WorkspaceId Workspace)
      , WorkspacesContext -> Box
    workspacesWidget :: Gtk.Box
      , WorkspacesContext -> WorkspacesConfig
    workspacesConfig :: WorkspacesConfig
      , WorkspacesContext -> Context
    taffyContext :: Context
      }

    type WorkspacesIO a = ReaderT WorkspacesContext IO a

    liftContext :: TaffyIO a -> WorkspacesIO a
    liftContext :: TaffyIO a -> WorkspacesIO a
    liftContext action :: TaffyIO a
    action = (WorkspacesContext -> Context)
    -> ReaderT WorkspacesContext IO Context
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks WorkspacesContext -> Context
    taffyContext ReaderT WorkspacesContext IO Context
    -> (Context -> WorkspacesIO a) -> WorkspacesIO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO a -> WorkspacesIO a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO a -> WorkspacesIO a)
    -> (Context -> IO a) -> Context -> WorkspacesIO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TaffyIO a -> Context -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT TaffyIO a
    action

    liftX11Def :: a -> X11Property a -> WorkspacesIO a
    liftX11Def :: a -> X11Property a -> WorkspacesIO a
    liftX11Def def :: a
    def prop :: X11Property a
    prop = TaffyIO a -> WorkspacesIO a
    forall a. TaffyIO a -> WorkspacesIO a
    liftContext (TaffyIO a -> WorkspacesIO a) -> TaffyIO a -> WorkspacesIO a
    forall a b. (a -> b) -> a -> b
    $ a -> X11Property a -> TaffyIO a
    forall a. a -> X11Property a -> TaffyIO a
    runX11Def a
    def X11Property a
    prop

    setWorkspaceWidgetStatusClass ::
         (MonadIO m, Gtk.IsWidget a) => Workspace -> a -> m ()
    setWorkspaceWidgetStatusClass :: Workspace -> a -> m ()
    setWorkspaceWidgetStatusClass workspace :: Workspace
    workspace widget :: a
    widget =
      a -> [Text] -> [Text] -> m ()
    forall (t1 :: * -> *) (t :: * -> *) a (m :: * -> *).
    (Foldable t1, Foldable t, IsWidget a, MonadIO m) =>
    a -> t1 Text -> t Text -> m ()
    updateWidgetClasses
        a
    widget
        [WorkspaceState -> Text
    forall s. Show s => s -> Text
    getCSSClass (WorkspaceState -> Text) -> WorkspaceState -> Text
    forall a b. (a -> b) -> a -> b
    $ Workspace -> WorkspaceState
    workspaceState Workspace
    workspace]
        [Text]
    cssWorkspaceStates

    updateWidgetClasses ::
      (Foldable t1, Foldable t, Gtk.IsWidget a, MonadIO m)
      => a
      -> t1 T.Text
      -> t T.Text
      -> m ()
    updateWidgetClasses :: a -> t1 Text -> t Text -> m ()
    updateWidgetClasses widget :: a
    widget toAdd :: t1 Text
    toAdd toRemove :: t Text
    toRemove = do
      StyleContext
    context <- a -> m StyleContext
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m StyleContext
    Gtk.widgetGetStyleContext a
    widget
      let hasClass :: Text -> m Bool
    hasClass = StyleContext -> Text -> m Bool
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsStyleContext a) =>
    a -> Text -> m Bool
    Gtk.styleContextHasClass StyleContext
    context
          addIfMissing :: Text -> m ()
    addIfMissing klass :: Text
    klass =
            Text -> m Bool
    hasClass Text
    klass m Bool -> (Bool -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    `when` StyleContext -> Text -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsStyleContext a) =>
    a -> Text -> m ()
    Gtk.styleContextAddClass StyleContext
    context Text
    klass) (Bool -> m ()) -> (Bool -> Bool) -> Bool -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not
          removeIfPresent :: Text -> m ()
    removeIfPresent klass :: Text
    klass = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text
    klass Text -> t1 Text -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t1 Text
    toAdd) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            Text -> m Bool
    hasClass Text
    klass m Bool -> (Bool -> m ()) -> m ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    `when` StyleContext -> Text -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsStyleContext a) =>
    a -> Text -> m ()
    Gtk.styleContextRemoveClass StyleContext
    context Text
    klass)
      (Text -> m ()) -> t Text -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Text -> m ()
    removeIfPresent t Text
    toRemove
      (Text -> m ()) -> t1 Text -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Text -> m ()
    addIfMissing t1 Text
    toAdd

    class WorkspaceWidgetController wc where
      getWidget :: wc -> WorkspacesIO Gtk.Widget
      updateWidget :: wc -> WidgetUpdate -> WorkspacesIO wc
      updateWidgetX11 :: wc -> WidgetUpdate -> WorkspacesIO wc
      updateWidgetX11 cont :: wc
    cont _ = wc -> WorkspacesIO wc
    forall (m :: * -> *) a. Monad m => a -> m a
    return wc
    cont

    data WWC = forall a. WorkspaceWidgetController a => WWC a

    instance WorkspaceWidgetController WWC where
      getWidget :: WWC -> WorkspacesIO Widget
    getWidget (WWC wc :: a
    wc) = a -> WorkspacesIO Widget
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WorkspacesIO Widget
    getWidget a
    wc
      updateWidget :: WWC -> WidgetUpdate -> WorkspacesIO WWC
    updateWidget (WWC wc :: a
    wc) update :: WidgetUpdate
    update = a -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC (a -> WWC) -> ReaderT WorkspacesContext IO a -> WorkspacesIO WWC
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> WidgetUpdate -> ReaderT WorkspacesContext IO a
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget a
    wc WidgetUpdate
    update
      updateWidgetX11 :: WWC -> WidgetUpdate -> WorkspacesIO WWC
    updateWidgetX11 (WWC wc :: a
    wc) update :: WidgetUpdate
    update = a -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC (a -> WWC) -> ReaderT WorkspacesContext IO a -> WorkspacesIO WWC
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> WidgetUpdate -> ReaderT WorkspacesContext IO a
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidgetX11 a
    wc WidgetUpdate
    update

    type ControllerConstructor = Workspace -> WorkspacesIO WWC
    type ParentControllerConstructor =
      ControllerConstructor -> ControllerConstructor

    type WindowIconPixbufGetter =
      Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)

    data WorkspacesConfig =
      WorkspacesConfig
      { WorkspacesConfig -> ControllerConstructor
    widgetBuilder :: ControllerConstructor
      , WorkspacesConfig -> Int
    widgetGap :: Int
      , WorkspacesConfig -> Int
    underlineHeight :: Int
      , WorkspacesConfig -> Int
    underlinePadding :: Int
      , WorkspacesConfig -> Maybe Int
    maxIcons :: Maybe Int
      , WorkspacesConfig -> Int
    minIcons :: Int
      , WorkspacesConfig -> WindowIconPixbufGetter
    getWindowIconPixbuf :: WindowIconPixbufGetter
      , WorkspacesConfig -> Workspace -> WorkspacesIO String
    labelSetter :: Workspace -> WorkspacesIO String
      , WorkspacesConfig -> Workspace -> Bool
    showWorkspaceFn :: Workspace -> Bool
      , WorkspacesConfig -> Int
    borderWidth :: Int
      , WorkspacesConfig -> [String]
    updateEvents :: [String]
      , WorkspacesConfig -> Integer
    updateRateLimitMicroseconds :: Integer
      , WorkspacesConfig -> [WindowData] -> WorkspacesIO [WindowData]
    iconSort :: [WindowData] -> WorkspacesIO [WindowData]
      , WorkspacesConfig -> Bool
    urgentWorkspaceState :: Bool
      }

    defaultWorkspacesConfig :: WorkspacesConfig
    defaultWorkspacesConfig :: WorkspacesConfig
    defaultWorkspacesConfig =
      WorkspacesConfig :: ControllerConstructor
    -> Int
    -> Int
    -> Int
    -> Maybe Int
    -> Int
    -> WindowIconPixbufGetter
    -> (Workspace -> WorkspacesIO String)
    -> (Workspace -> Bool)
    -> Int
    -> [String]
    -> Integer
    -> ([WindowData] -> WorkspacesIO [WindowData])
    -> Bool
    -> WorkspacesConfig
    WorkspacesConfig
      { widgetBuilder :: ControllerConstructor
    widgetBuilder = ParentControllerConstructor
    buildButtonController ControllerConstructor
    defaultBuildContentsController
      , widgetGap :: Int
    widgetGap = 0
      , underlineHeight :: Int
    underlineHeight = 4
      , underlinePadding :: Int
    underlinePadding = 1
      , maxIcons :: Maybe Int
    maxIcons = Maybe Int
    forall a. Maybe a
    Nothing
      , minIcons :: Int
    minIcons = 0
      , getWindowIconPixbuf :: WindowIconPixbufGetter
    getWindowIconPixbuf = WindowIconPixbufGetter
    defaultGetWindowIconPixbuf
      , labelSetter :: Workspace -> WorkspacesIO String
    labelSetter = String -> WorkspacesIO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> WorkspacesIO String)
    -> (Workspace -> String) -> Workspace -> WorkspacesIO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace -> String
    workspaceName
      , showWorkspaceFn :: Workspace -> Bool
    showWorkspaceFn = Bool -> Workspace -> Bool
    forall a b. a -> b -> a
    const Bool
    True
      , borderWidth :: Int
    borderWidth = 2
      , iconSort :: [WindowData] -> WorkspacesIO [WindowData]
    iconSort = [WindowData] -> WorkspacesIO [WindowData]
    sortWindowsByPosition
      , updateEvents :: [String]
    updateEvents = [String]
    allEWMHProperties [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [String
    ewmhWMIcon]
      , updateRateLimitMicroseconds :: Integer
    updateRateLimitMicroseconds = 100000
      , urgentWorkspaceState :: Bool
    urgentWorkspaceState = Bool
    False
      }

    hideEmpty :: Workspace -> Bool
    hideEmpty :: Workspace -> Bool
    hideEmpty Workspace { workspaceState :: Workspace -> WorkspaceState
    workspaceState = WorkspaceState
    Empty } = Bool
    False
    hideEmpty _ = Bool
    True

    wLog :: MonadIO m => Priority -> String -> m ()
    wLog :: Priority -> String -> m ()
    wLog l :: Priority
    l s :: String
    s = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> Priority -> String -> IO ()
    logM "System.Taffybar.Widget.Workspaces" Priority
    l String
    s

    updateVar :: MV.MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a
    updateVar :: MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a
    updateVar var :: MVar a
    var modify :: a -> WorkspacesIO a
    modify = do
      WorkspacesContext
    ctx <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      IO a -> WorkspacesIO a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO a -> WorkspacesIO a) -> IO a -> WorkspacesIO a
    forall a b. (a -> b) -> a -> b
    $ MVar a -> (a -> IO (a, a)) -> IO a
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    MV.modifyMVar MVar a
    var ((a -> IO (a, a)) -> IO a) -> (a -> IO (a, a)) -> IO a
    forall a b. (a -> b) -> a -> b
    $ (a -> (a, a)) -> IO a -> IO (a, a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\a :: a
    a -> (a
    a, a
    a)) (IO a -> IO (a, a)) -> (a -> IO a) -> a -> IO (a, a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WorkspacesIO a -> WorkspacesContext -> IO a)
    -> WorkspacesContext -> WorkspacesIO a -> IO a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO a -> WorkspacesContext -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO a -> IO a) -> (a -> WorkspacesIO a) -> a -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> WorkspacesIO a
    modify

    updateWorkspacesVar :: WorkspacesIO (M.Map WorkspaceId Workspace)
    updateWorkspacesVar :: WorkspacesIO (Map WorkspaceId Workspace)
    updateWorkspacesVar = do
      MVar (Map WorkspaceId Workspace)
    workspacesRef <- (WorkspacesContext -> MVar (Map WorkspaceId Workspace))
    -> ReaderT WorkspacesContext IO (MVar (Map WorkspaceId Workspace))
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks WorkspacesContext -> MVar (Map WorkspaceId Workspace)
    workspacesVar
      MVar (Map WorkspaceId Workspace)
    -> (Map WorkspaceId Workspace
        -> WorkspacesIO (Map WorkspaceId Workspace))
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall a. MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a
    updateVar MVar (Map WorkspaceId Workspace)
    workspacesRef Map WorkspaceId Workspace
    -> WorkspacesIO (Map WorkspaceId Workspace)
    buildWorkspaceData

    getWorkspaceToWindows ::
      [X11Window] -> X11Property (MM.MultiMap WorkspaceId X11Window)
    getWorkspaceToWindows :: [X11Window] -> X11Property (MultiMap WorkspaceId X11Window)
    getWorkspaceToWindows =
      (MultiMap WorkspaceId X11Window
     -> X11Window -> X11Property (MultiMap WorkspaceId X11Window))
    -> MultiMap WorkspaceId X11Window
    -> [X11Window]
    -> X11Property (MultiMap WorkspaceId X11Window)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM
        (\theMap :: MultiMap WorkspaceId X11Window
    theMap window :: X11Window
    window ->
           WorkspaceId
    -> X11Window
    -> MultiMap WorkspaceId X11Window
    -> MultiMap WorkspaceId X11Window
    forall k a. Ord k => k -> a -> MultiMap k a -> MultiMap k a
    MM.insert (WorkspaceId
     -> X11Window
     -> MultiMap WorkspaceId X11Window
     -> MultiMap WorkspaceId X11Window)
    -> ReaderT X11Context IO WorkspaceId
    -> ReaderT
         X11Context
         IO
         (X11Window
          -> MultiMap WorkspaceId X11Window
          -> MultiMap WorkspaceId X11Window)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> X11Window -> ReaderT X11Context IO WorkspaceId
    getWorkspace X11Window
    window ReaderT
      X11Context
      IO
      (X11Window
       -> MultiMap WorkspaceId X11Window
       -> MultiMap WorkspaceId X11Window)
    -> ReaderT X11Context IO X11Window
    -> ReaderT
         X11Context
         IO
         (MultiMap WorkspaceId X11Window -> MultiMap WorkspaceId X11Window)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> X11Window -> ReaderT X11Context IO X11Window
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure X11Window
    window ReaderT
      X11Context
      IO
      (MultiMap WorkspaceId X11Window -> MultiMap WorkspaceId X11Window)
    -> X11Property (MultiMap WorkspaceId X11Window)
    -> X11Property (MultiMap WorkspaceId X11Window)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> MultiMap WorkspaceId X11Window
    -> X11Property (MultiMap WorkspaceId X11Window)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure MultiMap WorkspaceId X11Window
    theMap)
        MultiMap WorkspaceId X11Window
    forall k a. MultiMap k a
    MM.empty

    getWindowData :: Maybe X11Window
                  -> [X11Window]
                  -> X11Window
                  -> X11Property WindowData
    getWindowData :: Maybe X11Window
    -> [X11Window] -> X11Window -> X11Property WindowData
    getWindowData activeWindow :: Maybe X11Window
    activeWindow urgentWindows :: [X11Window]
    urgentWindows window :: X11Window
    window = do
      String
    wTitle <- X11Window -> X11Property String
    getWindowTitle X11Window
    window
      String
    wClass <- X11Window -> X11Property String
    getWindowClass X11Window
    window
      Bool
    wMinimized <- X11Window -> X11Property Bool
    getWindowMinimized X11Window
    window
      WindowData -> X11Property WindowData
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        WindowData :: X11Window -> String -> String -> Bool -> Bool -> Bool -> WindowData
    WindowData
        { windowId :: X11Window
    windowId = X11Window
    window
        , windowTitle :: String
    windowTitle = String
    wTitle
        , windowClass :: String
    windowClass = String
    wClass
        , windowUrgent :: Bool
    windowUrgent = X11Window
    window X11Window -> [X11Window] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [X11Window]
    urgentWindows
        , windowActive :: Bool
    windowActive = X11Window -> Maybe X11Window
    forall a. a -> Maybe a
    Just X11Window
    window Maybe X11Window -> Maybe X11Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe X11Window
    activeWindow
        , windowMinimized :: Bool
    windowMinimized = Bool
    wMinimized
        }

    buildWorkspaceData :: M.Map WorkspaceId Workspace
                    -> WorkspacesIO (M.Map WorkspaceId Workspace)
    buildWorkspaceData :: Map WorkspaceId Workspace
    -> WorkspacesIO (Map WorkspaceId Workspace)
    buildWorkspaceData _ = ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask ReaderT WorkspacesContext IO WorkspacesContext
    -> (WorkspacesContext -> WorkspacesIO (Map WorkspaceId Workspace))
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \context :: WorkspacesContext
    context -> Map WorkspaceId Workspace
    -> X11Property (Map WorkspaceId Workspace)
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall a. a -> X11Property a -> WorkspacesIO a
    liftX11Def Map WorkspaceId Workspace
    forall k a. Map k a
    M.empty (X11Property (Map WorkspaceId Workspace)
     -> WorkspacesIO (Map WorkspaceId Workspace))
    -> X11Property (Map WorkspaceId Workspace)
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall a b. (a -> b) -> a -> b
    $ do
      [(WorkspaceId, String)]
    names <- X11Property [(WorkspaceId, String)]
    getWorkspaceNames
      [X11Window]
    wins <- X11Property [X11Window]
    getWindows
      MultiMap WorkspaceId X11Window
    workspaceToWindows <- [X11Window] -> X11Property (MultiMap WorkspaceId X11Window)
    getWorkspaceToWindows [X11Window]
    wins
      [X11Window]
    urgentWindows <- (X11Window -> X11Property Bool)
    -> [X11Window] -> X11Property [X11Window]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM X11Window -> X11Property Bool
    isWindowUrgent [X11Window]
    wins
      Maybe X11Window
    activeWindow <- X11Property (Maybe X11Window)
    getActiveWindow
      active :: WorkspaceId
    active:visible :: [WorkspaceId]
    visible <- X11Property [WorkspaceId]
    getVisibleWorkspaces
      let getWorkspaceState :: WorkspaceId -> [X11Window] -> WorkspaceState
    getWorkspaceState idx :: WorkspaceId
    idx ws :: [X11Window]
    ws
            | WorkspaceId
    idx WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    == WorkspaceId
    active = WorkspaceState
    Active
            | WorkspaceId
    idx WorkspaceId -> [WorkspaceId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [WorkspaceId]
    visible = WorkspaceState
    Visible
            | WorkspacesConfig -> Bool
    urgentWorkspaceState (WorkspacesContext -> WorkspacesConfig
    workspacesConfig WorkspacesContext
    context) Bool -> Bool -> Bool
    &&
              Bool -> Bool
    not ([X11Window] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([X11Window]
    ws [X11Window] -> [X11Window] -> [X11Window]
    forall a. Eq a => [a] -> [a] -> [a]
    `intersect` [X11Window]
    urgentWindows)) =
              WorkspaceState
    Urgent
            | [X11Window] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [X11Window]
    ws = WorkspaceState
    Empty
            | Bool
    otherwise = WorkspaceState
    Hidden
      (Map WorkspaceId Workspace
     -> (WorkspaceId, String)
     -> X11Property (Map WorkspaceId Workspace))
    -> Map WorkspaceId Workspace
    -> [(WorkspaceId, String)]
    -> X11Property (Map WorkspaceId Workspace)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM
        (\theMap :: Map WorkspaceId Workspace
    theMap (idx :: WorkspaceId
    idx, name :: String
    name) -> do
           let ws :: [X11Window]
    ws = WorkspaceId -> MultiMap WorkspaceId X11Window -> [X11Window]
    forall k a. Ord k => k -> MultiMap k a -> [a]
    MM.lookup WorkspaceId
    idx MultiMap WorkspaceId X11Window
    workspaceToWindows
           [WindowData]
    windowInfos <- (X11Window -> X11Property WindowData)
    -> [X11Window] -> ReaderT X11Context IO [WindowData]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Maybe X11Window
    -> [X11Window] -> X11Window -> X11Property WindowData
    getWindowData Maybe X11Window
    activeWindow [X11Window]
    urgentWindows) [X11Window]
    ws
           Map WorkspaceId Workspace
    -> X11Property (Map WorkspaceId Workspace)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map WorkspaceId Workspace
     -> X11Property (Map WorkspaceId Workspace))
    -> Map WorkspaceId Workspace
    -> X11Property (Map WorkspaceId Workspace)
    forall a b. (a -> b) -> a -> b
    $
             WorkspaceId
    -> Workspace
    -> Map WorkspaceId Workspace
    -> Map WorkspaceId Workspace
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert
               WorkspaceId
    idx
               Workspace :: WorkspaceId
    -> String -> WorkspaceState -> [WindowData] -> Workspace
    Workspace
               { workspaceIdx :: WorkspaceId
    workspaceIdx = WorkspaceId
    idx
               , workspaceName :: String
    workspaceName = String
    name
               , workspaceState :: WorkspaceState
    workspaceState = WorkspaceId -> [X11Window] -> WorkspaceState
    getWorkspaceState WorkspaceId
    idx [X11Window]
    ws
               , windows :: [WindowData]
    windows = [WindowData]
    windowInfos
               }
               Map WorkspaceId Workspace
    theMap)
        Map WorkspaceId Workspace
    forall k a. Map k a
    M.empty
        [(WorkspaceId, String)]
    names

    addWidgetsToTopLevel :: WorkspacesIO ()
    addWidgetsToTopLevel :: WorkspacesIO ()
    addWidgetsToTopLevel = do
      WorkspacesContext
        { controllersVar :: WorkspacesContext -> MVar (Map WorkspaceId WWC)
    controllersVar = MVar (Map WorkspaceId WWC)
    controllersRef
        , workspacesWidget :: WorkspacesContext -> Box
    workspacesWidget = Box
    cont
        } <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      Map WorkspaceId WWC
    controllersMap <- IO (Map WorkspaceId WWC)
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Map WorkspaceId WWC)
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> IO (Map WorkspaceId WWC)
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall a b. (a -> b) -> a -> b
    $ MVar (Map WorkspaceId WWC) -> IO (Map WorkspaceId WWC)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId WWC)
    controllersRef
      -- Elems returns elements in ascending order of their keys so this will always
      -- add the widgets in the correct order
      (WWC -> WorkspacesIO ()) -> [WWC] -> WorkspacesIO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ WWC -> WorkspacesIO ()
    addWidget ([WWC] -> WorkspacesIO ()) -> [WWC] -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Map WorkspaceId WWC -> [WWC]
    forall k a. Map k a -> [a]
    M.elems Map WorkspaceId WWC
    controllersMap
      IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShowAll Box
    cont

    addWidget :: WWC -> WorkspacesIO ()
    addWidget :: WWC -> WorkspacesIO ()
    addWidget controller :: WWC
    controller = do
      Box
    cont <- (WorkspacesContext -> Box) -> ReaderT WorkspacesContext IO Box
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks WorkspacesContext -> Box
    workspacesWidget
      Widget
    workspaceWidget <- WWC -> WorkspacesIO Widget
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WorkspacesIO Widget
    getWidget WWC
    controller
      IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ do
         -- XXX: This hbox exists to (hopefully) prevent the issue where workspace
         -- widgets appear out of order, in the switcher, by acting as an empty
         -- place holder when the actual widget is hidden.
        Box
    hbox <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal 0
        IO (Maybe ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Widget -> IO (Maybe Widget)
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m (Maybe Widget)
    Gtk.widgetGetParent Widget
    workspaceWidget IO (Maybe Widget)
    -> (Maybe Widget -> IO (Maybe Box)) -> IO (Maybe Box)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
             (Widget -> IO Box) -> Maybe Widget -> IO (Maybe Box)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((ManagedPtr Box -> Box) -> Widget -> IO Box
    forall o o'.
    (HasCallStack, ManagedPtrNewtype o, TypedObject o,
     ManagedPtrNewtype o', TypedObject o') =>
    (ManagedPtr o' -> o') -> o -> IO o'
    unsafeCastTo ManagedPtr Box -> Box
    Gtk.Box) IO (Maybe Box) -> (Maybe Box -> IO (Maybe ())) -> IO (Maybe ())
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
             (Box -> IO ()) -> Maybe Box -> IO (Maybe ())
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Box -> Widget -> IO ()) -> Widget -> Box -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Box -> Widget -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerRemove Widget
    workspaceWidget)
        Box -> Widget -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Box
    hbox Widget
    workspaceWidget
        Box -> Box -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Box
    cont Box
    hbox

    workspacesNew :: WorkspacesConfig -> TaffyIO Gtk.Widget
    workspacesNew :: WorkspacesConfig -> TaffyIO Widget
    workspacesNew cfg :: WorkspacesConfig
    cfg = ReaderT Context IO Context
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask ReaderT Context IO Context
    -> (Context -> TaffyIO Widget) -> TaffyIO Widget
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \tContext :: Context
    tContext -> IO Widget -> TaffyIO Widget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Widget -> TaffyIO Widget) -> IO Widget -> TaffyIO Widget
    forall a b. (a -> b) -> a -> b
    $ do
      Box
    cont <- 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
    $ Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (WorkspacesConfig -> Int
    widgetGap WorkspacesConfig
    cfg)
      MVar (Map WorkspaceId WWC)
    controllersRef <- Map WorkspaceId WWC -> IO (MVar (Map WorkspaceId WWC))
    forall a. a -> IO (MVar a)
    MV.newMVar Map WorkspaceId WWC
    forall k a. Map k a
    M.empty
      MVar (Map WorkspaceId Workspace)
    workspacesRef <- Map WorkspaceId Workspace -> IO (MVar (Map WorkspaceId Workspace))
    forall a. a -> IO (MVar a)
    MV.newMVar Map WorkspaceId Workspace
    forall k a. Map k a
    M.empty
      let context :: WorkspacesContext
    context =
            WorkspacesContext :: MVar (Map WorkspaceId WWC)
    -> MVar (Map WorkspaceId Workspace)
    -> Box
    -> WorkspacesConfig
    -> Context
    -> WorkspacesContext
    WorkspacesContext
            { controllersVar :: MVar (Map WorkspaceId WWC)
    controllersVar = MVar (Map WorkspaceId WWC)
    controllersRef
            , workspacesVar :: MVar (Map WorkspaceId Workspace)
    workspacesVar = MVar (Map WorkspaceId Workspace)
    workspacesRef
            , workspacesWidget :: Box
    workspacesWidget = Box
    cont
            , workspacesConfig :: WorkspacesConfig
    workspacesConfig = WorkspacesConfig
    cfg
            , taffyContext :: Context
    taffyContext = Context
    tContext
            }
      -- This will actually create all the widgets
      WorkspacesIO () -> WorkspacesContext -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesIO ()
    updateAllWorkspaceWidgets WorkspacesContext
    context
      Event -> IO ()
    updateHandler <- WorkspacesContext -> IO (Event -> IO ())
    onWorkspaceUpdate WorkspacesContext
    context
      Set X11Window -> IO ()
    iconHandler <- WorkspacesContext -> IO (Set X11Window -> IO ())
    onIconsChanged WorkspacesContext
    context
      let doUpdate :: Event -> ReaderT Context IO ()
    doUpdate = IO () -> ReaderT Context IO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> ReaderT Context IO ())
    -> (Event -> IO ()) -> Event -> ReaderT Context IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Event -> IO ()
    updateHandler
          handleConfigureEvents :: Event -> ReaderT Context IO ()
    handleConfigureEvents e :: Event
    e@(ConfigureEvent {}) = Event -> ReaderT Context IO ()
    doUpdate Event
    e
          handleConfigureEvents _ = () -> ReaderT Context IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      (workspaceSubscription :: Unique
    workspaceSubscription, iconSubscription :: Unique
    iconSubscription, geometrySubscription :: Unique
    geometrySubscription) <-
        (ReaderT Context IO (Unique, Unique, Unique)
     -> Context -> IO (Unique, Unique, Unique))
    -> Context
    -> ReaderT Context IO (Unique, Unique, Unique)
    -> IO (Unique, Unique, Unique)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT Context IO (Unique, Unique, Unique)
    -> Context -> IO (Unique, Unique, Unique)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    tContext (ReaderT Context IO (Unique, Unique, Unique)
     -> IO (Unique, Unique, Unique))
    -> ReaderT Context IO (Unique, Unique, Unique)
    -> IO (Unique, Unique, Unique)
    forall a b. (a -> b) -> a -> b
    $ (ReaderT Context IO Unique, ReaderT Context IO Unique,
     ReaderT Context IO Unique)
    -> ReaderT Context IO (Unique, Unique, Unique)
    forall a b. SequenceT a b => a -> b
    sequenceT
             ( [String] -> Listener -> Taffy IO Unique
    subscribeToPropertyEvents (WorkspacesConfig -> [String]
    updateEvents WorkspacesConfig
    cfg) (Listener -> ReaderT Context IO Unique)
    -> Listener -> ReaderT Context IO Unique
    forall a b. (a -> b) -> a -> b
    $ Event -> ReaderT Context IO ()
    Listener
    doUpdate
             , [String] -> Listener -> Taffy IO Unique
    subscribeToPropertyEvents [String
    ewmhWMIcon] (IO () -> ReaderT Context IO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> ReaderT Context IO ())
    -> (Event -> IO ()) -> Event -> ReaderT Context IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set X11Window -> IO ()) -> Event -> IO ()
    onIconChanged Set X11Window -> IO ()
    iconHandler)
             , Listener -> Taffy IO Unique
    subscribeToAll Event -> ReaderT Context IO ()
    Listener
    handleConfigureEvents
             )
      let doUnsubscribe :: IO ()
    doUnsubscribe = (ReaderT Context IO () -> Context -> IO ())
    -> Context -> ReaderT Context IO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT Context IO () -> Context -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    tContext (ReaderT Context IO () -> IO ()) -> ReaderT Context IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            (Unique -> ReaderT Context IO ())
    -> [Unique] -> ReaderT Context IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Unique -> ReaderT Context IO ()
    Unique -> Taffy IO ()
    unsubscribe
                  [ Unique
    iconSubscription
                  , Unique
    workspaceSubscription
                  , Unique
    geometrySubscription
                  ]
      SignalHandlerId
    _ <- Box -> IO () -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> IO () -> m SignalHandlerId
    Gtk.onWidgetUnrealize Box
    cont IO ()
    doUnsubscribe
      Box
    _ <- Box -> Text -> IO Box
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Box
    cont "workspaces"
      Box -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget Box
    cont

    updateAllWorkspaceWidgets :: WorkspacesIO ()
    updateAllWorkspaceWidgets :: WorkspacesIO ()
    updateAllWorkspaceWidgets = do
      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG "Updating workspace widgets"

      Map WorkspaceId Workspace
    workspacesMap <- WorkspacesIO (Map WorkspaceId Workspace)
    updateWorkspacesVar
      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> WorkspacesIO ()) -> String -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Workspaces: %s" ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Map WorkspaceId Workspace -> String
    forall a. Show a => a -> String
    show Map WorkspaceId Workspace
    workspacesMap

      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG "Adding and removing widgets"
      WorkspacesIO ()
    updateWorkspaceControllers

      let updateController' :: WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController' idx :: WorkspaceId
    idx controller :: WWC
    controller =
            WorkspacesIO WWC
    -> ControllerConstructor -> Maybe Workspace -> WorkspacesIO WWC
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (WWC -> WorkspacesIO WWC
    forall (m :: * -> *) a. Monad m => a -> m a
    return WWC
    controller)
                  (WWC -> WidgetUpdate -> WorkspacesIO WWC
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget WWC
    controller (WidgetUpdate -> WorkspacesIO WWC)
    -> (Workspace -> WidgetUpdate) -> ControllerConstructor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace -> WidgetUpdate
    WorkspaceUpdate) (Maybe Workspace -> WorkspacesIO WWC)
    -> Maybe Workspace -> WorkspacesIO WWC
    forall a b. (a -> b) -> a -> b
    $
                  WorkspaceId -> Map WorkspaceId Workspace -> Maybe Workspace
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup WorkspaceId
    idx Map WorkspaceId Workspace
    workspacesMap
          logUpdateController :: a -> m ()
    logUpdateController i :: a
    i =
            Priority -> String -> m ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Updating %s workspace widget" ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show a
    i
          updateController :: WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController i :: WorkspaceId
    i cont :: WWC
    cont = WorkspaceId -> WorkspacesIO ()
    forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
    logUpdateController WorkspaceId
    i WorkspacesIO () -> WorkspacesIO WWC -> WorkspacesIO WWC
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                    WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController' WorkspaceId
    i WWC
    cont

      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG "Done updating individual widget"

      (WorkspaceId -> WWC -> WorkspacesIO WWC) -> WorkspacesIO ()
    doWidgetUpdate WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController

      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG "Showing and hiding controllers"
      WorkspacesIO ()
    setControllerWidgetVisibility

    setControllerWidgetVisibility :: WorkspacesIO ()
    setControllerWidgetVisibility :: WorkspacesIO ()
    setControllerWidgetVisibility = do
      ctx :: WorkspacesContext
    ctx@WorkspacesContext
        { workspacesVar :: WorkspacesContext -> MVar (Map WorkspaceId Workspace)
    workspacesVar = MVar (Map WorkspaceId Workspace)
    workspacesRef
        , controllersVar :: WorkspacesContext -> MVar (Map WorkspaceId WWC)
    controllersVar = MVar (Map WorkspaceId WWC)
    controllersRef
        , workspacesConfig :: WorkspacesContext -> WorkspacesConfig
    workspacesConfig = WorkspacesConfig
    cfg
        } <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Map WorkspaceId Workspace
    workspacesMap <- MVar (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId Workspace)
    workspacesRef
        Map WorkspaceId WWC
    controllersMap <- MVar (Map WorkspaceId WWC) -> IO (Map WorkspaceId WWC)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId WWC)
    controllersRef
        [Workspace] -> (Workspace -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map WorkspaceId Workspace -> [Workspace]
    forall k a. Map k a -> [a]
    M.elems Map WorkspaceId Workspace
    workspacesMap) ((Workspace -> IO ()) -> IO ()) -> (Workspace -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ws :: Workspace
    ws ->
          let action :: Widget -> IO ()
    action = if WorkspacesConfig -> Workspace -> Bool
    showWorkspaceFn WorkspacesConfig
    cfg Workspace
    ws
                       then Widget -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShow
                       else Widget -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetHide
          in
            (WWC -> IO Widget) -> Maybe WWC -> IO (Maybe Widget)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((WorkspacesIO Widget -> WorkspacesContext -> IO Widget)
    -> WorkspacesContext -> WorkspacesIO Widget -> IO Widget
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO Widget -> WorkspacesContext -> IO Widget
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO Widget -> IO Widget)
    -> (WWC -> WorkspacesIO Widget) -> WWC -> IO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WWC -> WorkspacesIO Widget
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WorkspacesIO Widget
    getWidget)
                        (WorkspaceId -> Map WorkspaceId WWC -> Maybe WWC
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Workspace -> WorkspaceId
    workspaceIdx Workspace
    ws) Map WorkspaceId WWC
    controllersMap) IO (Maybe Widget) -> (Maybe Widget -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            IO () -> (Widget -> IO ()) -> Maybe Widget -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Widget -> IO ()
    action

    doWidgetUpdate :: (WorkspaceId -> WWC -> WorkspacesIO WWC) -> WorkspacesIO ()
    doWidgetUpdate :: (WorkspaceId -> WWC -> WorkspacesIO WWC) -> WorkspacesIO ()
    doWidgetUpdate updateController :: WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController = do
      c :: WorkspacesContext
    c@WorkspacesContext { controllersVar :: WorkspacesContext -> MVar (Map WorkspaceId WWC)
    controllersVar = MVar (Map WorkspaceId WWC)
    controllersRef } <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ MVar (Map WorkspaceId WWC)
    -> (Map WorkspaceId WWC -> IO (Map WorkspaceId WWC)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar (Map WorkspaceId WWC)
    controllersRef ((Map WorkspaceId WWC -> IO (Map WorkspaceId WWC)) -> IO ())
    -> (Map WorkspaceId WWC -> IO (Map WorkspaceId WWC)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \controllers :: Map WorkspaceId WWC
    controllers -> do
        Priority -> String -> IO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG "Updating controllers ref"
        [(WorkspaceId, WWC)]
    controllersList <-
          ((WorkspaceId, WWC) -> IO (WorkspaceId, WWC))
    -> [(WorkspaceId, WWC)] -> IO [(WorkspaceId, WWC)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM
          (\(idx :: WorkspaceId
    idx, controller :: WWC
    controller) -> do
             WWC
    newController <- WorkspacesIO WWC -> WorkspacesContext -> IO WWC
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (WorkspaceId -> WWC -> WorkspacesIO WWC
    updateController WorkspaceId
    idx WWC
    controller) WorkspacesContext
    c
             (WorkspaceId, WWC) -> IO (WorkspaceId, WWC)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WorkspaceId
    idx, WWC
    newController)) ([(WorkspaceId, WWC)] -> IO [(WorkspaceId, WWC)])
    -> [(WorkspaceId, WWC)] -> IO [(WorkspaceId, WWC)]
    forall a b. (a -> b) -> a -> b
    $
          Map WorkspaceId WWC -> [(WorkspaceId, WWC)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map WorkspaceId WWC
    controllers
        Map WorkspaceId WWC -> IO (Map WorkspaceId WWC)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map WorkspaceId WWC -> IO (Map WorkspaceId WWC))
    -> Map WorkspaceId WWC -> IO (Map WorkspaceId WWC)
    forall a b. (a -> b) -> a -> b
    $ [(WorkspaceId, WWC)] -> Map WorkspaceId WWC
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(WorkspaceId, WWC)]
    controllersList

    updateWorkspaceControllers :: WorkspacesIO ()
    updateWorkspaceControllers :: WorkspacesIO ()
    updateWorkspaceControllers = do
      WorkspacesContext
        { controllersVar :: WorkspacesContext -> MVar (Map WorkspaceId WWC)
    controllersVar = MVar (Map WorkspaceId WWC)
    controllersRef
        , workspacesVar :: WorkspacesContext -> MVar (Map WorkspaceId Workspace)
    workspacesVar = MVar (Map WorkspaceId Workspace)
    workspacesRef
        , workspacesWidget :: WorkspacesContext -> Box
    workspacesWidget = Box
    cont
        , workspacesConfig :: WorkspacesContext -> WorkspacesConfig
    workspacesConfig = WorkspacesConfig
    cfg
        } <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      Map WorkspaceId Workspace
    workspacesMap <- IO (Map WorkspaceId Workspace)
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Map WorkspaceId Workspace)
     -> WorkspacesIO (Map WorkspaceId Workspace))
    -> IO (Map WorkspaceId Workspace)
    -> WorkspacesIO (Map WorkspaceId Workspace)
    forall a b. (a -> b) -> a -> b
    $ MVar (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId Workspace)
    workspacesRef
      Map WorkspaceId WWC
    controllersMap <- IO (Map WorkspaceId WWC)
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Map WorkspaceId WWC)
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> IO (Map WorkspaceId WWC)
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall a b. (a -> b) -> a -> b
    $ MVar (Map WorkspaceId WWC) -> IO (Map WorkspaceId WWC)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId WWC)
    controllersRef

      let newWorkspacesSet :: Set WorkspaceId
    newWorkspacesSet = Map WorkspaceId Workspace -> Set WorkspaceId
    forall k a. Map k a -> Set k
    M.keysSet Map WorkspaceId Workspace
    workspacesMap
          existingWorkspacesSet :: Set WorkspaceId
    existingWorkspacesSet = Map WorkspaceId WWC -> Set WorkspaceId
    forall k a. Map k a -> Set k
    M.keysSet Map WorkspaceId WWC
    controllersMap

      Bool -> WorkspacesIO () -> WorkspacesIO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Set WorkspaceId
    existingWorkspacesSet Set WorkspaceId -> Set WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Set WorkspaceId
    newWorkspacesSet) (WorkspacesIO () -> WorkspacesIO ())
    -> WorkspacesIO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let addWorkspaces :: Set WorkspaceId
    addWorkspaces = Set WorkspaceId -> Set WorkspaceId -> Set WorkspaceId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.difference Set WorkspaceId
    newWorkspacesSet Set WorkspaceId
    existingWorkspacesSet
            removeWorkspaces :: Set WorkspaceId
    removeWorkspaces = Set WorkspaceId -> Set WorkspaceId -> Set WorkspaceId
    forall a. Ord a => Set a -> Set a -> Set a
    Set.difference Set WorkspaceId
    existingWorkspacesSet Set WorkspaceId
    newWorkspacesSet
            builder :: ControllerConstructor
    builder = WorkspacesConfig -> ControllerConstructor
    widgetBuilder WorkspacesConfig
    cfg

        Map WorkspaceId WWC
    _ <- MVar (Map WorkspaceId WWC)
    -> (Map WorkspaceId WWC
        -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall a. MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a
    updateVar MVar (Map WorkspaceId WWC)
    controllersRef ((Map WorkspaceId WWC
      -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> (Map WorkspaceId WWC
        -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall a b. (a -> b) -> a -> b
    $ \controllers :: Map WorkspaceId WWC
    controllers -> do
          let oldRemoved :: Map WorkspaceId WWC
    oldRemoved = (Map WorkspaceId WWC -> WorkspaceId -> Map WorkspaceId WWC)
    -> Map WorkspaceId WWC -> Set WorkspaceId -> Map WorkspaceId WWC
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    F.foldl ((WorkspaceId -> Map WorkspaceId WWC -> Map WorkspaceId WWC)
    -> Map WorkspaceId WWC -> WorkspaceId -> Map WorkspaceId WWC
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspaceId -> Map WorkspaceId WWC -> Map WorkspaceId WWC
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete) Map WorkspaceId WWC
    controllers Set WorkspaceId
    removeWorkspaces
              buildController :: WorkspaceId -> Maybe (WorkspacesIO WWC)
    buildController idx :: WorkspaceId
    idx = ControllerConstructor
    builder ControllerConstructor
    -> Maybe Workspace -> Maybe (WorkspacesIO WWC)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WorkspaceId -> Map WorkspaceId Workspace -> Maybe Workspace
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup WorkspaceId
    idx Map WorkspaceId Workspace
    workspacesMap
              buildAndAddController :: Map WorkspaceId WWC
    -> WorkspaceId
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    buildAndAddController theMap :: Map WorkspaceId WWC
    theMap idx :: WorkspaceId
    idx =
                ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    -> (WorkspacesIO WWC
        -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> Maybe (WorkspacesIO WWC)
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Map WorkspaceId WWC
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map WorkspaceId WWC
    theMap) (WorkspacesIO WWC
    -> (WWC -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Map WorkspaceId WWC
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map WorkspaceId WWC
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> (WWC -> Map WorkspaceId WWC)
    -> WWC
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WWC -> Map WorkspaceId WWC -> Map WorkspaceId WWC)
    -> Map WorkspaceId WWC -> WWC -> Map WorkspaceId WWC
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (WorkspaceId -> WWC -> Map WorkspaceId WWC -> Map WorkspaceId WWC
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert WorkspaceId
    idx) Map WorkspaceId WWC
    theMap)
                        (WorkspaceId -> Maybe (WorkspacesIO WWC)
    buildController WorkspaceId
    idx)
          (Map WorkspaceId WWC
     -> WorkspaceId
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> Map WorkspaceId WWC
    -> [WorkspaceId]
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Map WorkspaceId WWC
    -> WorkspaceId
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    buildAndAddController Map WorkspaceId WWC
    oldRemoved ([WorkspaceId]
     -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC))
    -> [WorkspaceId]
    -> ReaderT WorkspacesContext IO (Map WorkspaceId WWC)
    forall a b. (a -> b) -> a -> b
    $ Set WorkspaceId -> [WorkspaceId]
    forall a. Set a -> [a]
    Set.toList Set WorkspaceId
    addWorkspaces
        -- Clear the container and repopulate it
        IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Box -> (Widget -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsContainer a) =>
    a -> (Widget -> IO ()) -> m ()
    Gtk.containerForeach Box
    cont (Box -> Widget -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerRemove Box
    cont)
        WorkspacesIO ()
    addWidgetsToTopLevel

    rateLimitFn
      :: forall req resp.
         WorkspacesContext
      -> (req -> IO resp)
      -> ResultsCombiner req resp
      -> IO (req -> IO resp)
    rateLimitFn :: WorkspacesContext
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    rateLimitFn context :: WorkspacesContext
    context =
      let limit :: Integer
    limit = (WorkspacesConfig -> Integer
    updateRateLimitMicroseconds (WorkspacesConfig -> Integer) -> WorkspacesConfig -> Integer
    forall a b. (a -> b) -> a -> b
    $ WorkspacesContext -> WorkspacesConfig
    workspacesConfig WorkspacesContext
    context)
          rate :: Microsecond
    rate = Integer -> Microsecond
    forall a. TimeUnit a => Integer -> a
    fromMicroseconds Integer
    limit :: Microsecond in
      RateLimit Microsecond
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    forall req resp t.
    TimeUnit t =>
    RateLimit t
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    generateRateLimitedFunction (RateLimit Microsecond
     -> (req -> IO resp)
     -> ResultsCombiner req resp
     -> IO (req -> IO resp))
    -> RateLimit Microsecond
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    forall a b. (a -> b) -> a -> b
    $ Microsecond -> RateLimit Microsecond
    forall a. a -> RateLimit a
    PerInvocation Microsecond
    rate

    onWorkspaceUpdate :: WorkspacesContext -> IO (Event -> IO ())
    onWorkspaceUpdate :: WorkspacesContext -> IO (Event -> IO ())
    onWorkspaceUpdate context :: WorkspacesContext
    context = do
      Event -> IO ()
    rateLimited <- WorkspacesContext
    -> (Event -> IO ())
    -> ResultsCombiner Event ()
    -> IO (Event -> IO ())
    forall req resp.
    WorkspacesContext
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    rateLimitFn WorkspacesContext
    context Event -> IO ()
    doUpdate ResultsCombiner Event ()
    forall p a b. p -> a -> Maybe (a, b -> ((), ()))
    combineRequests
      let withLog :: Event -> IO ()
    withLog event :: Event
    event = do
            case Event
    event of
              PropertyEvent _ _ _ _ _ atom :: X11Window
    atom _ _ ->
                Priority -> String -> IO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Event %s" ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ X11Window -> String
    forall a. Show a => a -> String
    show X11Window
    atom
              _ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ Event -> IO ()
    rateLimited Event
    event
      (Event -> IO ()) -> IO (Event -> IO ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return Event -> IO ()
    withLog
      where
        combineRequests :: p -> a -> Maybe (a, b -> ((), ()))
    combineRequests _ b :: a
    b = (a, b -> ((), ())) -> Maybe (a, b -> ((), ()))
    forall a. a -> Maybe a
    Just (a
    b, ((), ()) -> b -> ((), ())
    forall a b. a -> b -> a
    const ((), ()))
        doUpdate :: Event -> IO ()
    doUpdate _ = IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WorkspacesIO () -> WorkspacesContext -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesIO ()
    updateAllWorkspaceWidgets WorkspacesContext
    context

    onIconChanged :: (Set.Set X11Window -> IO ()) -> Event -> IO ()
    onIconChanged :: (Set X11Window -> IO ()) -> Event -> IO ()
    onIconChanged handler :: Set X11Window -> IO ()
    handler event :: Event
    event =
      case Event
    event of
        PropertyEvent { ev_window :: Event -> X11Window
    ev_window = X11Window
    wid } -> do
          Priority -> String -> IO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG  (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Icon changed event %s" ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ X11Window -> String
    forall a. Show a => a -> String
    show X11Window
    wid
          Set X11Window -> IO ()
    handler (Set X11Window -> IO ()) -> Set X11Window -> IO ()
    forall a b. (a -> b) -> a -> b
    $ X11Window -> Set X11Window
    forall a. a -> Set a
    Set.singleton X11Window
    wid
        _ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    onIconsChanged :: WorkspacesContext -> IO (Set.Set X11Window -> IO ())
    onIconsChanged :: WorkspacesContext -> IO (Set X11Window -> IO ())
    onIconsChanged context :: WorkspacesContext
    context = WorkspacesContext
    -> (Set X11Window -> IO ())
    -> ResultsCombiner (Set X11Window) ()
    -> IO (Set X11Window -> IO ())
    forall req resp.
    WorkspacesContext
    -> (req -> IO resp)
    -> ResultsCombiner req resp
    -> IO (req -> IO resp)
    rateLimitFn WorkspacesContext
    context Set X11Window -> IO ()
    onIconsChanged' ResultsCombiner (Set X11Window) ()
    forall a b. Ord a => Set a -> Set a -> Maybe (Set a, b -> ((), ()))
    combineRequests
      where
        combineRequests :: Set a -> Set a -> Maybe (Set a, b -> ((), ()))
    combineRequests windows1 :: Set a
    windows1 windows2 :: Set a
    windows2 =
          (Set a, b -> ((), ())) -> Maybe (Set a, b -> ((), ()))
    forall a. a -> Maybe a
    Just (Set a -> Set a -> Set a
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Set a
    windows1 Set a
    windows2, ((), ()) -> b -> ((), ())
    forall a b. a -> b -> a
    const ((), ()))
        onIconsChanged' :: Set X11Window -> IO ()
    onIconsChanged' wids :: Set X11Window
    wids = do
          Priority -> String -> IO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Icon update execute %s" ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Set X11Window -> String
    forall a. Show a => a -> String
    show Set X11Window
    wids
          IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (WorkspacesIO () -> WorkspacesContext -> IO ())
    -> WorkspacesContext -> WorkspacesIO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO () -> WorkspacesContext -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    context (WorkspacesIO () -> IO ()) -> WorkspacesIO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            (WorkspaceId -> WWC -> WorkspacesIO WWC) -> WorkspacesIO ()
    doWidgetUpdate
              (\idx :: WorkspaceId
    idx c :: WWC
    c ->
                 Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Updating %s icons." ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ WorkspaceId -> String
    forall a. Show a => a -> String
    show WorkspaceId
    idx) WorkspacesIO () -> WorkspacesIO WWC -> WorkspacesIO WWC
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                 WWC -> WidgetUpdate -> WorkspacesIO WWC
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget WWC
    c ([X11Window] -> WidgetUpdate
    IconUpdate ([X11Window] -> WidgetUpdate) -> [X11Window] -> WidgetUpdate
    forall a b. (a -> b) -> a -> b
    $ Set X11Window -> [X11Window]
    forall a. Set a -> [a]
    Set.toList Set X11Window
    wids))

    data WorkspaceContentsController = WorkspaceContentsController
      { WorkspaceContentsController -> Widget
    containerWidget :: Gtk.Widget
      , WorkspaceContentsController -> [WWC]
    contentsControllers :: [WWC]
      }

    buildContentsController :: [ControllerConstructor] -> ControllerConstructor
    buildContentsController :: [ControllerConstructor] -> ControllerConstructor
    buildContentsController constructors :: [ControllerConstructor]
    constructors ws :: Workspace
    ws = do
      [WWC]
    controllers <- (ControllerConstructor -> WorkspacesIO WWC)
    -> [ControllerConstructor] -> ReaderT WorkspacesContext IO [WWC]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ParentControllerConstructor
    forall a b. (a -> b) -> a -> b
    $ Workspace
    ws) [ControllerConstructor]
    constructors
      WorkspacesContext
    ctx <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      WorkspaceContentsController
    tempController <- IO WorkspaceContentsController
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO WorkspaceContentsController
     -> ReaderT WorkspacesContext IO WorkspaceContentsController)
    -> IO WorkspaceContentsController
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    forall a b. (a -> b) -> a -> b
    $ do
        Box
    cons <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal 0
        (WWC -> IO ()) -> [WWC] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((WorkspacesIO Widget -> WorkspacesContext -> IO Widget)
    -> WorkspacesContext -> WorkspacesIO Widget -> IO Widget
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO Widget -> WorkspacesContext -> IO Widget
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO Widget -> IO Widget)
    -> (WWC -> WorkspacesIO Widget) -> WWC -> IO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WWC -> WorkspacesIO Widget
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WorkspacesIO Widget
    getWidget (WWC -> IO Widget) -> (Widget -> IO ()) -> WWC -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Box -> Widget -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Box
    cons) [WWC]
    controllers
        Widget
    outerBox <- Box -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget Box
    cons IO Widget -> (Widget -> IO Widget) -> IO Widget
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Widget -> IO Widget
    forall (m :: * -> *). MonadIO m => Widget -> m Widget
    buildPadBox
        Box
    _ <- Box -> Text -> IO Box
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Box
    cons "contents"
        Widget
    widget <- Widget -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget Widget
    outerBox
        WorkspaceContentsController -> IO WorkspaceContentsController
    forall (m :: * -> *) a. Monad m => a -> m a
    return
          WorkspaceContentsController :: Widget -> [WWC] -> WorkspaceContentsController
    WorkspaceContentsController
          { containerWidget :: Widget
    containerWidget = Widget
    widget
          , contentsControllers :: [WWC]
    contentsControllers = [WWC]
    controllers
          }
      WorkspaceContentsController -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC (WorkspaceContentsController -> WWC)
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    -> WorkspacesIO WWC
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WorkspaceContentsController
    -> WidgetUpdate
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget WorkspaceContentsController
    tempController (Workspace -> WidgetUpdate
    WorkspaceUpdate Workspace
    ws)

    defaultBuildContentsController :: ControllerConstructor
    defaultBuildContentsController :: ControllerConstructor
    defaultBuildContentsController =
      [ControllerConstructor] -> ControllerConstructor
    buildContentsController [ControllerConstructor
    buildLabelController, ControllerConstructor
    buildIconController]

    instance WorkspaceWidgetController WorkspaceContentsController where
      getWidget :: WorkspaceContentsController -> WorkspacesIO Widget
    getWidget = Widget -> WorkspacesIO Widget
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Widget -> WorkspacesIO Widget)
    -> (WorkspaceContentsController -> Widget)
    -> WorkspaceContentsController
    -> WorkspacesIO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WorkspaceContentsController -> Widget
    containerWidget
      updateWidget :: WorkspaceContentsController
    -> WidgetUpdate
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    updateWidget cc :: WorkspaceContentsController
    cc update :: WidgetUpdate
    update = do
        WorkspacesContext {} <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        case WidgetUpdate
    update of
          WorkspaceUpdate newWorkspace :: Workspace
    newWorkspace ->
            IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Workspace -> Widget -> IO ()
    forall (m :: * -> *) a.
    (MonadIO m, IsWidget a) =>
    Workspace -> a -> m ()
    setWorkspaceWidgetStatusClass Workspace
    newWorkspace (Widget -> IO ()) -> Widget -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WorkspaceContentsController -> Widget
    containerWidget WorkspaceContentsController
    cc
          _ -> () -> WorkspacesIO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        [WWC]
    newControllers <- (WWC -> WorkspacesIO WWC)
    -> [WWC] -> ReaderT WorkspacesContext IO [WWC]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WWC -> WidgetUpdate -> WorkspacesIO WWC
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    `updateWidget` WidgetUpdate
    update) ([WWC] -> ReaderT WorkspacesContext IO [WWC])
    -> [WWC] -> ReaderT WorkspacesContext IO [WWC]
    forall a b. (a -> b) -> a -> b
    $ WorkspaceContentsController -> [WWC]
    contentsControllers WorkspaceContentsController
    cc
        WorkspaceContentsController
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceContentsController
    cc {contentsControllers :: [WWC]
    contentsControllers = [WWC]
    newControllers}
      updateWidgetX11 :: WorkspaceContentsController
    -> WidgetUpdate
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    updateWidgetX11 cc :: WorkspaceContentsController
    cc update :: WidgetUpdate
    update = do
        [WWC]
    newControllers <- (WWC -> WorkspacesIO WWC)
    -> [WWC] -> ReaderT WorkspacesContext IO [WWC]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WWC -> WidgetUpdate -> WorkspacesIO WWC
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    `updateWidgetX11` WidgetUpdate
    update) ([WWC] -> ReaderT WorkspacesContext IO [WWC])
    -> [WWC] -> ReaderT WorkspacesContext IO [WWC]
    forall a b. (a -> b) -> a -> b
    $ WorkspaceContentsController -> [WWC]
    contentsControllers WorkspaceContentsController
    cc
        WorkspaceContentsController
    -> ReaderT WorkspacesContext IO WorkspaceContentsController
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceContentsController
    cc {contentsControllers :: [WWC]
    contentsControllers = [WWC]
    newControllers}

    newtype LabelController = LabelController { LabelController -> Label
    label :: Gtk.Label }

    buildLabelController :: ControllerConstructor
    buildLabelController :: ControllerConstructor
    buildLabelController ws :: Workspace
    ws = do
      LabelController
    tempController <- IO LabelController -> ReaderT WorkspacesContext IO LabelController
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO LabelController
     -> ReaderT WorkspacesContext IO LabelController)
    -> IO LabelController
    -> ReaderT WorkspacesContext IO LabelController
    forall a b. (a -> b) -> a -> b
    $ do
        Label
    lbl <- Maybe Text -> IO Label
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Label
    Gtk.labelNew Maybe Text
    forall a. Maybe a
    Nothing
        Label
    _ <- Label -> Text -> IO Label
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Label
    lbl "workspace-label"
        LabelController -> IO LabelController
    forall (m :: * -> *) a. Monad m => a -> m a
    return LabelController :: Label -> LabelController
    LabelController { label :: Label
    label = Label
    lbl }
      LabelController -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC (LabelController -> WWC)
    -> ReaderT WorkspacesContext IO LabelController -> WorkspacesIO WWC
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LabelController
    -> WidgetUpdate -> ReaderT WorkspacesContext IO LabelController
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget LabelController
    tempController (Workspace -> WidgetUpdate
    WorkspaceUpdate Workspace
    ws)

    instance WorkspaceWidgetController LabelController where
      getWidget :: LabelController -> WorkspacesIO Widget
    getWidget = IO Widget -> WorkspacesIO Widget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Widget -> WorkspacesIO Widget)
    -> (LabelController -> IO Widget)
    -> LabelController
    -> WorkspacesIO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Label -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget (Label -> IO Widget)
    -> (LabelController -> Label) -> LabelController -> IO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LabelController -> Label
    label
      updateWidget :: LabelController
    -> WidgetUpdate -> ReaderT WorkspacesContext IO LabelController
    updateWidget lc :: LabelController
    lc (WorkspaceUpdate newWorkspace :: Workspace
    newWorkspace) = do
        WorkspacesContext { workspacesConfig :: WorkspacesContext -> WorkspacesConfig
    workspacesConfig = WorkspacesConfig
    cfg } <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        String
    labelText <- WorkspacesConfig -> Workspace -> WorkspacesIO String
    labelSetter WorkspacesConfig
    cfg Workspace
    newWorkspace
        IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ do
          Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Text -> m ()
    Gtk.labelSetMarkup (LabelController -> Label
    label LabelController
    lc) (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    labelText
          Workspace -> Label -> IO ()
    forall (m :: * -> *) a.
    (MonadIO m, IsWidget a) =>
    Workspace -> a -> m ()
    setWorkspaceWidgetStatusClass Workspace
    newWorkspace (Label -> IO ()) -> Label -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LabelController -> Label
    label LabelController
    lc
        LabelController -> ReaderT WorkspacesContext IO LabelController
    forall (m :: * -> *) a. Monad m => a -> m a
    return LabelController
    lc
      updateWidget lc :: LabelController
    lc _ = LabelController -> ReaderT WorkspacesContext IO LabelController
    forall (m :: * -> *) a. Monad m => a -> m a
    return LabelController
    lc

    data IconWidget = IconWidget
      { IconWidget -> EventBox
    iconContainer :: Gtk.EventBox
      , IconWidget -> Image
    iconImage :: Gtk.Image
      , IconWidget -> MVar (Maybe WindowData)
    iconWindow :: MV.MVar (Maybe WindowData)
      , IconWidget -> IO ()
    iconForceUpdate :: IO ()
      }

    getPixbufForIconWidget :: Bool
                           -> MV.MVar (Maybe WindowData)
                           -> Int32
                           -> WorkspacesIO (Maybe Gdk.Pixbuf)
    getPixbufForIconWidget :: Bool
    -> MVar (Maybe WindowData) -> Int32 -> WorkspacesIO (Maybe Pixbuf)
    getPixbufForIconWidget transparentOnNone :: Bool
    transparentOnNone dataVar :: MVar (Maybe WindowData)
    dataVar size :: Int32
    size = do
      WorkspacesContext
    ctx <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      let tContext :: Context
    tContext = WorkspacesContext -> Context
    taffyContext WorkspacesContext
    ctx
          getPBFromData :: WindowIconPixbufGetter
    getPBFromData = WorkspacesConfig -> WindowIconPixbufGetter
    getWindowIconPixbuf (WorkspacesConfig -> WindowIconPixbufGetter)
    -> WorkspacesConfig -> WindowIconPixbufGetter
    forall a b. (a -> b) -> a -> b
    $ WorkspacesContext -> WorkspacesConfig
    workspacesConfig WorkspacesContext
    ctx
          getPB' :: ReaderT Context IO (Maybe Pixbuf)
    getPB' = MaybeT (ReaderT Context IO) Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (ReaderT Context IO) Pixbuf
     -> ReaderT Context IO (Maybe Pixbuf))
    -> MaybeT (ReaderT Context IO) Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $
                   ReaderT Context IO (Maybe WindowData)
    -> MaybeT (ReaderT Context IO) WindowData
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe WindowData) -> ReaderT Context IO (Maybe WindowData)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe WindowData) -> ReaderT Context IO (Maybe WindowData))
    -> IO (Maybe WindowData) -> ReaderT Context IO (Maybe WindowData)
    forall a b. (a -> b) -> a -> b
    $ MVar (Maybe WindowData) -> IO (Maybe WindowData)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Maybe WindowData)
    dataVar) MaybeT (ReaderT Context IO) WindowData
    -> (WindowData -> MaybeT (ReaderT Context IO) Pixbuf)
    -> MaybeT (ReaderT Context IO) Pixbuf
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT Context IO (Maybe Pixbuf)
    -> MaybeT (ReaderT Context IO) Pixbuf
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (ReaderT Context IO (Maybe Pixbuf)
     -> MaybeT (ReaderT Context IO) Pixbuf)
    -> (WindowData -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowData
    -> MaybeT (ReaderT Context IO) Pixbuf
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowIconPixbufGetter
    getPBFromData Int32
    size
          getPB :: ReaderT Context IO (Maybe Pixbuf)
    getPB = if Bool
    transparentOnNone
                  then ReaderT Context IO (Maybe Pixbuf)
    -> ReaderT Context IO (Maybe Pixbuf)
    -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) a.
    Monad m =>
    m (Maybe a) -> m (Maybe a) -> m (Maybe a)
    maybeTCombine ReaderT Context IO (Maybe Pixbuf)
    getPB' (Pixbuf -> Maybe Pixbuf
    forall a. a -> Maybe a
    Just (Pixbuf -> Maybe Pixbuf)
    -> ReaderT Context IO Pixbuf -> ReaderT Context IO (Maybe Pixbuf)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int32 -> Word32 -> ReaderT Context IO Pixbuf
    forall (m :: * -> *). MonadIO m => Int32 -> Word32 -> m Pixbuf
    pixBufFromColor Int32
    size 0)
                  else ReaderT Context IO (Maybe Pixbuf)
    getPB'
      IO (Maybe Pixbuf) -> WorkspacesIO (Maybe Pixbuf)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> WorkspacesIO (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> WorkspacesIO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ ReaderT Context IO (Maybe Pixbuf) -> Context -> IO (Maybe Pixbuf)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT Context IO (Maybe Pixbuf)
    getPB Context
    tContext

    buildIconWidget :: Bool -> Workspace -> WorkspacesIO IconWidget
    buildIconWidget :: Bool -> Workspace -> WorkspacesIO IconWidget
    buildIconWidget transparentOnNone :: Bool
    transparentOnNone ws :: Workspace
    ws = do
      WorkspacesContext
    ctx <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      IO IconWidget -> WorkspacesIO IconWidget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO IconWidget -> WorkspacesIO IconWidget)
    -> IO IconWidget -> WorkspacesIO IconWidget
    forall a b. (a -> b) -> a -> b
    $ do
        MVar (Maybe WindowData)
    windowVar <- Maybe WindowData -> IO (MVar (Maybe WindowData))
    forall a. a -> IO (MVar a)
    MV.newMVar Maybe WindowData
    forall a. Maybe a
    Nothing
        Image
    img <- IO Image
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
    Gtk.imageNew
        IO ()
    refreshImage <-
          Image -> (Int32 -> IO (Maybe Pixbuf)) -> Orientation -> IO (IO ())
    forall (m :: * -> *).
    MonadIO m =>
    Image -> (Int32 -> IO (Maybe Pixbuf)) -> Orientation -> m (IO ())
    autoSizeImage Image
    img
            ((WorkspacesIO (Maybe Pixbuf)
     -> WorkspacesContext -> IO (Maybe Pixbuf))
    -> WorkspacesContext
    -> WorkspacesIO (Maybe Pixbuf)
    -> IO (Maybe Pixbuf)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO (Maybe Pixbuf)
    -> WorkspacesContext -> IO (Maybe Pixbuf)
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO (Maybe Pixbuf) -> IO (Maybe Pixbuf))
    -> (Int32 -> WorkspacesIO (Maybe Pixbuf))
    -> Int32
    -> IO (Maybe Pixbuf)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool
    -> MVar (Maybe WindowData) -> Int32 -> WorkspacesIO (Maybe Pixbuf)
    getPixbufForIconWidget Bool
    transparentOnNone MVar (Maybe WindowData)
    windowVar)
            Orientation
    Gtk.OrientationHorizontal
        EventBox
    ebox <- IO EventBox
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
    Gtk.eventBoxNew
        Image
    _ <- Image -> Text -> IO Image
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Image
    img "window-icon"
        EventBox
    _ <- EventBox -> Text -> IO EventBox
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI EventBox
    ebox "window-icon-container"
        EventBox -> Image -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd EventBox
    ebox Image
    img
        SignalHandlerId
    _ <-
          EventBox -> WidgetButtonPressEventCallback -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> WidgetButtonPressEventCallback -> m SignalHandlerId
    Gtk.onWidgetButtonPressEvent EventBox
    ebox (WidgetButtonPressEventCallback -> IO SignalHandlerId)
    -> WidgetButtonPressEventCallback -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $
          IO Bool -> WidgetButtonPressEventCallback
    forall a b. a -> b -> a
    const (IO Bool -> WidgetButtonPressEventCallback)
    -> IO Bool -> WidgetButtonPressEventCallback
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe WindowData
    info <- MVar (Maybe WindowData) -> IO (Maybe WindowData)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Maybe WindowData)
    windowVar
            case Maybe WindowData
    info of
              Just updatedInfo :: WindowData
    updatedInfo ->
                (WorkspacesIO () -> WorkspacesContext -> IO ())
    -> WorkspacesContext -> WorkspacesIO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO () -> WorkspacesContext -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO () -> IO ()) -> WorkspacesIO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                () -> X11Property () -> WorkspacesIO ()
    forall a. a -> X11Property a -> WorkspacesIO a
    liftX11Def () (X11Property () -> WorkspacesIO ())
    -> X11Property () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ X11Window -> X11Property ()
    focusWindow (X11Window -> X11Property ()) -> X11Window -> X11Property ()
    forall a b. (a -> b) -> a -> b
    $ WindowData -> X11Window
    windowId WindowData
    updatedInfo
              _ -> IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ WorkspacesContext -> WorkspaceId -> IO Bool
    forall (m :: * -> *).
    MonadIO m =>
    WorkspacesContext -> WorkspaceId -> m Bool
    switch WorkspacesContext
    ctx (Workspace -> WorkspaceId
    workspaceIdx Workspace
    ws)
            Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        IconWidget -> IO IconWidget
    forall (m :: * -> *) a. Monad m => a -> m a
    return
          IconWidget :: EventBox -> Image -> MVar (Maybe WindowData) -> IO () -> IconWidget
    IconWidget
          { iconContainer :: EventBox
    iconContainer = EventBox
    ebox
          , iconImage :: Image
    iconImage = Image
    img
          , iconWindow :: MVar (Maybe WindowData)
    iconWindow = MVar (Maybe WindowData)
    windowVar
          , iconForceUpdate :: IO ()
    iconForceUpdate = IO ()
    refreshImage
          }

    data IconController = IconController
      { IconController -> Box
    iconsContainer :: Gtk.Box
      , IconController -> [IconWidget]
    iconImages :: [IconWidget]
      , IconController -> Workspace
    iconWorkspace :: Workspace
      }

    buildIconController :: ControllerConstructor
    buildIconController :: ControllerConstructor
    buildIconController ws :: Workspace
    ws = do
      IconController
    tempController <-
        IO IconController -> ReaderT WorkspacesContext IO IconController
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO IconController -> ReaderT WorkspacesContext IO IconController)
    -> IO IconController -> ReaderT WorkspacesContext IO IconController
    forall a b. (a -> b) -> a -> b
    $ do
          Box
    hbox <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal 0
          IconController -> IO IconController
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            IconController :: Box -> [IconWidget] -> Workspace -> IconController
    IconController
            {iconsContainer :: Box
    iconsContainer = Box
    hbox, iconImages :: [IconWidget]
    iconImages = [], iconWorkspace :: Workspace
    iconWorkspace = Workspace
    ws}
      IconController -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC (IconController -> WWC)
    -> ReaderT WorkspacesContext IO IconController -> WorkspacesIO WWC
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IconController
    -> WidgetUpdate -> ReaderT WorkspacesContext IO IconController
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget IconController
    tempController (Workspace -> WidgetUpdate
    WorkspaceUpdate Workspace
    ws)

    instance WorkspaceWidgetController IconController where
      getWidget :: IconController -> WorkspacesIO Widget
    getWidget = IO Widget -> WorkspacesIO Widget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Widget -> WorkspacesIO Widget)
    -> (IconController -> IO Widget)
    -> IconController
    -> WorkspacesIO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Box -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget (Box -> IO Widget)
    -> (IconController -> Box) -> IconController -> IO Widget
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IconController -> Box
    iconsContainer
      updateWidget :: IconController
    -> WidgetUpdate -> ReaderT WorkspacesContext IO IconController
    updateWidget ic :: IconController
    ic (WorkspaceUpdate newWorkspace :: Workspace
    newWorkspace) = do
        [IconWidget]
    newImages <- IconController -> Workspace -> WorkspacesIO [IconWidget]
    updateImages IconController
    ic Workspace
    newWorkspace
        IconController -> ReaderT WorkspacesContext IO IconController
    forall (m :: * -> *) a. Monad m => a -> m a
    return IconController
    ic { iconImages :: [IconWidget]
    iconImages = [IconWidget]
    newImages, iconWorkspace :: Workspace
    iconWorkspace = Workspace
    newWorkspace }
      updateWidget ic :: IconController
    ic (IconUpdate updatedIcons :: [X11Window]
    updatedIcons) =
        IconController -> [X11Window] -> WorkspacesIO ()
    updateWindowIconsById IconController
    ic [X11Window]
    updatedIcons WorkspacesIO ()
    -> ReaderT WorkspacesContext IO IconController
    -> ReaderT WorkspacesContext IO IconController
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IconController -> ReaderT WorkspacesContext IO IconController
    forall (m :: * -> *) a. Monad m => a -> m a
    return IconController
    ic

    updateWindowIconsById ::
      IconController -> [X11Window] -> WorkspacesIO ()
    updateWindowIconsById :: IconController -> [X11Window] -> WorkspacesIO ()
    updateWindowIconsById ic :: IconController
    ic windowIds :: [X11Window]
    windowIds =
      (IconWidget -> WorkspacesIO ()) -> [IconWidget] -> WorkspacesIO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ IconWidget -> WorkspacesIO ()
    maybeUpdateWindowIcon ([IconWidget] -> WorkspacesIO ())
    -> [IconWidget] -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ IconController -> [IconWidget]
    iconImages IconController
    ic
      where
        maybeUpdateWindowIcon :: IconWidget -> WorkspacesIO ()
    maybeUpdateWindowIcon widget :: IconWidget
    widget =
          do
            Maybe WindowData
    info <- IO (Maybe WindowData)
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe WindowData)
     -> ReaderT WorkspacesContext IO (Maybe WindowData))
    -> IO (Maybe WindowData)
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall a b. (a -> b) -> a -> b
    $ MVar (Maybe WindowData) -> IO (Maybe WindowData)
    forall a. MVar a -> IO a
    MV.readMVar (MVar (Maybe WindowData) -> IO (Maybe WindowData))
    -> MVar (Maybe WindowData) -> IO (Maybe WindowData)
    forall a b. (a -> b) -> a -> b
    $ IconWidget -> MVar (Maybe WindowData)
    iconWindow IconWidget
    widget
            Bool -> WorkspacesIO () -> WorkspacesIO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> (WindowData -> Bool) -> Maybe WindowData -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False ((X11Window -> [X11Window] -> Bool)
    -> [X11Window] -> X11Window -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip X11Window -> [X11Window] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem [X11Window]
    windowIds (X11Window -> Bool)
    -> (WindowData -> X11Window) -> WindowData -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowData -> X11Window
    windowId) Maybe WindowData
    info) (WorkspacesIO () -> WorkspacesIO ())
    -> WorkspacesIO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $
             IconController -> IconWidget -> Maybe WindowData -> WorkspacesIO ()
    updateIconWidget IconController
    ic IconWidget
    widget Maybe WindowData
    info

    scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter
    scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter
    scaledWindowIconPixbufGetter getter :: WindowIconPixbufGetter
    getter size :: Int32
    size =
      WindowIconPixbufGetter
    getter Int32
    size (WindowData -> ReaderT Context IO (Maybe Pixbuf))
    -> (Maybe Pixbuf -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowData
    -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
      IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf))
    -> (Maybe Pixbuf -> IO (Maybe Pixbuf))
    -> Maybe Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pixbuf -> IO Pixbuf) -> Maybe Pixbuf -> IO (Maybe Pixbuf)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Int32 -> Orientation -> Pixbuf -> IO Pixbuf
    scalePixbufToSize Int32
    size Orientation
    Gtk.OrientationHorizontal)

    constantScaleWindowIconPixbufGetter ::
      Int32 -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    constantScaleWindowIconPixbufGetter :: Int32 -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    constantScaleWindowIconPixbufGetter constantSize :: Int32
    constantSize getter :: WindowIconPixbufGetter
    getter =
      (WindowData -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowIconPixbufGetter
    forall a b. a -> b -> a
    const ((WindowData -> ReaderT Context IO (Maybe Pixbuf))
     -> WindowIconPixbufGetter)
    -> (WindowData -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowIconPixbufGetter
    forall a b. (a -> b) -> a -> b
    $ WindowIconPixbufGetter -> WindowIconPixbufGetter
    scaledWindowIconPixbufGetter WindowIconPixbufGetter
    getter Int32
    constantSize

    getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter
    getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter
    getWindowIconPixbufFromEWMH size :: Int32
    size windowData :: WindowData
    windowData =
      Maybe Pixbuf
    -> X11Property (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall a. a -> X11Property a -> TaffyIO a
    runX11Def Maybe Pixbuf
    forall a. Maybe a
    Nothing (Int32 -> X11Window -> X11Property (Maybe Pixbuf)
    getIconPixBufFromEWMH Int32
    size (X11Window -> X11Property (Maybe Pixbuf))
    -> X11Window -> X11Property (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ WindowData -> X11Window
    windowId WindowData
    windowData)

    getWindowIconPixbufFromClass :: WindowIconPixbufGetter
    getWindowIconPixbufFromClass :: WindowIconPixbufGetter
    getWindowIconPixbufFromClass size :: Int32
    size windowData :: WindowData
    windowData =
      IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ Int32 -> String -> IO (Maybe Pixbuf)
    getWindowIconFromClasses Int32
    size (WindowData -> String
    windowClass WindowData
    windowData)

    getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter
    getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter
    getWindowIconPixbufFromDesktopEntry size :: Int32
    size windowData :: WindowData
    windowData =
      Int32 -> String -> ReaderT Context IO (Maybe Pixbuf)
    getWindowIconFromDesktopEntryByClasses Int32
    size (WindowData -> String
    windowClass WindowData
    windowData)

    getWindowIconPixbufFromChrome :: WindowIconPixbufGetter
    getWindowIconPixbufFromChrome :: WindowIconPixbufGetter
    getWindowIconPixbufFromChrome _ windowData :: WindowData
    windowData =
      X11Window -> ReaderT Context IO (Maybe Pixbuf)
    getPixBufFromChromeData (X11Window -> ReaderT Context IO (Maybe Pixbuf))
    -> X11Window -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ WindowData -> X11Window
    windowId WindowData
    windowData

    defaultGetWindowIconPixbuf :: WindowIconPixbufGetter
    defaultGetWindowIconPixbuf :: WindowIconPixbufGetter
    defaultGetWindowIconPixbuf =
      WindowIconPixbufGetter -> WindowIconPixbufGetter
    scaledWindowIconPixbufGetter WindowIconPixbufGetter
    unscaledDefaultGetWindowIconPixbuf

    unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter
    unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter
    unscaledDefaultGetWindowIconPixbuf =
      WindowIconPixbufGetter
    getWindowIconPixbufFromDesktopEntry WindowIconPixbufGetter
    -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    forall (m :: * -> *) t t1 a.
    Monad m =>
    (t -> t1 -> m (Maybe a))
    -> (t -> t1 -> m (Maybe a)) -> t -> t1 -> m (Maybe a)
    <|||>
      WindowIconPixbufGetter
    getWindowIconPixbufFromClass WindowIconPixbufGetter
    -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    forall (m :: * -> *) t t1 a.
    Monad m =>
    (t -> t1 -> m (Maybe a))
    -> (t -> t1 -> m (Maybe a)) -> t -> t1 -> m (Maybe a)
    <|||>
      WindowIconPixbufGetter
    getWindowIconPixbufFromEWMH

    addCustomIconsToDefaultWithFallbackByPath
      :: (WindowData -> Maybe FilePath)
      -> FilePath
      -> WindowIconPixbufGetter
    addCustomIconsToDefaultWithFallbackByPath :: (WindowData -> Maybe String) -> String -> WindowIconPixbufGetter
    addCustomIconsToDefaultWithFallbackByPath getCustomIconPath :: WindowData -> Maybe String
    getCustomIconPath fallbackPath :: String
    fallbackPath =
      (WindowData -> Maybe String)
    -> (Int32 -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowIconPixbufGetter
    -> WindowIconPixbufGetter
    addCustomIconsAndFallback
        WindowData -> Maybe String
    getCustomIconPath
        (ReaderT Context IO (Maybe Pixbuf)
    -> Int32 -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. a -> b -> a
    const (ReaderT Context IO (Maybe Pixbuf)
     -> Int32 -> ReaderT Context IO (Maybe Pixbuf))
    -> ReaderT Context IO (Maybe Pixbuf)
    -> Int32
    -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Maybe Pixbuf)
    getPixbufFromFilePath String
    fallbackPath)
        WindowIconPixbufGetter
    unscaledDefaultGetWindowIconPixbuf

    addCustomIconsAndFallback
      :: (WindowData -> Maybe FilePath)
      -> (Int32 -> TaffyIO (Maybe Gdk.Pixbuf))
      -> WindowIconPixbufGetter
      -> WindowIconPixbufGetter
    addCustomIconsAndFallback :: (WindowData -> Maybe String)
    -> (Int32 -> ReaderT Context IO (Maybe Pixbuf))
    -> WindowIconPixbufGetter
    -> WindowIconPixbufGetter
    addCustomIconsAndFallback getCustomIconPath :: WindowData -> Maybe String
    getCustomIconPath fallback :: Int32 -> ReaderT Context IO (Maybe Pixbuf)
    fallback defaultGetter :: WindowIconPixbufGetter
    defaultGetter =
      WindowIconPixbufGetter -> WindowIconPixbufGetter
    scaledWindowIconPixbufGetter (WindowIconPixbufGetter -> WindowIconPixbufGetter)
    -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    forall a b. (a -> b) -> a -> b
    $
      WindowIconPixbufGetter
    getCustomIcon WindowIconPixbufGetter
    -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    forall (m :: * -> *) t t1 a.
    Monad m =>
    (t -> t1 -> m (Maybe a))
    -> (t -> t1 -> m (Maybe a)) -> t -> t1 -> m (Maybe a)
    <|||> WindowIconPixbufGetter
    defaultGetter WindowIconPixbufGetter
    -> WindowIconPixbufGetter -> WindowIconPixbufGetter
    forall (m :: * -> *) t t1 a.
    Monad m =>
    (t -> t1 -> m (Maybe a))
    -> (t -> t1 -> m (Maybe a)) -> t -> t1 -> m (Maybe a)
    <|||> (\s :: Int32
    s _ -> Int32 -> ReaderT Context IO (Maybe Pixbuf)
    fallback Int32
    s)
      where
        getCustomIcon :: Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)
        getCustomIcon :: WindowIconPixbufGetter
    getCustomIcon _ wdata :: WindowData
    wdata =
          IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $
          IO (Maybe Pixbuf)
    -> (String -> IO (Maybe Pixbuf))
    -> Maybe String
    -> IO (Maybe Pixbuf)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe Pixbuf -> IO (Maybe Pixbuf)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Pixbuf
    forall a. Maybe a
    Nothing) String -> IO (Maybe Pixbuf)
    getPixbufFromFilePath (Maybe String -> IO (Maybe Pixbuf))
    -> Maybe String -> IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ WindowData -> Maybe String
    getCustomIconPath WindowData
    wdata

    sortWindowsByPosition :: [WindowData] -> WorkspacesIO [WindowData]
    sortWindowsByPosition :: [WindowData] -> WorkspacesIO [WindowData]
    sortWindowsByPosition wins :: [WindowData]
    wins = do
      let getGeometryWorkspaces :: X11Window
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    getGeometryWorkspaces w :: X11Window
    w = X11Property Display
    getDisplay X11Property Display
    -> (Display
        -> ReaderT
             X11Context
             IO
             (X11Window, Int32, Int32, Word32, Word32, Word32, CInt))
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
     -> ReaderT
          X11Context
          IO
          (X11Window, Int32, Int32, Word32, Word32, Word32, CInt))
    -> (Display
        -> IO (X11Window, Int32, Int32, Word32, Word32, Word32, CInt))
    -> Display
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Display
    -> X11Window
    -> IO (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    `safeGetGeometry` X11Window
    w)
          getGeometries :: ReaderT X11Context IO [(X11Window, (Int32, Int32))]
    getGeometries = (WindowData -> ReaderT X11Context IO (X11Window, (Int32, Int32)))
    -> [WindowData]
    -> ReaderT X11Context IO [(X11Window, (Int32, Int32))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM
                          ((X11Window -> ReaderT X11Context IO X11Window)
    -> (X11Window -> ReaderT X11Context IO (Int32, Int32))
    -> X11Window
    -> ReaderT X11Context IO (X11Window, (Int32, Int32))
    forall (m :: * -> *) c a b.
    Monad m =>
    (c -> m a) -> (c -> m b) -> c -> m (a, b)
    forkM X11Window -> ReaderT X11Context IO X11Window
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                                   (((((X11Window, Int32, Int32, Word32, Word32, Word32, CInt) -> Int32
    forall a b. Sel2 a b => a -> b
    sel2 ((X11Window, Int32, Int32, Word32, Word32, Word32, CInt) -> Int32)
    -> ((X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
        -> Int32)
    -> (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    -> (Int32, Int32)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (X11Window, Int32, Int32, Word32, Word32, Word32, CInt) -> Int32
    forall a b. Sel3 a b => a -> b
    sel3) ((X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
     -> (Int32, Int32))
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    -> ReaderT X11Context IO (Int32, Int32)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (ReaderT
       X11Context
       IO
       (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
     -> ReaderT X11Context IO (Int32, Int32))
    -> (X11Window
        -> ReaderT
             X11Context
             IO
             (X11Window, Int32, Int32, Word32, Word32, Word32, CInt))
    -> X11Window
    -> ReaderT X11Context IO (Int32, Int32)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) X11Window
    -> ReaderT
         X11Context
         IO
         (X11Window, Int32, Int32, Word32, Word32, Word32, CInt)
    getGeometryWorkspaces) (X11Window -> ReaderT X11Context IO (X11Window, (Int32, Int32)))
    -> (WindowData -> X11Window)
    -> WindowData
    -> ReaderT X11Context IO (X11Window, (Int32, Int32))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   WindowData -> X11Window
    windowId)
                          [WindowData]
    wins
      [(X11Window, (Int32, Int32))]
    windowGeometries <- [(X11Window, (Int32, Int32))]
    -> ReaderT X11Context IO [(X11Window, (Int32, Int32))]
    -> WorkspacesIO [(X11Window, (Int32, Int32))]
    forall a. a -> X11Property a -> WorkspacesIO a
    liftX11Def [] ReaderT X11Context IO [(X11Window, (Int32, Int32))]
    getGeometries
      let getLeftPos :: WindowData -> (Int32, Int32)
    getLeftPos wd :: WindowData
    wd =
            (Int32, Int32) -> Maybe (Int32, Int32) -> (Int32, Int32)
    forall a. a -> Maybe a -> a
    fromMaybe (999999999, 99999999) (Maybe (Int32, Int32) -> (Int32, Int32))
    -> Maybe (Int32, Int32) -> (Int32, Int32)
    forall a b. (a -> b) -> a -> b
    $ X11Window -> [(X11Window, (Int32, Int32))] -> Maybe (Int32, Int32)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (WindowData -> X11Window
    windowId WindowData
    wd) [(X11Window, (Int32, Int32))]
    windowGeometries
          compareWindowData :: WindowData -> WindowData -> Ordering
    compareWindowData a :: WindowData
    a b :: WindowData
    b =
            (Bool, (Int32, Int32)) -> (Bool, (Int32, Int32)) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare
              (WindowData -> Bool
    windowMinimized WindowData
    a, WindowData -> (Int32, Int32)
    getLeftPos WindowData
    a)
              (WindowData -> Bool
    windowMinimized WindowData
    b, WindowData -> (Int32, Int32)
    getLeftPos WindowData
    b)
      [WindowData] -> WorkspacesIO [WindowData]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([WindowData] -> WorkspacesIO [WindowData])
    -> [WindowData] -> WorkspacesIO [WindowData]
    forall a b. (a -> b) -> a -> b
    $ (WindowData -> WindowData -> Ordering)
    -> [WindowData] -> [WindowData]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy WindowData -> WindowData -> Ordering
    compareWindowData [WindowData]
    wins

    updateImages :: IconController -> Workspace -> WorkspacesIO [IconWidget]
    updateImages :: IconController -> Workspace -> WorkspacesIO [IconWidget]
    updateImages ic :: IconController
    ic ws :: Workspace
    ws = do
      WorkspacesContext {workspacesConfig :: WorkspacesContext -> WorkspacesConfig
    workspacesConfig = WorkspacesConfig
    cfg} <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      [WindowData]
    sortedWindows <- WorkspacesConfig -> [WindowData] -> WorkspacesIO [WindowData]
    iconSort WorkspacesConfig
    cfg ([WindowData] -> WorkspacesIO [WindowData])
    -> [WindowData] -> WorkspacesIO [WindowData]
    forall a b. (a -> b) -> a -> b
    $ Workspace -> [WindowData]
    windows Workspace
    ws
      Priority -> String -> WorkspacesIO ()
    forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
    wLog Priority
    DEBUG (String -> WorkspacesIO ()) -> String -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall r. PrintfType r => String -> r
    printf "Updating images for %s" (Workspace -> String
    forall a. Show a => a -> String
    show Workspace
    ws)
      let updateIconWidget' :: WorkspacesIO IconWidget
    -> Maybe WindowData -> WorkspacesIO IconWidget
    updateIconWidget' getImageAction :: WorkspacesIO IconWidget
    getImageAction wdata :: Maybe WindowData
    wdata = do
            IconWidget
    iconWidget <- WorkspacesIO IconWidget
    getImageAction
            ()
    _ <- IconController -> IconWidget -> Maybe WindowData -> WorkspacesIO ()
    updateIconWidget IconController
    ic IconWidget
    iconWidget Maybe WindowData
    wdata
            IconWidget -> WorkspacesIO IconWidget
    forall (m :: * -> *) a. Monad m => a -> m a
    return IconWidget
    iconWidget
          existingImages :: [WorkspacesIO IconWidget]
    existingImages = (IconWidget -> WorkspacesIO IconWidget)
    -> [IconWidget] -> [WorkspacesIO IconWidget]
    forall a b. (a -> b) -> [a] -> [b]
    map IconWidget -> WorkspacesIO IconWidget
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([IconWidget] -> [WorkspacesIO IconWidget])
    -> [IconWidget] -> [WorkspacesIO IconWidget]
    forall a b. (a -> b) -> a -> b
    $ IconController -> [IconWidget]
    iconImages IconController
    ic
          buildAndAddIconWidget :: Bool -> WorkspacesIO IconWidget
    buildAndAddIconWidget transparentOnNone :: Bool
    transparentOnNone = do
            IconWidget
    iw <- Bool -> Workspace -> WorkspacesIO IconWidget
    buildIconWidget Bool
    transparentOnNone Workspace
    ws
            IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Box -> EventBox -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd (IconController -> Box
    iconsContainer IconController
    ic) (EventBox -> IO ()) -> EventBox -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IconWidget -> EventBox
    iconContainer IconWidget
    iw
            IconWidget -> WorkspacesIO IconWidget
    forall (m :: * -> *) a. Monad m => a -> m a
    return IconWidget
    iw
          infiniteImages :: [WorkspacesIO IconWidget]
    infiniteImages =
            [WorkspacesIO IconWidget]
    existingImages [WorkspacesIO IconWidget]
    -> [WorkspacesIO IconWidget] -> [WorkspacesIO IconWidget]
    forall a. [a] -> [a] -> [a]
    ++
            Int -> WorkspacesIO IconWidget -> [WorkspacesIO IconWidget]
    forall a. Int -> a -> [a]
    replicate (WorkspacesConfig -> Int
    minIcons WorkspacesConfig
    cfg Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [WorkspacesIO IconWidget] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [WorkspacesIO IconWidget]
    existingImages)
                      (Bool -> WorkspacesIO IconWidget
    buildAndAddIconWidget Bool
    True) [WorkspacesIO IconWidget]
    -> [WorkspacesIO IconWidget] -> [WorkspacesIO IconWidget]
    forall a. [a] -> [a] -> [a]
    ++
            WorkspacesIO IconWidget -> [WorkspacesIO IconWidget]
    forall a. a -> [a]
    repeat (Bool -> WorkspacesIO IconWidget
    buildAndAddIconWidget Bool
    False)
          windowCount :: Int
    windowCount = [WindowData] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([WindowData] -> Int) -> [WindowData] -> Int
    forall a b. (a -> b) -> a -> b
    $ Workspace -> [WindowData]
    windows Workspace
    ws
          maxNeeded :: Int
    maxNeeded = Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    windowCount (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    windowCount) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ WorkspacesConfig -> Maybe Int
    maxIcons WorkspacesConfig
    cfg
          newImagesNeeded :: Bool
    newImagesNeeded = [WorkspacesIO IconWidget] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [WorkspacesIO IconWidget]
    existingImages Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max (WorkspacesConfig -> Int
    minIcons WorkspacesConfig
    cfg) Int
    maxNeeded
          -- XXX: Only one of the two things being zipped can be an infinite list,
          -- which is why this newImagesNeeded contortion is needed.
          imgSrcs :: [WorkspacesIO IconWidget]
    imgSrcs =
            if Bool
    newImagesNeeded
              then [WorkspacesIO IconWidget]
    infiniteImages
              else [WorkspacesIO IconWidget]
    existingImages
          getImgs :: [WorkspacesIO IconWidget]
    getImgs = [WorkspacesIO IconWidget]
    -> (Int -> [WorkspacesIO IconWidget])
    -> Maybe Int
    -> [WorkspacesIO IconWidget]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [WorkspacesIO IconWidget]
    imgSrcs (Int -> [WorkspacesIO IconWidget] -> [WorkspacesIO IconWidget]
    forall a. Int -> [a] -> [a]
    `take` [WorkspacesIO IconWidget]
    imgSrcs) (Maybe Int -> [WorkspacesIO IconWidget])
    -> Maybe Int -> [WorkspacesIO IconWidget]
    forall a b. (a -> b) -> a -> b
    $ WorkspacesConfig -> Maybe Int
    maxIcons WorkspacesConfig
    cfg
          justWindows :: [Maybe WindowData]
    justWindows = (WindowData -> Maybe WindowData)
    -> [WindowData] -> [Maybe WindowData]
    forall a b. (a -> b) -> [a] -> [b]
    map WindowData -> Maybe WindowData
    forall a. a -> Maybe a
    Just [WindowData]
    sortedWindows
          windowDatas :: [Maybe WindowData]
    windowDatas =
            if Bool
    newImagesNeeded
              then [Maybe WindowData]
    justWindows [Maybe WindowData] -> [Maybe WindowData] -> [Maybe WindowData]
    forall a. [a] -> [a] -> [a]
    ++
                   Int -> Maybe WindowData -> [Maybe WindowData]
    forall a. Int -> a -> [a]
    replicate (WorkspacesConfig -> Int
    minIcons WorkspacesConfig
    cfg Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [Maybe WindowData] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Maybe WindowData]
    justWindows) Maybe WindowData
    forall a. Maybe a
    Nothing
              else [Maybe WindowData]
    justWindows [Maybe WindowData] -> [Maybe WindowData] -> [Maybe WindowData]
    forall a. [a] -> [a] -> [a]
    ++ Maybe WindowData -> [Maybe WindowData]
    forall a. a -> [a]
    repeat Maybe WindowData
    forall a. Maybe a
    Nothing
      [IconWidget]
    newImgs <-
        (WorkspacesIO IconWidget
     -> Maybe WindowData -> WorkspacesIO IconWidget)
    -> [WorkspacesIO IconWidget]
    -> [Maybe WindowData]
    -> WorkspacesIO [IconWidget]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM WorkspacesIO IconWidget
    -> Maybe WindowData -> WorkspacesIO IconWidget
    updateIconWidget' [WorkspacesIO IconWidget]
    getImgs [Maybe WindowData]
    windowDatas
      Bool -> WorkspacesIO () -> WorkspacesIO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    newImagesNeeded (WorkspacesIO () -> WorkspacesIO ())
    -> WorkspacesIO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ Box -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShowAll (Box -> IO ()) -> Box -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IconController -> Box
    iconsContainer IconController
    ic
      [IconWidget] -> WorkspacesIO [IconWidget]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [IconWidget]
    newImgs

    getWindowStatusString :: WindowData -> T.Text
    getWindowStatusString :: WindowData -> Text
    getWindowStatusString windowData :: WindowData
    windowData = Text -> Text
    T.toLower (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $
      case WindowData
    windowData of
        WindowData { windowMinimized :: WindowData -> Bool
    windowMinimized = Bool
    True } -> "minimized"
        WindowData { windowActive :: WindowData -> Bool
    windowActive = Bool
    True } -> WorkspaceState -> String
    forall a. Show a => a -> String
    show WorkspaceState
    Active
        WindowData { windowUrgent :: WindowData -> Bool
    windowUrgent = Bool
    True } -> WorkspaceState -> String
    forall a. Show a => a -> String
    show WorkspaceState
    Urgent
        _ -> "normal"

    possibleStatusStrings :: [T.Text]
    possibleStatusStrings :: [Text]
    possibleStatusStrings =
      (String -> Text) -> [String] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map
        (Text -> Text
    T.toLower (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack)
        [WorkspaceState -> String
    forall a. Show a => a -> String
    show WorkspaceState
    Active, WorkspaceState -> String
    forall a. Show a => a -> String
    show WorkspaceState
    Urgent, "minimized", "normal", "inactive"]

    updateIconWidget
      :: IconController
      -> IconWidget
      -> Maybe WindowData
      -> WorkspacesIO ()
    updateIconWidget :: IconController -> IconWidget -> Maybe WindowData -> WorkspacesIO ()
    updateIconWidget _ IconWidget
                       { iconContainer :: IconWidget -> EventBox
    iconContainer = EventBox
    iconButton
                       , iconWindow :: IconWidget -> MVar (Maybe WindowData)
    iconWindow = MVar (Maybe WindowData)
    windowRef
                       , iconForceUpdate :: IconWidget -> IO ()
    iconForceUpdate = IO ()
    updateIcon
                       } windowData :: Maybe WindowData
    windowData = do
      let statusString :: Text
    statusString = Text -> (WindowData -> Text) -> Maybe WindowData -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "inactive" WindowData -> Text
    getWindowStatusString Maybe WindowData
    windowData :: T.Text
          setIconWidgetProperties :: IO ()
    setIconWidgetProperties =
            EventBox -> [Text] -> [Text] -> IO ()
    forall (t1 :: * -> *) (t :: * -> *) a (m :: * -> *).
    (Foldable t1, Foldable t, IsWidget a, MonadIO m) =>
    a -> t1 Text -> t Text -> m ()
    updateWidgetClasses EventBox
    iconButton [Text
    statusString] [Text]
    possibleStatusStrings
      ReaderT WorkspacesContext IO (Maybe WindowData) -> WorkspacesIO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT WorkspacesContext IO (Maybe WindowData)
     -> WorkspacesIO ())
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ MVar (Maybe WindowData)
    -> (Maybe WindowData
        -> ReaderT WorkspacesContext IO (Maybe WindowData))
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall a. MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a
    updateVar MVar (Maybe WindowData)
    windowRef ((Maybe WindowData
      -> ReaderT WorkspacesContext IO (Maybe WindowData))
     -> ReaderT WorkspacesContext IO (Maybe WindowData))
    -> (Maybe WindowData
        -> ReaderT WorkspacesContext IO (Maybe WindowData))
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall a b. (a -> b) -> a -> b
    $ ReaderT WorkspacesContext IO (Maybe WindowData)
    -> Maybe WindowData
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall a b. a -> b -> a
    const (ReaderT WorkspacesContext IO (Maybe WindowData)
     -> Maybe WindowData
     -> ReaderT WorkspacesContext IO (Maybe WindowData))
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    -> Maybe WindowData
    -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall a b. (a -> b) -> a -> b
    $ Maybe WindowData -> ReaderT WorkspacesContext IO (Maybe WindowData)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe WindowData
    windowData
      IO () -> WorkspacesIO ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO () -> WorkspacesIO ()) -> IO () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ IO ()
    updateIcon IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    setIconWidgetProperties

    data WorkspaceButtonController = WorkspaceButtonController
      { WorkspaceButtonController -> EventBox
    button :: Gtk.EventBox
      , WorkspaceButtonController -> Workspace
    buttonWorkspace :: Workspace
      , WorkspaceButtonController -> WWC
    contentsController :: WWC
      }

    buildButtonController :: ParentControllerConstructor
    buildButtonController :: ParentControllerConstructor
    buildButtonController contentsBuilder :: ControllerConstructor
    contentsBuilder workspace :: Workspace
    workspace = do
      WWC
    cc <- ControllerConstructor
    contentsBuilder Workspace
    workspace
      MVar (Map WorkspaceId Workspace)
    workspacesRef <- (WorkspacesContext -> MVar (Map WorkspaceId Workspace))
    -> ReaderT WorkspacesContext IO (MVar (Map WorkspaceId Workspace))
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks WorkspacesContext -> MVar (Map WorkspaceId Workspace)
    workspacesVar
      WorkspacesContext
    ctx <- ReaderT WorkspacesContext IO WorkspacesContext
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      Widget
    widget <- WWC -> WorkspacesIO Widget
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WorkspacesIO Widget
    getWidget WWC
    cc
      IO WWC -> WorkspacesIO WWC
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO WWC -> WorkspacesIO WWC) -> IO WWC -> WorkspacesIO WWC
    forall a b. (a -> b) -> a -> b
    $ do
        EventBox
    ebox <- IO EventBox
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
    Gtk.eventBoxNew
        EventBox -> Widget -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd EventBox
    ebox Widget
    widget
        EventBox -> Bool -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsEventBox a) =>
    a -> Bool -> m ()
    Gtk.eventBoxSetVisibleWindow EventBox
    ebox Bool
    False
        SignalHandlerId
    _ <-
          EventBox -> WidgetScrollEventCallback -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> WidgetScrollEventCallback -> m SignalHandlerId
    Gtk.onWidgetScrollEvent EventBox
    ebox (WidgetScrollEventCallback -> IO SignalHandlerId)
    -> WidgetScrollEventCallback -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ \scrollEvent :: EventScroll
    scrollEvent -> do
            ScrollDirection
    dir <- EventScroll -> IO ScrollDirection
    forall (m :: * -> *). MonadIO m => EventScroll -> m ScrollDirection
    Gdk.getEventScrollDirection EventScroll
    scrollEvent
            Map WorkspaceId Workspace
    workspaces <- IO (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace))
    -> IO (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace)
    forall a b. (a -> b) -> a -> b
    $ MVar (Map WorkspaceId Workspace) -> IO (Map WorkspaceId Workspace)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map WorkspaceId Workspace)
    workspacesRef
            let switchOne :: Bool -> IO Bool
    switchOne a :: Bool
    a =
                  IO Bool -> IO Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
                  (ReaderT WorkspacesContext IO Bool -> WorkspacesContext -> IO Bool)
    -> WorkspacesContext
    -> ReaderT WorkspacesContext IO Bool
    -> IO Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT WorkspacesContext IO Bool -> WorkspacesContext -> IO Bool
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (ReaderT WorkspacesContext IO Bool -> IO Bool)
    -> ReaderT WorkspacesContext IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
                  () -> X11Property () -> WorkspacesIO ()
    forall a. a -> X11Property a -> WorkspacesIO a
    liftX11Def
                    ()
                    (Bool -> Int -> X11Property ()
    switchOneWorkspace Bool
    a ([(WorkspaceId, Workspace)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Map WorkspaceId Workspace -> [(WorkspaceId, Workspace)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map WorkspaceId Workspace
    workspaces) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)) WorkspacesIO ()
    -> ReaderT WorkspacesContext IO Bool
    -> ReaderT WorkspacesContext IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                  Bool -> ReaderT WorkspacesContext IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            case ScrollDirection
    dir of
              Gdk.ScrollDirectionUp -> Bool -> IO Bool
    switchOne Bool
    True
              Gdk.ScrollDirectionLeft -> Bool -> IO Bool
    switchOne Bool
    True
              Gdk.ScrollDirectionDown -> Bool -> IO Bool
    switchOne Bool
    False
              Gdk.ScrollDirectionRight -> Bool -> IO Bool
    switchOne Bool
    False
              _ -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        SignalHandlerId
    _ <- EventBox -> WidgetButtonPressEventCallback -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> WidgetButtonPressEventCallback -> m SignalHandlerId
    Gtk.onWidgetButtonPressEvent EventBox
    ebox (WidgetButtonPressEventCallback -> IO SignalHandlerId)
    -> WidgetButtonPressEventCallback -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> WidgetButtonPressEventCallback
    forall a b. a -> b -> a
    const (IO Bool -> WidgetButtonPressEventCallback)
    -> IO Bool -> WidgetButtonPressEventCallback
    forall a b. (a -> b) -> a -> b
    $ WorkspacesContext -> WorkspaceId -> IO Bool
    forall (m :: * -> *).
    MonadIO m =>
    WorkspacesContext -> WorkspaceId -> m Bool
    switch WorkspacesContext
    ctx (WorkspaceId -> IO Bool) -> WorkspaceId -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Workspace -> WorkspaceId
    workspaceIdx Workspace
    workspace
        WWC -> IO WWC
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WWC -> IO WWC) -> WWC -> IO WWC
    forall a b. (a -> b) -> a -> b
    $
          WorkspaceButtonController -> WWC
    forall a. WorkspaceWidgetController a => a -> WWC
    WWC
            WorkspaceButtonController :: EventBox -> Workspace -> WWC -> WorkspaceButtonController
    WorkspaceButtonController
            {button :: EventBox
    button = EventBox
    ebox, buttonWorkspace :: Workspace
    buttonWorkspace = Workspace
    workspace, contentsController :: WWC
    contentsController = WWC
    cc}

    switch :: (MonadIO m) => WorkspacesContext -> WorkspaceId -> m Bool
    switch :: WorkspacesContext -> WorkspaceId -> m Bool
    switch ctx :: WorkspacesContext
    ctx idx :: WorkspaceId
    idx = do
      IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ (WorkspacesIO () -> WorkspacesContext -> IO ())
    -> WorkspacesContext -> WorkspacesIO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip WorkspacesIO () -> WorkspacesContext -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT WorkspacesContext
    ctx (WorkspacesIO () -> IO ()) -> WorkspacesIO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> X11Property () -> WorkspacesIO ()
    forall a. a -> X11Property a -> WorkspacesIO a
    liftX11Def () (X11Property () -> WorkspacesIO ())
    -> X11Property () -> WorkspacesIO ()
    forall a b. (a -> b) -> a -> b
    $ WorkspaceId -> X11Property ()
    switchToWorkspace WorkspaceId
    idx
      Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    instance WorkspaceWidgetController WorkspaceButtonController
      where
        getWidget :: WorkspaceButtonController -> WorkspacesIO Widget
    getWidget wbc :: WorkspaceButtonController
    wbc = IO Widget -> WorkspacesIO Widget
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Widget -> WorkspacesIO Widget)
    -> IO Widget -> WorkspacesIO Widget
    forall a b. (a -> b) -> a -> b
    $ EventBox -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget (EventBox -> IO Widget) -> EventBox -> IO Widget
    forall a b. (a -> b) -> a -> b
    $ WorkspaceButtonController -> EventBox
    button WorkspaceButtonController
    wbc
        updateWidget :: WorkspaceButtonController
    -> WidgetUpdate -> WorkspacesIO WorkspaceButtonController
    updateWidget wbc :: WorkspaceButtonController
    wbc update :: WidgetUpdate
    update = do
          WWC
    newContents <- WWC -> WidgetUpdate -> WorkspacesIO WWC
    forall wc.
    WorkspaceWidgetController wc =>
    wc -> WidgetUpdate -> WorkspacesIO wc
    updateWidget (WorkspaceButtonController -> WWC
    contentsController WorkspaceButtonController
    wbc) WidgetUpdate
    update
          WorkspaceButtonController -> WorkspacesIO WorkspaceButtonController
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceButtonController
    wbc { contentsController :: WWC
    contentsController = WWC
    newContents }