    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE LambdaCase #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.TreeSelect
    -- Description :  Display workspaces or actions in a tree-like format.
    -- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Tom Smeets <tom.tsmeets@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    --
    -- TreeSelect displays your workspaces or actions in a Tree-like format.
    -- You can select the desired workspace/action with the cursor or hjkl keys.
    --
    -- This module is fully configurable and very useful if you like to have a
    -- lot of workspaces.
    --
    -- Only the nodes up to the currently selected are displayed.
    -- This will be configurable in the near future by changing 'ts_hidechildren' to @False@, this is not yet implemented.
    --
    -- <<https://wiki.haskell.org/wikiupload/thumb/0/0b/Treeselect-Workspace.png/800px-Treeselect-Workspace.png>>
    --
    -----------------------------------------------------------------------------
    module XMonad.Actions.TreeSelect
        (
          -- * Usage
          -- $usage
          treeselectWorkspace
        , toWorkspaces
        , treeselectAction

          -- * Configuring
          -- $config
        , Pixel
          -- $pixel

        , TSConfig(..)
        , tsDefaultConfig
        , def

          -- * Navigation
          -- $navigation
        , defaultNavigation
        , select
        , cancel
        , moveParent
        , moveChild
        , moveNext
        , movePrev
        , moveHistBack
        , moveHistForward
        , moveTo

          -- * Advanced usage
          -- $advusage
        , TSNode(..)
        , treeselect
        , treeselectAt
        ) where

    import Control.Monad.Reader
    import Control.Monad.State
    import Data.Tree
    import Foreign (shiftL, shiftR, (.&.))
    import System.IO
    import XMonad hiding (liftX)
    import XMonad.Prelude
    import XMonad.StackSet as W
    import XMonad.Util.Font
    import XMonad.Util.NamedWindows
    import XMonad.Util.TreeZipper
    import XMonad.Hooks.WorkspaceHistory
    import qualified Data.Map as M

    #ifdef XFT
    import qualified Data.List.NonEmpty as NE
    import Graphics.X11.Xrender
    import Graphics.X11.Xft
    #endif

    -- $usage
    --
    -- These imports are used in the following example
    --
    -- > import Data.Tree
    -- > import XMonad.Actions.TreeSelect
    -- > import XMonad.Hooks.WorkspaceHistory
    -- > import qualified XMonad.StackSet as W
    --
    -- For selecting Workspaces, you need to define them in a tree structure using 'Data.Tree.Node' instead of just a standard list
    --
    -- Here is an example workspace-tree
    --
    -- > myWorkspaces :: Forest String
    -- > myWorkspaces = [ Node "Browser" [] -- a workspace for your browser
    -- >                , Node "Home"       -- for everyday activity's
    -- >                    [ Node "1" []   --  with 4 extra sub-workspaces, for even more activity's
    -- >                    , Node "2" []
    -- >                    , Node "3" []
    -- >                    , Node "4" []
    -- >                    ]
    -- >                , Node "Programming" -- for all your programming needs
    -- >                    [ Node "Haskell" []
    -- >                    , Node "Docs"    [] -- documentation
    -- >                    ]
    -- >                ]
    --
    -- Then add it to your 'XMonad.Core.workspaces' using the 'toWorkspaces' function.
    --
    -- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
    --
    -- > xmonad $ def { ...
    -- >              , workspaces = toWorkspaces myWorkspaces
    -- >              , logHook = workspaceHistoryHook
    -- >              }
    --
    -- After that you still need to bind buttons to 'treeselectWorkspace' to start selecting a workspaces and moving windows
    --
    -- you could bind @Mod-f@ to switch workspace
    --
    -- >  , ((modMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.greedyView)
    --
    -- and bind @Mod-Shift-f@ to moving the focused windows to a workspace
    --
    -- >  , ((modMask .|. shiftMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.shift)

    -- $config
    -- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
    --
    -- The default config defined as 'def'
    --
    -- > def = TSConfig { ts_hidechildren = True
    -- >                , ts_background   = 0xc0c0c0c0
    -- >                , ts_font         = "xft:Sans-16"
    -- >                , ts_node         = (0xff000000, 0xff50d0db)
    -- >                , ts_nodealt      = (0xff000000, 0xff10b8d6)
    -- >                , ts_highlight    = (0xffffffff, 0xffff0000)
    -- >                , ts_extra        = 0xff000000
    -- >                , ts_node_width   = 200
    -- >                , ts_node_height  = 30
    -- >                , ts_originX      = 0
    -- >                , ts_originY      = 0
    -- >                , ts_indent       = 80
    -- >                , ts_navigate     = defaultNavigation
    -- >                }

    -- $pixel
    --
    -- The 'Pixel' Color format is in the form of @0xaarrggbb@
    --
    -- Note that transparency is only supported if you have a window compositor running like <https://github.com/chjj/compton compton>
    --
    -- Some Examples:
    --
    -- @
    -- white       = 0xffffffff
    -- black       = 0xff000000
    -- red         = 0xffff0000
    -- green       = 0xff00ff00
    -- blue        = 0xff0000ff
    -- transparent = 0x00000000
    -- @

    -- $navigation
    --
    -- Keybindings for navigations can also be modified
    --
    -- This is the definition of 'defaultNavigation'
    --
    -- > defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
    -- > defaultNavigation = M.fromList
    -- >     [ ((0, xK_Escape), cancel)
    -- >     , ((0, xK_Return), select)
    -- >     , ((0, xK_space),  select)
    -- >     , ((0, xK_Up),     movePrev)
    -- >     , ((0, xK_Down),   moveNext)
    -- >     , ((0, xK_Left),   moveParent)
    -- >     , ((0, xK_Right),  moveChild)
    -- >     , ((0, xK_k),      movePrev)
    -- >     , ((0, xK_j),      moveNext)
    -- >     , ((0, xK_h),      moveParent)
    -- >     , ((0, xK_l),      moveChild)
    -- >     , ((0, xK_o),      moveHistBack)
    -- >     , ((0, xK_i),      moveHistForward)
    -- >     ]

    -- $advusage
    -- This module can also be used to select any other action

    -- | Extensive configuration for displaying the tree.
    --
    -- This class also has a 'Default' instance
    data TSConfig a = TSConfig { forall a. TSConfig a -> Bool
    ts_hidechildren :: Bool -- ^ when enabled, only the parents (and their first children) of the current node will be shown (This feature is not yet implemented!)
                               , forall a. TSConfig a -> Pixel
    ts_background :: Pixel -- ^ background color filling the entire screen.

                               , forall a. TSConfig a -> WorkspaceId
    ts_font :: String -- ^ XMF font for drawing the node name extra text

                               , forall a. TSConfig a -> (Pixel, Pixel)
    ts_node      :: (Pixel, Pixel) -- ^ node foreground (text) and background color when not selected
                               , forall a. TSConfig a -> (Pixel, Pixel)
    ts_nodealt   :: (Pixel, Pixel) -- ^ every other node will use this color instead of 'ts_node'
                               , forall a. TSConfig a -> (Pixel, Pixel)
    ts_highlight :: (Pixel, Pixel) -- ^ node foreground (text) and background color when selected

                               , forall a. TSConfig a -> Pixel
    ts_extra :: Pixel -- ^ extra text color

                               , forall a. TSConfig a -> Int
    ts_node_width   :: Int -- ^ node width in pixels
                               , forall a. TSConfig a -> Int
    ts_node_height  :: Int -- ^ node height in pixels
                               , forall a. TSConfig a -> Int
    ts_originX :: Int -- ^ tree X position on the screen in pixels
                               , forall a. TSConfig a -> Int
    ts_originY :: Int -- ^ tree Y position on the screen in pixels

                               , forall a. TSConfig a -> Int
    ts_indent :: Int -- ^ indentation amount for each level in pixels

                               , forall a.
    TSConfig a -> Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    ts_navigate :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) -- ^ key bindings for navigating the tree
                               }

    instance Default (TSConfig a) where
        def :: TSConfig a
    def = TSConfig { ts_hidechildren :: Bool
    ts_hidechildren = Bool
    True
                       , ts_background :: Pixel
    ts_background   = Pixel
    0xc0c0c0c0
                       , ts_font :: WorkspaceId
    ts_font         = WorkspaceId
    "xft:Sans-16"
                       , ts_node :: (Pixel, Pixel)
    ts_node         = (Pixel
    0xff000000, Pixel
    0xff50d0db)
                       , ts_nodealt :: (Pixel, Pixel)
    ts_nodealt      = (Pixel
    0xff000000, Pixel
    0xff10b8d6)
                       , ts_highlight :: (Pixel, Pixel)
    ts_highlight    = (Pixel
    0xffffffff, Pixel
    0xffff0000)
                       , ts_extra :: Pixel
    ts_extra        = Pixel
    0xff000000
                       , ts_node_width :: Int
    ts_node_width   = Int
    200
                       , ts_node_height :: Int
    ts_node_height  = Int
    30
                       , ts_originX :: Int
    ts_originX      = Int
    0
                       , ts_originY :: Int
    ts_originY      = Int
    0
                       , ts_indent :: Int
    ts_indent       = Int
    80
                       , ts_navigate :: Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    ts_navigate     = Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    forall a. Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    defaultNavigation
                       }

    -- | Default navigation
    --
    -- * navigation using either arrow key or vi style hjkl
    -- * Return or Space to confirm
    -- * Escape or Backspace to cancel to
    defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
    defaultNavigation :: forall a. Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    defaultNavigation = [((KeyMask, Pixel), TreeSelect a (Maybe a))]
    -> Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
        [ ((KeyMask
    0, Pixel
    xK_Escape), TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    cancel)
        , ((KeyMask
    0, Pixel
    xK_Return), TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    select)
        , ((KeyMask
    0, Pixel
    xK_space),  TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    select)
        , ((KeyMask
    0, Pixel
    xK_Up),     TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    movePrev)
        , ((KeyMask
    0, Pixel
    xK_Down),   TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveNext)
        , ((KeyMask
    0, Pixel
    xK_Left),   TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveParent)
        , ((KeyMask
    0, Pixel
    xK_Right),  TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveChild)
        , ((KeyMask
    0, Pixel
    xK_k),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    movePrev)
        , ((KeyMask
    0, Pixel
    xK_j),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveNext)
        , ((KeyMask
    0, Pixel
    xK_h),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveParent)
        , ((KeyMask
    0, Pixel
    xK_l),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveChild)
        , ((KeyMask
    0, Pixel
    xK_o),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveHistBack)
        , ((KeyMask
    0, Pixel
    xK_i),      TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    moveHistForward)
        ]

    -- | Default configuration.
    --
    -- Using nice alternating blue nodes
    tsDefaultConfig :: TSConfig a
    tsDefaultConfig :: forall a. TSConfig a
    tsDefaultConfig = TSConfig a
    forall a. Default a => a
    def
    {-# DEPRECATED tsDefaultConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TreeSelect) instead." #-}

    -- | Tree Node With a name and extra text
    data TSNode a = TSNode { forall a. TSNode a -> WorkspaceId
    tsn_name  :: String
                           , forall a. TSNode a -> WorkspaceId
    tsn_extra :: String -- ^ extra text, displayed next to the node name
                           , forall a. TSNode a -> a
    tsn_value :: a      -- ^ value to return when this node is selected
                           }

    -- | State used by TreeSelect.
    --
    -- Contains all needed information such as the window, font and a zipper over the tree.
    data TSState a = TSState { forall a. TSState a -> TreeZipper (TSNode a)
    tss_tree     :: TreeZipper (TSNode a)
                             , forall a. TSState a -> Pixel
    tss_window   :: Window
                             , forall a. TSState a -> Display
    tss_display  :: Display
                             , forall a. TSState a -> (Int, Int)
    tss_size     :: (Int, Int) -- ^ size of 'tz_window'
                             , forall a. TSState a -> XMonadFont
    tss_xfont    :: XMonadFont
                             , forall a. TSState a -> GC
    tss_gc       :: GC
                             , forall a. TSState a -> Visual
    tss_visual   :: Visual
                             , forall a. TSState a -> Pixel
    tss_colormap :: Colormap
                             , forall a. TSState a -> ([[WorkspaceId]], [[WorkspaceId]])
    tss_history  :: ([[String]], [[String]]) -- ^ history zipper, navigated with 'moveHistBack' and 'moveHistForward'
                             }

    -- | State monad transformer using 'TSState'
    newtype TreeSelect a b = TreeSelect { forall a b.
    TreeSelect a b -> ReaderT (TSConfig a) (StateT (TSState a) X) b
    runTreeSelect :: ReaderT (TSConfig a) (StateT (TSState a) X) b }
        deriving (Applicative (TreeSelect a)
    Applicative (TreeSelect a) =>
    (forall a b.
     TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b)
    -> (forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b)
    -> (forall a. a -> TreeSelect a a)
    -> Monad (TreeSelect a)
    forall a. Applicative (TreeSelect a)
    forall a. a -> TreeSelect a a
    forall a a. a -> TreeSelect a a
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall a b.
    TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b
    forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall a a b.
    TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a a b.
    TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b
    >>= :: forall a b.
    TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b
    $c>> :: forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    >> :: forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    $creturn :: forall a a. a -> TreeSelect a a
    return :: forall a. a -> TreeSelect a a
    Monad, Functor (TreeSelect a)
    Functor (TreeSelect a) =>
    (forall a. a -> TreeSelect a a)
    -> (forall a b.
        TreeSelect a (a -> b) -> TreeSelect a a -> TreeSelect a b)
    -> (forall a b c.
        (a -> b -> c)
        -> TreeSelect a a -> TreeSelect a b -> TreeSelect a c)
    -> (forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b)
    -> (forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a a)
    -> Applicative (TreeSelect a)
    forall a. Functor (TreeSelect a)
    forall a. a -> TreeSelect a a
    forall a a. a -> TreeSelect a a
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a a
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall a b.
    TreeSelect a (a -> b) -> TreeSelect a a -> TreeSelect a b
    forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a a
    forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall a a b.
    TreeSelect a (a -> b) -> TreeSelect a a -> TreeSelect a b
    forall a b c.
    (a -> b -> c) -> TreeSelect a a -> TreeSelect a b -> TreeSelect a c
    forall a a b c.
    (a -> b -> c) -> TreeSelect a a -> TreeSelect a b -> TreeSelect a c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a a. a -> TreeSelect a a
    pure :: forall a. a -> TreeSelect a a
    $c<*> :: forall a a b.
    TreeSelect a (a -> b) -> TreeSelect a a -> TreeSelect a b
    <*> :: forall a b.
    TreeSelect a (a -> b) -> TreeSelect a a -> TreeSelect a b
    $cliftA2 :: forall a a b c.
    (a -> b -> c) -> TreeSelect a a -> TreeSelect a b -> TreeSelect a c
    liftA2 :: forall a b c.
    (a -> b -> c) -> TreeSelect a a -> TreeSelect a b -> TreeSelect a c
    $c*> :: forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    *> :: forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    $c<* :: forall a a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a a
    <* :: forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a a
    Applicative, (forall a b. (a -> b) -> TreeSelect a a -> TreeSelect a b)
    -> (forall a b. a -> TreeSelect a b -> TreeSelect a a)
    -> Functor (TreeSelect a)
    forall a b. a -> TreeSelect a b -> TreeSelect a a
    forall a b. (a -> b) -> TreeSelect a a -> TreeSelect a b
    forall a a b. a -> TreeSelect a b -> TreeSelect a a
    forall a a b. (a -> b) -> TreeSelect a a -> TreeSelect a b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a a b. (a -> b) -> TreeSelect a a -> TreeSelect a b
    fmap :: forall a b. (a -> b) -> TreeSelect a a -> TreeSelect a b
    $c<$ :: forall a a b. a -> TreeSelect a b -> TreeSelect a a
    <$ :: forall a b. a -> TreeSelect a b -> TreeSelect a a
    Functor, MonadState (TSState a),  MonadReader (TSConfig a), Monad (TreeSelect a)
    Monad (TreeSelect a) =>
    (forall a. IO a -> TreeSelect a a) -> MonadIO (TreeSelect a)
    forall a. Monad (TreeSelect a)
    forall a. IO a -> TreeSelect a a
    forall a a. IO a -> TreeSelect a a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a a. IO a -> TreeSelect a a
    liftIO :: forall a. IO a -> TreeSelect a a
    MonadIO)

    -- | Lift the 'X' action into the 'XMonad.Actions.TreeSelect.TreeSelect' monad
    liftX :: X a -> TreeSelect b a
    liftX :: forall a b. X a -> TreeSelect b a
    liftX = ReaderT (TSConfig b) (StateT (TSState b) X) a -> TreeSelect b a
    forall a b.
    ReaderT (TSConfig a) (StateT (TSState a) X) b -> TreeSelect a b
    TreeSelect (ReaderT (TSConfig b) (StateT (TSState b) X) a -> TreeSelect b a)
    -> (X a -> ReaderT (TSConfig b) (StateT (TSState b) X) a)
    -> X a
    -> TreeSelect b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT (TSState b) X a
    -> ReaderT (TSConfig b) (StateT (TSState b) X) a
    forall (m :: * -> *) a. Monad m => m a -> ReaderT (TSConfig b) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT (TSState b) X a
     -> ReaderT (TSConfig b) (StateT (TSState b) X) a)
    -> (X a -> StateT (TSState b) X a)
    -> X a
    -> ReaderT (TSConfig b) (StateT (TSState b) X) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X a -> StateT (TSState b) X a
    forall (m :: * -> *) a. Monad m => m a -> StateT (TSState b) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    -- | Run Treeselect with a given config and tree.
    -- This can be used for selectiong anything
    --
    -- * for switching workspaces and moving windows use 'treeselectWorkspace'
    -- * for selecting actions use 'treeselectAction'
    treeselect :: TSConfig a         -- ^ config file
               -> Forest (TSNode a)  -- ^ a list of 'Data.Tree.Tree's to select from.
               -> X (Maybe a)
    treeselect :: forall a. TSConfig a -> Forest (TSNode a) -> X (Maybe a)
    treeselect TSConfig a
    c Forest (TSNode a)
    t = TSConfig a
    -> TreeZipper (TSNode a) -> [[WorkspaceId]] -> X (Maybe a)
    forall a.
    TSConfig a
    -> TreeZipper (TSNode a) -> [[WorkspaceId]] -> X (Maybe a)
    treeselectAt TSConfig a
    c (Forest (TSNode a) -> TreeZipper (TSNode a)
    forall a. Forest a -> TreeZipper a
    fromForest Forest (TSNode a)
    t) []

    -- | Same as 'treeselect' but ad a specific starting position
    treeselectAt :: TSConfig a         -- ^ config file
                 -> TreeZipper (TSNode a)  -- ^ tree structure with a cursor position (starting node)
                 -> [[String]] -- ^ list of paths that can be navigated with 'moveHistBack' and 'moveHistForward' (bound to the 'o' and 'i' keys)
                 -> X (Maybe a)
    treeselectAt :: forall a.
    TSConfig a
    -> TreeZipper (TSNode a) -> [[WorkspaceId]] -> X (Maybe a)
    treeselectAt conf :: TSConfig a
    conf@TSConfig{Bool
    Int
    WorkspaceId
    Pixel
    (Pixel, Pixel)
    Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    ts_hidechildren :: forall a. TSConfig a -> Bool
    ts_background :: forall a. TSConfig a -> Pixel
    ts_font :: forall a. TSConfig a -> WorkspaceId
    ts_node :: forall a. TSConfig a -> (Pixel, Pixel)
    ts_nodealt :: forall a. TSConfig a -> (Pixel, Pixel)
    ts_highlight :: forall a. TSConfig a -> (Pixel, Pixel)
    ts_extra :: forall a. TSConfig a -> Pixel
    ts_node_width :: forall a. TSConfig a -> Int
    ts_node_height :: forall a. TSConfig a -> Int
    ts_originX :: forall a. TSConfig a -> Int
    ts_originY :: forall a. TSConfig a -> Int
    ts_indent :: forall a. TSConfig a -> Int
    ts_navigate :: forall a.
    TSConfig a -> Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    ts_hidechildren :: Bool
    ts_background :: Pixel
    ts_font :: WorkspaceId
    ts_node :: (Pixel, Pixel)
    ts_nodealt :: (Pixel, Pixel)
    ts_highlight :: (Pixel, Pixel)
    ts_extra :: Pixel
    ts_node_width :: Int
    ts_node_height :: Int
    ts_originX :: Int
    ts_originY :: Int
    ts_indent :: Int
    ts_navigate :: Map (KeyMask, Pixel) (TreeSelect a (Maybe a))
    ..} TreeZipper (TSNode a)
    zipper [[WorkspaceId]]
    hist = (Display -> X (Maybe a)) -> X (Maybe a)
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X (Maybe a)) -> X (Maybe a))
    -> (Display -> X (Maybe a)) -> X (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \Display
    display -> do
        -- create a window on the currently focused screen
        rootw <- (XConf -> Pixel) -> X Pixel
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Pixel
    theRoot
        Rectangle{..} <- gets $ screenRect . W.screenDetail . W.current . windowset

        Just vinfo <- liftIO $ matchVisualInfo display (defaultScreen display) 32 4

        colormap <- liftIO $ createColormap display rootw (visualInfo_visual vinfo) allocNone

        win <- liftIO $ allocaSetWindowAttributes $ \Ptr SetWindowAttributes
    attributes -> do
            Ptr SetWindowAttributes -> Bool -> IO ()
    set_override_redirect Ptr SetWindowAttributes
    attributes Bool
    True
            Ptr SetWindowAttributes -> Pixel -> IO ()
    set_colormap Ptr SetWindowAttributes
    attributes Pixel
    colormap
            Ptr SetWindowAttributes -> Pixel -> IO ()
    set_background_pixel Ptr SetWindowAttributes
    attributes Pixel
    ts_background
            Ptr SetWindowAttributes -> Pixel -> IO ()
    set_border_pixel Ptr SetWindowAttributes
    attributes Pixel
    0
            w <- Display
    -> Pixel
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> CInt
    -> CInt
    -> CInt
    -> Visual
    -> Pixel
    -> Ptr SetWindowAttributes
    -> IO Pixel
    createWindow Display
    display Pixel
    rootw Position
    rect_x Position
    rect_y Dimension
    rect_width Dimension
    rect_height CInt
    0 (VisualInfo -> CInt
    visualInfo_depth VisualInfo
    vinfo) CInt
    inputOutput (VisualInfo -> Visual
    visualInfo_visual VisualInfo
    vinfo) (Pixel
    cWColormap Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .|. Pixel
    cWBorderPixel Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .|. Pixel
    cWBackPixel) Ptr SetWindowAttributes
    attributes
            setClassHint display w (ClassHint "xmonad-tree_select" "xmonad")
            pure w

        liftIO $ do
            -- TODO: move below?
            -- make the window visible
            mapWindow display win

            -- listen to key and mouse button events
            selectInput display win (exposureMask .|. keyPressMask .|. buttonReleaseMask)

            -- TODO: enable mouse select?
            -- and mouse button 1
            grabButton display button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none

        -- grab the keyboard
        status <- liftIO $ grabKeyboard display win True grabModeAsync grabModeAsync currentTime

        r <- if status == grabSuccess
            then do
                -- load the XMF font
                gc <- liftIO $ createGC display win
                xfont <- initXMF ts_font

                -- run the treeselect Monad
                ret <- evalStateT (runReaderT (runTreeSelect (redraw >> navigate)) conf)
                    TSState{ tss_tree     = zipper
                           , tss_window   = win
                           , tss_display  = display
                           , tss_xfont    = xfont
                           , tss_size     = (fromIntegral rect_width, fromIntegral rect_height)
                           , tss_gc       = gc
                           , tss_visual   = visualInfo_visual vinfo
                           , tss_colormap = colormap
                           , tss_history = ([], hist)
                           }

                -- release the XMF font
                releaseXMF xfont
                liftIO $ freeGC display gc
                return ret

            else return Nothing

        -- destroy the window
        liftIO $ do
            unmapWindow display win
            destroyWindow display win
            freeColormap display colormap
            -- Flush the output buffer and wait for all the events to be processed
            -- TODO: is this needed?
            sync display False
        return r

    -- | Select a workspace and execute a \"view\" function from "XMonad.StackSet" on it.
    treeselectWorkspace :: TSConfig WorkspaceId
                        -> Forest String -- ^ your tree of workspace-names
                        -> (WorkspaceId -> WindowSet -> WindowSet) -- ^ the \"view\" function.
                                                                   -- Instances can be 'W.greedyView' for switching to a workspace
                                                                   -- and/or 'W.shift' for moving the focused window to a selected workspace.
                                                                   --
                                                                   -- These actions can also be combined by doing
                                                                   --
                                                                   -- > \i -> W.greedyView i . W.shift i
                        -> X ()
    treeselectWorkspace :: TSConfig WorkspaceId
    -> Forest WorkspaceId
    -> (WorkspaceId
        -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
        -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail)
    -> X ()
    treeselectWorkspace TSConfig WorkspaceId
    c Forest WorkspaceId
    xs WorkspaceId
    -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
    -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
    f = do
        -- get all defined workspaces
        -- They have to be set with 'toWorkspaces'!
        ws <- (XState -> [Workspace WorkspaceId (Layout Pixel) Pixel])
    -> X [Workspace WorkspaceId (Layout Pixel) Pixel]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
    -> [Workspace WorkspaceId (Layout Pixel) Pixel]
    forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
    W.workspaces (StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
     -> [Workspace WorkspaceId (Layout Pixel) Pixel])
    -> (XState
        -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail)
    -> XState
    -> [Workspace WorkspaceId (Layout Pixel) Pixel]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet WorkspaceId (Layout Pixel) Pixel ScreenId ScreenDetail
    windowset)

        -- check the 'XConfig.workspaces'
        if all (`elem` map tag ws) (toWorkspaces xs)
          then do
            -- convert the 'Forest WorkspaceId' to 'Forest (TSNode WorkspaceId)'
            wsf <- forMForest (mkPaths xs) $ \(WorkspaceId
    n, WorkspaceId
    i) -> X (TSNode WorkspaceId)
    -> (Workspace WorkspaceId (Layout Pixel) Pixel
        -> X (TSNode WorkspaceId))
    -> Maybe (Workspace WorkspaceId (Layout Pixel) Pixel)
    -> X (TSNode WorkspaceId)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (TSNode WorkspaceId -> X (TSNode WorkspaceId)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WorkspaceId -> WorkspaceId -> WorkspaceId -> TSNode WorkspaceId
    forall a. WorkspaceId -> WorkspaceId -> a -> TSNode a
    TSNode WorkspaceId
    n WorkspaceId
    "Does not exist!" WorkspaceId
    "")) (WorkspaceId
    -> Workspace WorkspaceId (Layout Pixel) Pixel
    -> X (TSNode WorkspaceId)
    forall {a} {l}. WorkspaceId -> Workspace a l Pixel -> X (TSNode a)
    mkNode WorkspaceId
    n) ((Workspace WorkspaceId (Layout Pixel) Pixel -> Bool)
    -> [Workspace WorkspaceId (Layout Pixel) Pixel]
    -> Maybe (Workspace WorkspaceId (Layout Pixel) Pixel)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\Workspace WorkspaceId (Layout Pixel) Pixel
    w -> WorkspaceId
    i WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Workspace WorkspaceId (Layout Pixel) Pixel -> WorkspaceId
    forall i l a. Workspace i l a -> i
    tag Workspace WorkspaceId (Layout Pixel) Pixel
    w) [Workspace WorkspaceId (Layout Pixel) Pixel]
    ws)

            -- get the current workspace path
            me <- gets (W.tag . W.workspace . W.current . windowset)
            hist <- workspaceHistory
            treeselectAt c (fromJust $ followPath tsn_name (splitPath me) $ fromForest wsf) (map splitPath hist) >>= maybe (return ()) (windows . f)

          else liftIO $ do
            -- error!
            let msg = [WorkspaceId] -> WorkspaceId
    unlines ([WorkspaceId] -> WorkspaceId) -> [WorkspaceId] -> WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ [ WorkspaceId
    "Please add:"
                                , WorkspaceId
    "    workspaces = toWorkspaces myWorkspaces"
                                , WorkspaceId
    "to your XMonad config!"
                                , WorkspaceId
    ""
                                , WorkspaceId
    "XConfig.workspaces: "
                                ] [WorkspaceId] -> [WorkspaceId] -> [WorkspaceId]
    forall a. [a] -> [a] -> [a]
    ++ (Workspace WorkspaceId (Layout Pixel) Pixel -> WorkspaceId)
    -> [Workspace WorkspaceId (Layout Pixel) Pixel] -> [WorkspaceId]
    forall a b. (a -> b) -> [a] -> [b]
    map Workspace WorkspaceId (Layout Pixel) Pixel -> WorkspaceId
    forall i l a. Workspace i l a -> i
    tag [Workspace WorkspaceId (Layout Pixel) Pixel]
    ws
            hPutStrLn stderr msg
            xmessage msg
            return ()
      where
        mkNode :: WorkspaceId -> Workspace a l Pixel -> X (TSNode a)
    mkNode WorkspaceId
    n Workspace a l Pixel
    w = do
            -- find the focused window's name on this workspace
            name <- X WorkspaceId
    -> (Stack Pixel -> X WorkspaceId)
    -> Maybe (Stack Pixel)
    -> X WorkspaceId
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (WorkspaceId -> X WorkspaceId
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceId
    "") ((NamedWindow -> WorkspaceId) -> X NamedWindow -> X WorkspaceId
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NamedWindow -> WorkspaceId
    forall a. Show a => a -> WorkspaceId
    show (X NamedWindow -> X WorkspaceId)
    -> (Stack Pixel -> X NamedWindow) -> Stack Pixel -> X WorkspaceId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pixel -> X NamedWindow
    getName (Pixel -> X NamedWindow)
    -> (Stack Pixel -> Pixel) -> Stack Pixel -> X NamedWindow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Stack Pixel -> Pixel
    forall a. Stack a -> a
    W.focus) (Maybe (Stack Pixel) -> X WorkspaceId)
    -> Maybe (Stack Pixel) -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ Workspace a l Pixel -> Maybe (Stack Pixel)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    stack Workspace a l Pixel
    w
            return $ TSNode n name (tag w)

    -- | Convert the workspace-tree to a flat list of paths such that XMonad can use them
    --
    -- The Nodes will be separated by a dot (\'.\') character
    toWorkspaces :: Forest String -> [WorkspaceId]
    toWorkspaces :: Forest WorkspaceId -> [WorkspaceId]
    toWorkspaces = ((WorkspaceId, WorkspaceId) -> WorkspaceId)
    -> [(WorkspaceId, WorkspaceId)] -> [WorkspaceId]
    forall a b. (a -> b) -> [a] -> [b]
    map (WorkspaceId, WorkspaceId) -> WorkspaceId
    forall a b. (a, b) -> b
    snd ([(WorkspaceId, WorkspaceId)] -> [WorkspaceId])
    -> (Forest WorkspaceId -> [(WorkspaceId, WorkspaceId)])
    -> Forest WorkspaceId
    -> [WorkspaceId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree (WorkspaceId, WorkspaceId) -> [(WorkspaceId, WorkspaceId)])
    -> [Tree (WorkspaceId, WorkspaceId)]
    -> [(WorkspaceId, WorkspaceId)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree (WorkspaceId, WorkspaceId) -> [(WorkspaceId, WorkspaceId)]
    forall a. Tree a -> [a]
    flatten ([Tree (WorkspaceId, WorkspaceId)] -> [(WorkspaceId, WorkspaceId)])
    -> (Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)])
    -> Forest WorkspaceId
    -> [(WorkspaceId, WorkspaceId)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)]
    mkPaths

    mkPaths :: Forest String -> Forest (String, WorkspaceId)
    mkPaths :: Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)]
    mkPaths = (Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId))
    -> Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Node WorkspaceId
    n Forest WorkspaceId
    ns) -> (WorkspaceId, WorkspaceId)
    -> [Tree (WorkspaceId, WorkspaceId)]
    -> Tree (WorkspaceId, WorkspaceId)
    forall a. a -> [Tree a] -> Tree a
    Node (WorkspaceId
    n, WorkspaceId
    n) ((Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId))
    -> Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)]
    forall a b. (a -> b) -> [a] -> [b]
    map (WorkspaceId -> Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId)
    f WorkspaceId
    n) Forest WorkspaceId
    ns))
      where
        f :: WorkspaceId -> Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId)
    f WorkspaceId
    pth (Node WorkspaceId
    x Forest WorkspaceId
    xs) = let pth' :: WorkspaceId
    pth' = WorkspaceId
    pth WorkspaceId -> WorkspaceId -> WorkspaceId
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.' Char -> WorkspaceId -> WorkspaceId
    forall a. a -> [a] -> [a]
    : WorkspaceId
    x
                             in (WorkspaceId, WorkspaceId)
    -> [Tree (WorkspaceId, WorkspaceId)]
    -> Tree (WorkspaceId, WorkspaceId)
    forall a. a -> [Tree a] -> Tree a
    Node (WorkspaceId
    x, WorkspaceId
    pth') ((Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId))
    -> Forest WorkspaceId -> [Tree (WorkspaceId, WorkspaceId)]
    forall a b. (a -> b) -> [a] -> [b]
    map (WorkspaceId -> Tree WorkspaceId -> Tree (WorkspaceId, WorkspaceId)
    f WorkspaceId
    pth') Forest WorkspaceId
    xs)

    splitPath :: WorkspaceId -> [String]
    splitPath :: WorkspaceId -> [WorkspaceId]
    splitPath WorkspaceId
    i = case (Char -> Bool) -> WorkspaceId -> (WorkspaceId, WorkspaceId)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') WorkspaceId
    i of
        (WorkspaceId
    x,   []) -> [WorkspaceId
    x]
        (WorkspaceId
    x, Char
    _:WorkspaceId
    xs) -> WorkspaceId
    x WorkspaceId -> [WorkspaceId] -> [WorkspaceId]
    forall a. a -> [a] -> [a]
    : WorkspaceId -> [WorkspaceId]
    splitPath WorkspaceId
    xs

    -- | Select from a Tree of 'X' actions
    --
    -- <<https://wiki.haskell.org/wikiupload/thumb/9/9b/Treeselect-Action.png/800px-Treeselect-Action.png>>
    --
    -- Each of these actions have to be specified inside a 'TSNode'
    --
    -- Example
    --
    -- > treeselectAction myTreeConf
    -- >    [ Node (TSNode "Hello"    "displays hello"      (spawn "xmessage hello!")) []
    -- >    , Node (TSNode "Shutdown" "Poweroff the system" (spawn "shutdown")) []
    -- >    , Node (TSNode "Brightness" "Sets screen brightness using xbacklight" (return ()))
    -- >        [ Node (TSNode "Bright" "FULL POWER!!"            (spawn "xbacklight -set 100")) []
    -- >        , Node (TSNode "Normal" "Normal Brightness (50%)" (spawn "xbacklight -set 50"))  []
    -- >        , Node (TSNode "Dim"    "Quite dark"              (spawn "xbacklight -set 10"))  []
    -- >        ]
    -- >    ]
    treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
    treeselectAction :: forall a. TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
    treeselectAction TSConfig (X a)
    c Forest (TSNode (X a))
    xs = TSConfig (X a) -> Forest (TSNode (X a)) -> X (Maybe (X a))
    forall a. TSConfig a -> Forest (TSNode a) -> X (Maybe a)
    treeselect TSConfig (X a)
    c Forest (TSNode (X a))
    xs X (Maybe (X a)) -> (Maybe (X a) -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just X a
    a  -> X a -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void X a
    a
        Maybe (X a)
    Nothing -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
    forMForest :: forall (m :: * -> *) a b.
    (Functor m, Applicative m, Monad m) =>
    [Tree a] -> (a -> m b) -> m [Tree b]
    forMForest [Tree a]
    x a -> m b
    g = (Tree a -> m (Tree b)) -> [Tree a] -> m [Tree b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((a -> m b) -> Tree a -> m (Tree b)
    forall (m :: * -> *) a b.
    (Functor m, Applicative m, Monad m) =>
    (a -> m b) -> Tree a -> m (Tree b)
    mapMTree a -> m b
    g) [Tree a]
    x

    mapMTree :: (Functor m, Applicative m, Monad m) => (a -> m b) -> Tree a -> m (Tree b)
    mapMTree :: forall (m :: * -> *) a b.
    (Functor m, Applicative m, Monad m) =>
    (a -> m b) -> Tree a -> m (Tree b)
    mapMTree a -> m b
    f (Node a
    x [Tree a]
    xs) = b -> [Tree b] -> Tree b
    forall a. a -> [Tree a] -> Tree a
    Node (b -> [Tree b] -> Tree b) -> m b -> m ([Tree b] -> Tree b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> m b
    f a
    x m ([Tree b] -> Tree b) -> m [Tree b] -> m (Tree b)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>  (Tree a -> m (Tree b)) -> [Tree a] -> m [Tree b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((a -> m b) -> Tree a -> m (Tree b)
    forall (m :: * -> *) a b.
    (Functor m, Applicative m, Monad m) =>
    (a -> m b) -> Tree a -> m (Tree b)
    mapMTree a -> m b
    f) [Tree a]
    xs

    -- | Quit returning the currently selected node
    select :: TreeSelect a (Maybe a)
    select :: forall a. TreeSelect a (Maybe a)
    select = (TSState a -> Maybe a) -> TreeSelect a (Maybe a)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> (TSState a -> a) -> TSState a -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TSNode a -> a
    forall a. TSNode a -> a
    tsn_value (TSNode a -> a) -> (TSState a -> TSNode a) -> TSState a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TreeZipper (TSNode a) -> TSNode a
    forall a. TreeZipper a -> a
    cursor (TreeZipper (TSNode a) -> TSNode a)
    -> (TSState a -> TreeZipper (TSNode a)) -> TSState a -> TSNode a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TSState a -> TreeZipper (TSNode a)
    forall a. TSState a -> TreeZipper (TSNode a)
    tss_tree))

    -- | Quit without returning anything
    cancel :: TreeSelect a (Maybe a)
    cancel :: forall a. TreeSelect a (Maybe a)
    cancel = Maybe a -> TreeSelect a (Maybe a)
    forall a. a -> TreeSelect a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    -- TODO: redraw only what is necessary.
    -- Examples: redrawAboveCursor, redrawBelowCursor and redrawCursor

    -- | Move the cursor to its parent node
    moveParent :: TreeSelect a (Maybe a)
    moveParent :: forall a. TreeSelect a (Maybe a)
    moveParent = (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))
    forall a. TreeZipper a -> Maybe (TreeZipper a)
    parent TreeSelect a () -> TreeSelect a () -> TreeSelect a ()
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a ()
    forall a. TreeSelect a ()
    redraw TreeSelect a () -> TreeSelect a (Maybe a) -> TreeSelect a (Maybe a)
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move the cursor one level down, highlighting its first child-node
    moveChild :: TreeSelect a (Maybe a)
    moveChild :: forall a. TreeSelect a (Maybe a)
    moveChild = (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))
    forall a. TreeZipper a -> Maybe (TreeZipper a)
    children TreeSelect a () -> TreeSelect a () -> TreeSelect a ()
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a ()
    forall a. TreeSelect a ()
    redraw TreeSelect a () -> TreeSelect a (Maybe a) -> TreeSelect a (Maybe a)
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move the cursor to the next child-node
    moveNext :: TreeSelect a (Maybe a)
    moveNext :: forall a. TreeSelect a (Maybe a)
    moveNext = (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))
    forall a. TreeZipper a -> Maybe (TreeZipper a)
    nextChild TreeSelect a () -> TreeSelect a () -> TreeSelect a ()
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a ()
    forall a. TreeSelect a ()
    redraw TreeSelect a () -> TreeSelect a (Maybe a) -> TreeSelect a (Maybe a)
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move the cursor to the previous child-node
    movePrev :: TreeSelect a (Maybe a)
    movePrev :: forall a. TreeSelect a (Maybe a)
    movePrev = (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))
    forall a. TreeZipper a -> Maybe (TreeZipper a)
    previousChild TreeSelect a () -> TreeSelect a () -> TreeSelect a ()
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a ()
    forall a. TreeSelect a ()
    redraw TreeSelect a () -> TreeSelect a (Maybe a) -> TreeSelect a (Maybe a)
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move backwards in history
    moveHistBack :: TreeSelect a (Maybe a)
    moveHistBack :: forall a. TreeSelect a (Maybe a)
    moveHistBack = do
        s <- TreeSelect a (TSState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
        case tss_history s of
            ([[WorkspaceId]]
    xs, [WorkspaceId]
    a:[WorkspaceId]
    y:[[WorkspaceId]]
    ys) -> do
                TSState a -> TreeSelect a ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TSState a
    s{tss_history = (a:xs, y:ys)}
                [WorkspaceId] -> TreeSelect a (Maybe a)
    forall a. [WorkspaceId] -> TreeSelect a (Maybe a)
    moveTo [WorkspaceId]
    y
            ([[WorkspaceId]], [[WorkspaceId]])
    _ -> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move forward in history
    moveHistForward :: TreeSelect a (Maybe a)
    moveHistForward :: forall a. TreeSelect a (Maybe a)
    moveHistForward = do
        s <- TreeSelect a (TSState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
        case tss_history s of
            ([WorkspaceId]
    x:[[WorkspaceId]]
    xs, [[WorkspaceId]]
    ys) -> do
                TSState a -> TreeSelect a ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TSState a
    s{tss_history = (xs, x:ys)}
                [WorkspaceId] -> TreeSelect a (Maybe a)
    forall a. [WorkspaceId] -> TreeSelect a (Maybe a)
    moveTo [WorkspaceId]
    x
            ([[WorkspaceId]], [[WorkspaceId]])
    _ -> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Move to a specific node
    moveTo :: [String] -- ^ path, always starting from the top
           -> TreeSelect a (Maybe a)
    moveTo :: forall a. [WorkspaceId] -> TreeSelect a (Maybe a)
    moveTo [WorkspaceId]
    i = (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith ((TSNode a -> WorkspaceId)
    -> [WorkspaceId]
    -> TreeZipper (TSNode a)
    -> Maybe (TreeZipper (TSNode a))
    forall b a.
    Eq b =>
    (a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a)
    followPath TSNode a -> WorkspaceId
    forall a. TSNode a -> WorkspaceId
    tsn_name [WorkspaceId]
    i (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> (TreeZipper (TSNode a) -> TreeZipper (TSNode a))
    -> TreeZipper (TSNode a)
    -> Maybe (TreeZipper (TSNode a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TreeZipper (TSNode a) -> TreeZipper (TSNode a)
    forall a. TreeZipper a -> TreeZipper a
    rootNode) TreeSelect a () -> TreeSelect a () -> TreeSelect a ()
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a ()
    forall a. TreeSelect a ()
    redraw TreeSelect a () -> TreeSelect a (Maybe a) -> TreeSelect a (Maybe a)
    forall a b. TreeSelect a a -> TreeSelect a b -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TreeSelect a (Maybe a)
    forall a. TreeSelect a (Maybe a)
    navigate

    -- | Apply a transformation on the internal 'XMonad.Util.TreeZipper.TreeZipper'.
    moveWith :: (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))) -> TreeSelect a ()
    moveWith :: forall a.
    (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a)))
    -> TreeSelect a ()
    moveWith TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))
    f = do
        s <- TreeSelect a (TSState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
        case f (tss_tree s) of
            -- TODO: redraw cursor only?
            Just TreeZipper (TSNode a)
    t -> TSState a -> TreeSelect a ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TSState a
    s{ tss_tree = t }
            Maybe (TreeZipper (TSNode a))
    Nothing -> () -> TreeSelect a ()
    forall a. a -> TreeSelect a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | wait for keys and run navigation
    navigate :: TreeSelect a (Maybe a)
    navigate :: forall a. TreeSelect a (Maybe a)
    navigate = (TSState a -> Display) -> TreeSelect a Display
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TSState a -> Display
    forall a. TSState a -> Display
    tss_display TreeSelect a Display
    -> (Display -> TreeSelect a (Maybe a)) -> TreeSelect a (Maybe a)
    forall a b.
    TreeSelect a a -> (a -> TreeSelect a b) -> TreeSelect a b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Display
    d -> TreeSelect a (TreeSelect a (Maybe a)) -> TreeSelect a (Maybe a)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (TreeSelect a (TreeSelect a (Maybe a)) -> TreeSelect a (Maybe a))
    -> ((XEventPtr -> IO (TreeSelect a (Maybe a)))
        -> TreeSelect a (TreeSelect a (Maybe a)))
    -> (XEventPtr -> IO (TreeSelect a (Maybe a)))
    -> TreeSelect a (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (TreeSelect a (Maybe a))
    -> TreeSelect a (TreeSelect a (Maybe a))
    forall a. IO a -> TreeSelect a a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (TreeSelect a (Maybe a))
     -> TreeSelect a (TreeSelect a (Maybe a)))
    -> ((XEventPtr -> IO (TreeSelect a (Maybe a)))
        -> IO (TreeSelect a (Maybe a)))
    -> (XEventPtr -> IO (TreeSelect a (Maybe a)))
    -> TreeSelect a (TreeSelect a (Maybe a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XEventPtr -> IO (TreeSelect a (Maybe a)))
    -> IO (TreeSelect a (Maybe a))
    forall a. (XEventPtr -> IO a) -> IO a
    allocaXEvent ((XEventPtr -> IO (TreeSelect a (Maybe a)))
     -> TreeSelect a (Maybe a))
    -> (XEventPtr -> IO (TreeSelect a (Maybe a)))
    -> TreeSelect a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \XEventPtr
    e -> do
        Display -> Pixel -> XEventPtr -> IO ()
    maskEvent Display
    d (Pixel
    exposureMask Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .|. Pixel
    keyPressMask Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .|. Pixel
    buttonReleaseMask Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .|. Pixel
    buttonPressMask) XEventPtr
    e

        ev <- XEventPtr -> IO Event
    getEvent XEventPtr
    e

        if | ev_event_type ev == keyPress -> do
               ks <- keycodeToKeysym d (ev_keycode ev) 0
               return $ do
                   mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)
                   f <- asks ts_navigate
                   fromMaybe navigate $ M.lookup (mask, ks) f
           | ev_event_type ev == buttonPress -> do
               -- See XMonad.Prompt Note [Allow ButtonEvents]
               allowEvents d replayPointer currentTime
               return navigate
           | otherwise -> return navigate

    -- | Request a full redraw
    redraw :: TreeSelect a ()
    redraw :: forall a. TreeSelect a ()
    redraw = do
        win <- (TSState a -> Pixel) -> TreeSelect a Pixel
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TSState a -> Pixel
    forall a. TSState a -> Pixel
    tss_window
        dpy <- gets tss_display

        -- clear window
        -- TODO: not always needed!
        liftIO $ clearWindow dpy win

        t <- gets tss_tree
        _ <- drawLayers 0 0 (reverse $ (tz_before t, cursor t, tz_after t) : tz_parents t)
        return ()

    drawLayers :: Int -- ^ indentation level
               -> Int -- ^ height
               -> [(Forest (TSNode a), TSNode a, Forest (TSNode a))] -- ^ node layers (from top to bottom!)
               -> TreeSelect a Int
    drawLayers :: forall a.
    Int
    -> Int
    -> [(Forest (TSNode a), TSNode a, Forest (TSNode a))]
    -> TreeSelect a Int
    drawLayers Int
    _ Int
    yl [] = Int -> TreeSelect a Int
    forall a. a -> TreeSelect a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    yl
    drawLayers Int
    xl Int
    yl ((Forest (TSNode a)
    bs, TSNode a
    c, Forest (TSNode a)
    as):[(Forest (TSNode a), TSNode a, Forest (TSNode a))]
    xs) = do
        TSConfig{..} <- TreeSelect a (TSConfig a)
    forall r (m :: * -> *). MonadReader r m => m r
    ask

        let nodeColor a
    y = if a -> Bool
    forall a. Integral a => a -> Bool
    odd a
    y then (Pixel, Pixel)
    ts_node else (Pixel, Pixel)
    ts_nodealt

        -- draw nodes above
        forM_ (zip [yl ..] (reverse bs)) $ \(Int
    y, Node TSNode a
    n Forest (TSNode a)
    _) ->
            Int -> Int -> TSNode a -> (Pixel, Pixel) -> TreeSelect a ()
    forall a.
    Int -> Int -> TSNode a -> (Pixel, Pixel) -> TreeSelect a ()
    drawNode Int
    xl Int
    y TSNode a
    n (Int -> (Pixel, Pixel)
    forall {a}. Integral a => a -> (Pixel, Pixel)
    nodeColor Int
    y)
            -- drawLayers (xl + 1) (y + 1) ns
            -- TODO: draw rest? if not ts_hidechildren
            -- drawLayers (xl + 1) (y + 1) ns

        -- draw the current / parent node
        -- if this is the last (currently focused) we use the 'ts_highlight' color
        let current_level = Int
    yl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Forest (TSNode a) -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Forest (TSNode a)
    bs
        drawNode xl current_level c $
            if null xs then ts_highlight
                       else nodeColor current_level

        l2 <- drawLayers (xl + 1) (current_level + 1) xs

        -- draw nodes below
        forM_ (zip [l2 ..] as) $ \(Int
    y, Node TSNode a
    n Forest (TSNode a)
    _) ->
            Int -> Int -> TSNode a -> (Pixel, Pixel) -> TreeSelect a ()
    forall a.
    Int -> Int -> TSNode a -> (Pixel, Pixel) -> TreeSelect a ()
    drawNode Int
    xl Int
    y TSNode a
    n (Int -> (Pixel, Pixel)
    forall {a}. Integral a => a -> (Pixel, Pixel)
    nodeColor Int
    y)
            -- TODO: draw rest? if not ts_hidechildren
            -- drawLayers (xl + 1) (y + 1) ns
        return (l2 + length as)

    -- | Draw a node at a given indentation and height level
    drawNode :: Int -- ^ indentation level (not in pixels)
             -> Int -- ^ height level (not in pixels)
             -> TSNode a -- ^ node to draw
             -> (Pixel, Pixel) -- ^ node foreground (font) and background color
             -> TreeSelect a ()
    drawNode :: forall a.
    Int -> Int -> TSNode a -> (Pixel, Pixel) -> TreeSelect a ()
    drawNode Int
    ix Int
    iy TSNode{a
    WorkspaceId
    tsn_name :: forall a. TSNode a -> WorkspaceId
    tsn_extra :: forall a. TSNode a -> WorkspaceId
    tsn_value :: forall a. TSNode a -> a
    tsn_name :: WorkspaceId
    tsn_extra :: WorkspaceId
    tsn_value :: a
    ..} (Pixel, Pixel)
    col = do
        TSConfig{..} <- TreeSelect a (TSConfig a)
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        window       <- gets tss_window
        display      <- gets tss_display
        font         <- gets tss_xfont
        gc           <- gets tss_gc
        colormap <- gets tss_colormap
        visual   <- gets tss_visual
        liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
            (ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)
            ts_node_width ts_node_height

        -- TODO: draw extra text (transparent background? or ts_background)
        -- drawWinBox window fnt col2 nodeH (scW-x) (mes) (x+nodeW) y 8

    -- | Draw a simple box with text
    drawWinBox :: Window -> Display -> Visual -> Colormap -> GC -> XMonadFont -> (Pixel, Pixel) -> String -> Pixel -> String -> Int -> Int -> Int -> Int -> IO ()
    drawWinBox :: Pixel
    -> Display
    -> Visual
    -> Pixel
    -> GC
    -> XMonadFont
    -> (Pixel, Pixel)
    -> WorkspaceId
    -> Pixel
    -> WorkspaceId
    -> Int
    -> Int
    -> Int
    -> Int
    -> IO ()
    drawWinBox Pixel
    win Display
    display Visual
    visual Pixel
    colormap GC
    gc XMonadFont
    font (Pixel
    fg, Pixel
    bg) WorkspaceId
    text Pixel
    fg2 WorkspaceId
    text2 Int
    x Int
    y Int
    w Int
    h = do
        -- draw box
        Display -> GC -> Pixel -> IO ()
    setForeground Display
    display GC
    gc Pixel
    bg
        Display
    -> Pixel
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    display Pixel
    win GC
    gc (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    x) (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    y) (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    w) (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    h)

        -- dreaw text
        Display
    -> Pixel
    -> Visual
    -> Pixel
    -> GC
    -> XMonadFont
    -> Pixel
    -> Position
    -> Position
    -> WorkspaceId
    -> IO ()
    drawStringXMF Display
    display Pixel
    win Visual
    visual Pixel
    colormap GC
    gc XMonadFont
    font Pixel
    fg
            (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Position) -> Int -> Position
    forall a b. (a -> b) -> a -> b
    $ Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    8)
            (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Position) -> Int -> Position
    forall a b. (a -> b) -> a -> b
    $ Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8)
            WorkspaceId
    text

        -- dreaw extra text
        Display
    -> Pixel
    -> Visual
    -> Pixel
    -> GC
    -> XMonadFont
    -> Pixel
    -> Position
    -> Position
    -> WorkspaceId
    -> IO ()
    drawStringXMF Display
    display Pixel
    win Visual
    visual Pixel
    colormap GC
    gc XMonadFont
    font Pixel
    fg2
            (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Position) -> Int -> Position
    forall a b. (a -> b) -> a -> b
    $ Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    8)
            (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Position) -> Int -> Position
    forall a b. (a -> b) -> a -> b
    $ Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8)
            WorkspaceId
    text2

    -- | Modified version of 'XMonad.Util.Font.printStringXMF' that uses 'Pixel' as color format
    drawStringXMF :: Display -> Drawable -> Visual -> Colormap -> GC
                  -> XMonadFont -- ^ XMF Font
                  -> Pixel -- ^ font color
                  -> Position   -- ^ x-position
                  -> Position   -- ^ y-position
                  -> String -- ^ string text
                  -> IO ()
    drawStringXMF :: Display
    -> Pixel
    -> Visual
    -> Pixel
    -> GC
    -> XMonadFont
    -> Pixel
    -> Position
    -> Position
    -> WorkspaceId
    -> IO ()
    drawStringXMF Display
    display Pixel
    window Visual
    visual Pixel
    colormap GC
    gc XMonadFont
    font Pixel
    col Position
    x Position
    y WorkspaceId
    text = case XMonadFont
    font of
        Core FontStruct
    fnt -> do
            Display -> GC -> Pixel -> IO ()
    setForeground Display
    display GC
    gc Pixel
    col
            Display -> GC -> Pixel -> IO ()
    setFont Display
    display GC
    gc (Pixel -> IO ()) -> Pixel -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FontStruct -> Pixel
    fontFromFontStruct FontStruct
    fnt
            Display
    -> Pixel -> GC -> Position -> Position -> WorkspaceId -> IO ()
    drawImageString Display
    display Pixel
    window GC
    gc Position
    x Position
    y WorkspaceId
    text
        Utf8 FontSet
    fnt -> do
            Display -> GC -> Pixel -> IO ()
    setForeground Display
    display GC
    gc Pixel
    col
            Display
    -> Pixel
    -> FontSet
    -> GC
    -> Position
    -> Position
    -> WorkspaceId
    -> IO ()
    wcDrawImageString Display
    display Pixel
    window FontSet
    fnt GC
    gc Position
    x Position
    y WorkspaceId
    text
    #ifdef XFT
        Xft NonEmpty XftFont
    fnts -> do
            Display -> Pixel -> Visual -> Pixel -> (XftDraw -> IO ()) -> IO ()
    forall a.
    Display -> Pixel -> Visual -> Pixel -> (XftDraw -> IO a) -> IO a
    withXftDraw Display
    display Pixel
    window Visual
    visual Pixel
    colormap ((XftDraw -> IO ()) -> IO ()) -> (XftDraw -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                \XftDraw
    ft_draw -> Display
    -> Visual -> Pixel -> XRenderColor -> (XftColor -> IO ()) -> IO ()
    forall a.
    Display
    -> Visual -> Pixel -> XRenderColor -> (XftColor -> IO a) -> IO a
    withXftColorValue Display
    display Visual
    visual Pixel
    colormap (Pixel -> XRenderColor
    fromARGB Pixel
    col) ((XftColor -> IO ()) -> IO ()) -> (XftColor -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    #if MIN_VERSION_X11_xft(0, 3, 4)
                \XftColor
    ft_color -> XftDraw
    -> XftColor -> [XftFont] -> Int -> Int -> WorkspaceId -> IO ()
    xftDrawStringFallback XftDraw
    ft_draw XftColor
    ft_color (NonEmpty XftFont -> [XftFont]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty XftFont
    fnts) (Position -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    x) (Position -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    y) WorkspaceId
    text
    #else
                \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text
    #endif

    -- | Convert 'Pixel' to 'XRenderColor'
    --
    -- Note that it uses short to represent its components
    fromARGB :: Pixel -> XRenderColor
    fromARGB :: Pixel -> XRenderColor
    fromARGB Pixel
    x =
    #if MIN_VERSION_X11_xft(0, 3, 3)
        Int -> Int -> Int -> Int -> XRenderColor
    XRenderColor Int
    r Int
    g Int
    b Int
    a
    #else
        -- swapped green/blue as a workaround for the faulty Storable instance in X11-xft < 0.3.3
        XRenderColor r b g a
    #endif
      where
        r :: Int
    r = Pixel -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Pixel -> Int) -> Pixel -> Int
    forall a b. (a -> b) -> a -> b
    $ Pixel
    0xff00 Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .&. Pixel -> Int -> Pixel
    forall a. Bits a => a -> Int -> a
    shiftR Pixel
    x Int
    8
        g :: Int
    g = Pixel -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Pixel -> Int) -> Pixel -> Int
    forall a b. (a -> b) -> a -> b
    $ Pixel
    0xff00 Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .&. Pixel
    x
        b :: Int
    b = Pixel -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Pixel -> Int) -> Pixel -> Int
    forall a b. (a -> b) -> a -> b
    $ Pixel
    0xff00 Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .&. Pixel -> Int -> Pixel
    forall a. Bits a => a -> Int -> a
    shiftL Pixel
    x Int
    8
        a :: Int
    a = Pixel -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Pixel -> Int) -> Pixel -> Int
    forall a b. (a -> b) -> a -> b
    $ Pixel
    0xff00 Pixel -> Pixel -> Pixel
    forall a. Bits a => a -> a -> a
    .&. Pixel -> Int -> Pixel
    forall a. Bits a => a -> Int -> a
    shiftR Pixel
    x Int
    16
    #endif