    ----------------------------------------------------------------------------
    -- |
    -- 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)