-------------------------------------------------------------------------------
-- |
-- 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 -> String -> String
clickableWrap Int
i = String -> String -> String -> String
xmobarAction (String
"xdotool set_desktop " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) String
"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 (String -> Maybe Int)
getWsIndex = do
    WorkspaceSort
wSort <- X WorkspaceSort
getSortByIndex
    [String]
spaces <- (XState -> [String]) -> X [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Workspace String (Layout Window) Window -> String)
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
W.tag ([Workspace String (Layout Window) Window] -> [String])
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
wSort WorkspaceSort
-> (XState -> [Workspace String (Layout Window) Window])
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace String (Layout Window) Window])
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
    (String -> Maybe Int) -> X (String -> Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Maybe Int) -> X (String -> Maybe Int))
-> (String -> Maybe Int) -> X (String -> Maybe Int)
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> Maybe Int)
-> [String] -> String -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [String]
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 (String -> Workspace String (Layout Window) Window -> String)
getClickable = X (String -> Maybe Int)
getWsIndex X (String -> Maybe Int)
-> ((String -> Maybe Int)
    -> String -> Workspace String (Layout Window) Window -> String)
-> X (String -> Workspace String (Layout Window) Window -> String)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String -> Maybe Int
idx String
s Workspace String (Layout Window) Window
w -> (String -> String)
-> (Int -> String -> String) -> Maybe Int -> String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id Int -> String -> String
clickableWrap (String -> Maybe Int
idx (Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
W.tag Workspace String (Layout Window) Window
w)) String
s

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