-------------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.ClickableWorkspaces
-- Description :  Make workspace tags clickable in XMobar (for switching focus).
-- Copyright   :  (c) Geoff deRosenroll <geoffderosenroll@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Geoff deRosenroll <geoffderosenroll@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides @clickablePP@, which when applied to the 'PP' pretty-printer used
-- by "XMonad.Hooks.StatusBar" will make the workspace tags clickable in
-- XMobar (for switching focus).
--
-----------------------------------------------------------------------------

module XMonad.Util.ClickableWorkspaces (
  -- * Usage
  -- $usage
  clickablePP,
  clickableWrap,
  ) where

import XMonad.Prelude ((<&>), (>=>))
import XMonad
import XMonad.Hooks.StatusBar.PP (xmobarAction, PP(..))
import XMonad.Util.WorkspaceCompare (getSortByIndex)
import qualified XMonad.StackSet as W
import Data.List (elemIndex)

-- $usage
-- If you're using the "XMonad.Hooks.StatusBar" interface, apply 'clickablePP'
-- to the 'PP' passed to 'XMonad.Hooks.StatusBar.statusBarProp':
--
-- > mySB <- statusBarProp "xmobar" (clickablePP xmobarPP)
--
-- Or if you're using the old "XMonad.Hooks.DynamicLog" interface:
--
-- > logHook = clickablePP xmobarPP { ... } >>= dynamicLogWithPP
--
-- Requirements:
--
--   * @xdotool@ on system (in path)
--   * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup)
--   * use of UnsafeStdinReader\/UnsafeXMonadLog in xmobarrc (rather than StdinReader\/XMonadLog)
--
-- Note that UnsafeStdinReader is potentially dangerous if your workspace
-- names are dynamically generated from untrusted input (like window titles).
-- You may need to add @xmobarRaw@ to 'ppRename' before applying
-- 'clickablePP' in such case.

-- | Wrap string with an xmobar action that uses @xdotool@ to switch to
-- workspace @i@.
clickableWrap :: Int -> String -> String
clickableWrap :: Int -> WorkspaceId -> WorkspaceId
clickableWrap Int
i = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarAction (WorkspaceId
"xdotool set_desktop " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show Int
i) WorkspaceId
"1"

-- | 'XMonad.Util.WorkspaceCompare.getWsIndex' extended to handle workspaces
-- not in the static 'workspaces' config, such as those created by
-- "XMonad.Action.DynamicWorkspaces".
--
-- Uses 'getSortByIndex', as that's what "XMonad.Hooks.EwmhDesktops" uses to
-- export the information to tools like @xdotool@. (Note that EwmhDesktops can
-- be configured with a custom sort function, and we don't handle that here
-- yet.)
getWsIndex :: X (WorkspaceId -> Maybe Int)
getWsIndex :: X (WorkspaceId -> Maybe Int)
getWsIndex = do
    WorkspaceSort
wSort <- X WorkspaceSort
getSortByIndex
    [WorkspaceId]
spaces <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag ([WindowSpace] -> [WorkspaceId])
-> (XState -> [WindowSpace]) -> XState -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
wSort WorkspaceSort
-> (XState -> [WindowSpace]) -> XState -> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [WindowSpace])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
    (WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int))
-> (WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int)
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [WorkspaceId] -> Maybe Int)
-> [WorkspaceId] -> WorkspaceId -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> [WorkspaceId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [WorkspaceId]
spaces

-- | Return a function that wraps workspace names in an xmobar action that
-- switches to that workspace.
--
-- This assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook'
-- isn't configured to change the workspace order. We might need to add an
-- additional parameter if anyone needs that.
getClickable :: X (String -> WindowSpace -> String)
getClickable :: X (WorkspaceId -> WindowSpace -> WorkspaceId)
getClickable = X (WorkspaceId -> Maybe Int)
getWsIndex X (WorkspaceId -> Maybe Int)
-> ((WorkspaceId -> Maybe Int)
    -> WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> Maybe Int
idx WorkspaceId
s WindowSpace
w -> (WorkspaceId -> WorkspaceId)
-> (Int -> WorkspaceId -> WorkspaceId)
-> Maybe Int
-> WorkspaceId
-> WorkspaceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkspaceId -> WorkspaceId
forall a. a -> a
id Int -> WorkspaceId -> WorkspaceId
clickableWrap (WorkspaceId -> Maybe Int
idx (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
w)) WorkspaceId
s

-- | Apply clickable wrapping to the given PP.
clickablePP :: PP -> X PP
clickablePP :: PP -> X PP
clickablePP PP
pp = X (WorkspaceId -> WindowSpace -> WorkspaceId)
getClickable X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> ((WorkspaceId -> WindowSpace -> WorkspaceId) -> PP) -> X PP
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> WindowSpace -> WorkspaceId
ren -> PP
pp{ ppRename :: WorkspaceId -> WindowSpace -> WorkspaceId
ppRename = PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename PP
pp (WorkspaceId -> WindowSpace -> WorkspaceId)
-> (WorkspaceId -> WindowSpace -> WorkspaceId)
-> WorkspaceId
-> WindowSpace
-> WorkspaceId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> WorkspaceId -> WindowSpace -> WorkspaceId
ren }