    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.ServerMode
    -- Description :  Send commands to a running xmonad process.
    -- Copyright   :  (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  polson2@hawk.iit.edu
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This is an 'EventHook' that will receive commands from an external
    -- client. Also consider "XMonad.Hooks.EwmhDesktops" together with
    -- @wmctrl@.
    --
    -- See @scripts/xmonadctl.hs@ for the client.
    --
    -----------------------------------------------------------------------------

    module XMonad.Hooks.ServerMode
        ( -- * Usage
          -- $usage
          serverModeEventHook
        , serverModeEventHook'
        , serverModeEventHookCmd
        , serverModeEventHookCmd'
        , serverModeEventHookF
        ) where

    import System.IO

    import XMonad
    import XMonad.Prelude
    import XMonad.Actions.Commands

    -- $usage
    -- You can use this module with the following in your
    -- @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Hooks.ServerMode
    --
    -- Then edit your @handleEventHook@ by adding the appropriate event hook from below

    -- | Executes a command of the list when receiving its index via a special ClientMessageEvent
    -- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers
    -- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default.
    --
    -- > main = xmonad def { handleEventHook = serverModeEventHook }
    --
    -- > xmonadctl 0 # tells xmonad to output command list
    -- > xmonadctl 1 # tells xmonad to switch to workspace 1
    --
    serverModeEventHook :: Event -> X All
    serverModeEventHook :: Event -> X All
    serverModeEventHook = X [(String, X ())] -> Event -> X All
    serverModeEventHook' X [(String, X ())]
    defaultCommands

    -- | serverModeEventHook' additionally takes an action to generate the list of
    -- commands.
    serverModeEventHook' :: X [(String,X ())] -> Event -> X All
    serverModeEventHook' :: X [(String, X ())] -> Event -> X All
    serverModeEventHook' X [(String, X ())]
    cmdAction = String -> (String -> X ()) -> Event -> X All
    serverModeEventHookF String
    "XMONAD_COMMAND" ((String -> X ()) -> [String] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> X ()
    helper ([String] -> X ()) -> (String -> [String]) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words)
            where helper :: String -> X ()
    helper String
    cmd = do [(String, X ())]
    cl <- X [(String, X ())]
    cmdAction
                                  case String -> [(String, (String, X ()))] -> Maybe (String, X ())
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    cmd ([String] -> [(String, X ())] -> [(String, (String, X ()))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((Integer -> String) -> [Integer] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> String
    forall a. Show a => a -> String
    show [Integer
    1 :: Integer ..]) [(String, X ())]
    cl) of
                                    Just (String
    _,X ()
    action) -> X ()
    action
                                    Maybe (String, X ())
    Nothing         -> (String -> X ()) -> [String] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> (String -> IO ()) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Handle -> String -> IO ()
    hPutStrLn Handle
    stderr) ([String] -> X ())
    -> ([(String, X ())] -> [String]) -> [(String, X ())] -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, X ())] -> [String]
    forall {b}. [(String, b)] -> [String]
    listOfCommands ([(String, X ())] -> X ()) -> [(String, X ())] -> X ()
    forall a b. (a -> b) -> a -> b
    $ [(String, X ())]
    cl
                  listOfCommands :: [(String, b)] -> [String]
    listOfCommands [(String, b)]
    cl = (String -> String -> String) -> [String] -> [String] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) ((Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> String
    forall a. Show a => a -> String
    show [Int
    1 :: Int ..]) (((String, b) -> String) -> [(String, b)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) String
    " - " (String -> String)
    -> ((String, b) -> String) -> (String, b) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, b) -> String
    forall a b. (a, b) -> a
    fst) [(String, b)]
    cl)

    -- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
    -- Uses "XMonad.Actions.Commands#defaultCommands" as the default.
    --
    -- > main = xmonad def { handleEventHook = serverModeEventHookCmd }
    --
    -- > xmonadctl run # Tells xmonad to generate a run prompt
    --
    serverModeEventHookCmd :: Event -> X All
    serverModeEventHookCmd :: Event -> X All
    serverModeEventHookCmd = X [(String, X ())] -> Event -> X All
    serverModeEventHookCmd' X [(String, X ())]
    defaultCommands

    -- | Additionally takes an action to generate the list of commands
    serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
    serverModeEventHookCmd' :: X [(String, X ())] -> Event -> X All
    serverModeEventHookCmd' X [(String, X ())]
    cmdAction = String -> (String -> X ()) -> Event -> X All
    serverModeEventHookF String
    "XMONAD_COMMAND" ((String -> X ()) -> [String] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> X ()
    helper ([String] -> X ()) -> (String -> [String]) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words)
            where helper :: String -> X ()
    helper String
    cmd = do [(String, X ())]
    cl <- X [(String, X ())]
    cmdAction
                                  X () -> Maybe (X ()) -> X ()
    forall a. a -> Maybe a -> a
    fromMaybe (IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Couldn't find command " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cmd)) (String -> [(String, X ())] -> Maybe (X ())
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    cmd [(String, X ())]
    cl)

    -- | Listens for an atom, then executes a callback function whenever it hears it.
    -- A trivial example that prints everything supplied to it on xmonad's standard out:
    --
    -- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) }
    --
    -- > xmonadctl -a XMONAD_PRINT "hello world"
    --
    serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
    serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
    serverModeEventHookF String
    key String -> X ()
    func ClientMessageEvent {ev_message_type :: Event -> Atom
    ev_message_type = Atom
    mt, ev_data :: Event -> [CInt]
    ev_data = [CInt]
    dt} = do
            Display
    d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
            Atom
    atm <- IO Atom -> X Atom
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Atom -> X Atom) -> IO Atom -> X Atom
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> Bool -> IO Atom
    internAtom Display
    d String
    key Bool
    False
            Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Atom
    mt Atom -> Atom -> Bool
    forall a. Eq a => a -> a -> Bool
    == Atom
    atm Bool -> Bool -> Bool
    && [CInt]
    dt [CInt] -> [CInt] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
             let atom :: Atom
    atom = CInt -> Atom
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([CInt] -> CInt
    forall a. HasCallStack => [a] -> a
    head [CInt]
    dt)
             Maybe String
    cmd <- IO (Maybe String) -> X (Maybe String)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe String) -> X (Maybe String))
    -> IO (Maybe String) -> X (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ Display -> Atom -> IO (Maybe String)
    getAtomName Display
    d Atom
    atom
             case Maybe String
    cmd of
                  Just String
    command -> String -> X ()
    func String
    command
                  Maybe String
    Nothing -> IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Couldn't retrieve atom " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Atom -> String
    forall a. Show a => a -> String
    show Atom
    atom)
            All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    serverModeEventHookF String
    _ String -> X ()
    _ Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)