----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.BluetileCommands
-- 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 XMonad.Layout.LayoutCombinators
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 sid :: 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
>>= \spaces :: [String]
spaces -> [(String, X ())] -> X [(String, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return
                            [(("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 sid :: Int
sid = [ ("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 "Floating"))
                     , ("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 "Tiled1"))
                     , ("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 "Tiled2"))
                     , ("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 "Fullscreen"))
                     ]

masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands sid :: Int
sid = [ ("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 1))
                         , ("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 (-1)))
                         ]

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

bluetileCommands :: X [(String, X ())]
bluetileCommands :: X [(String, X ())]
bluetileCommands = do
    let restartCommand :: [(String, X ())]
restartCommand = [ ("restart bluetile", String -> Bool -> X ()
restart "bluetile" Bool
True) ]
    [(String, X ())]
wscmds0 <- Int -> X [(String, X ())]
workspaceCommands 0
    [(String, X ())]
wscmds1 <- Int -> X [(String, X ())]
workspaceCommands 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 0 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
masterAreaCommands 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 1 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ Int -> [(String, X ())]
masterAreaCommands 1 [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
quitCommands

activateScreen :: Int -> X ()
activateScreen :: Int -> X ()
activateScreen sid :: 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)