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

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

masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands :: Int -> [(WorkspaceId, X ())]
masterAreaCommands Int
sid = [ (WorkspaceId
"increase master n", Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall a b. X a -> X b -> X b
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))
                         , (WorkspaceId
"decrease master n", Int -> X ()
activateScreen Int
sid X () -> X () -> X ()
forall a b. X a -> X b -> X b
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 :: [(WorkspaceId, X ())]
quitCommands = [ (WorkspaceId
"quit bluetile", IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ()
forall a. IO a
exitSuccess)
               , (WorkspaceId
"quit bluetile and start metacity", WorkspaceId -> Bool -> X ()
restart WorkspaceId
"metacity" Bool
False)
               ]

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

activateScreen :: Int -> X ()
activateScreen :: Int -> X ()
activateScreen Int
sid = ScreenId -> X (Maybe WorkspaceId)
screenWorkspace (Int -> ScreenId
S Int
sid) X (Maybe WorkspaceId) -> (Maybe WorkspaceId -> 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
>>= (Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ())
-> (WorkspaceId -> X ()) -> Maybe WorkspaceId -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> 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)