----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.BluetileCommands
-- Description :  Interface with the [Bluetile](https://hackage.haskell.org/package/bluetile) tiling window manager.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- This is a list of selected commands that can be made available using
-- "XMonad.Hooks.ServerMode" to allow external programs to control
-- the window manager. Bluetile (<http://projects.haskell.org/bluetile/>)
-- uses this to enable its dock application to do things like changing
-- workspaces and layouts.
--
-----------------------------------------------------------------------------

module XMonad.Actions.BluetileCommands (
    -- * Usage
    -- $usage
    bluetileCommands
    ) where

import XMonad
import qualified XMonad.StackSet as W
import System.Exit

-- $usage
--
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- >    import XMonad.Hooks.ServerMode
-- >    import XMonad.Actions.BluetileCommands
--
-- Then edit your @handleEventHook@:
--
-- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands }
--
-- See the documentation of "XMonad.Hooks.ServerMode" for details on
-- how to actually invoke the commands from external programs.

workspaceCommands :: Int -> X [(String, X ())]
workspaceCommands :: Int -> X [(String, X ())]
workspaceCommands Int
sid = (XConf -> [String]) -> X [String]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> [String]
forall (l :: * -> *). XConfig l -> [String]
workspaces (XConfig Layout -> [String])
-> (XConf -> XConfig Layout) -> XConf -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X [String]
-> ([String] -> X [(String, X ())]) -> X [(String, X ())]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String]
spaces -> [(String, X ())] -> X [(String, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return
                            [( String
"greedyView" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
i,
                                Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows (String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView String
i))
                                | String
i <- [String]
spaces ]

layoutCommands :: Int -> [(String, X ())]
layoutCommands :: Int -> [(String, X ())]
layoutCommands Int
sid = [ (String
"layout floating"    , Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    JumpToLayout -> X ()
forall a. Message a => a -> X ()
sendMessage (String -> JumpToLayout
JumpToLayout String
"Floating"))
                     , (String
"layout tiled1"      , Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    JumpToLayout -> X ()
forall a. Message a => a -> X ()
sendMessage (String -> JumpToLayout
JumpToLayout String
"Tiled1"))
                     , (String
"layout tiled2"      , Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    JumpToLayout -> X ()
forall a. Message a => a -> X ()
sendMessage (String -> JumpToLayout
JumpToLayout String
"Tiled2"))
                     , (String
"layout fullscreen"  , Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    JumpToLayout -> X ()
forall a. Message a => a -> X ()
sendMessage (String -> JumpToLayout
JumpToLayout String
"Fullscreen"))
                     ]

masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands Int
sid = [ (String
"increase master n", Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    IncMasterN -> X ()
forall a. Message a => a -> X ()
sendMessage (Int -> IncMasterN
IncMasterN Int
1))
                         , (String
"decrease master n", Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                                    IncMasterN -> X ()
forall a. Message a => a -> X ()
sendMessage (Int -> IncMasterN
IncMasterN (-Int
1)))
                         ]

quitCommands :: [(String, X ())]
quitCommands :: [(String, X ())]
quitCommands = [ (String
"quit bluetile", IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ()
forall a. IO a
exitSuccess)
               , (String
"quit bluetile and start metacity", String -> Bool -> X ()
restart String
"metacity" Bool
False)
               ]

bluetileCommands :: X [(String, X ())]
bluetileCommands :: X [(String, X ())]
bluetileCommands = do
    let restartCommand :: [(String, X ())]
restartCommand = [ (String
"restart bluetile", String -> Bool -> X ()
restart String
"bluetile" Bool
True) ]
    [(String, X ())]
wscmds0 <- Int -> X [(String, X ())]
workspaceCommands Int
0
    [(String, X ())]
wscmds1 <- Int -> X [(String, X ())]
workspaceCommands Int
1
    [(String, X ())] -> X [(String, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, X ())] -> X [(String, X ())])
-> [(String, X ())] -> X [(String, X ())]
forall a b. (a -> b) -> a -> b
$ [(String, X ())]
restartCommand
                [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
wscmds0 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
layoutCommands Int
0 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
masterAreaCommands Int
0 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
quitCommands
                [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
wscmds1 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
layoutCommands Int
1 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
masterAreaCommands Int
1 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
quitCommands

activateScreen :: Int -> X ()
activateScreen :: Int -> X ()
activateScreen Int
sid = ScreenId -> X (Maybe String)
screenWorkspace (Int -> ScreenId
S Int
sid) X (Maybe String) -> (Maybe String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (String -> WindowSet -> WindowSet) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view)