    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving, TupleSections #-}
    --------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.NamedActions
    -- Description :  A wrapper for keybinding configuration that can list the available keybindings.
    -- Copyright   :  2009 Adam Vogt <vogt.adam@gmail.com>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Adam Vogt <vogt.adam@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A wrapper for keybinding configuration that can list the available
    -- keybindings.
    --
    -- Note that xmonad>=0.11 has by default a list of the default keybindings
    -- bound to @M-S-/@ or @M-?@.
    --------------------------------------------------------------------

    module XMonad.Util.NamedActions (
        -- * Usage:
        -- $usage
        sendMessage',
        spawn',
        submapName,
        addDescrKeys,
        addDescrKeys',
        xMessage,

        showKmSimple,
        showKm,

        noName,
        oneName,
        addName,

        separator,
        subtitle,

        (^++^),

        NamedAction(..),
        HasName,
        defaultKeysDescr
        ) where

    import XMonad.Actions.Submap(submap)
    import XMonad.Prelude (groupBy, keyToString)
    import XMonad
    import Control.Arrow(Arrow((&&&), second))
    import System.Exit(exitSuccess)

    import qualified Data.Map as M
    import qualified XMonad.StackSet as W

    -- $usage
    -- Here is an example config that demonstrates the usage of 'sendMessage'',
    -- 'mkNamedKeymap', 'addDescrKeys', and '^++^'
    --
    -- > import XMonad
    -- > import XMonad.Util.NamedActions
    -- > import XMonad.Util.EZConfig
    -- >
    -- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys
    -- >                    def { modMask = mod4Mask }
    -- >
    -- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $
    -- >    [("M-x a", addName "useless message" $ spawn "xmessage foo"),
    -- >     ("M-c", sendMessage' Expand)]
    -- >     ^++^
    -- >    [("<XF86AudioPlay>", spawn "mpc toggle" :: X ()),
    -- >     ("<XF86AudioNext>", spawn "mpc next")]
    --
    -- Using '^++^', you can combine bindings whose actions are @X ()@
    -- as well as actions that have descriptions. However you cannot mix the two in
    -- a single list, unless each is prefixed with 'addName' or 'noName'.
    --
    -- If you don't like EZConfig, you can still use '^++^' with the basic XMonad
    -- keybinding configuration too.
    --
    -- Also note the unfortunate necessity of a type annotation, since 'spawn' is
    -- too general.

    -- TODO: squeeze titles that have no entries (consider titles containing \n)
    --
    -- Output to Multiple columns
    --
    -- Devin Mullin's suggestions:
    --
    -- Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a
    -- HasName context (and leave mkKeymap as a specific case of it?)
    --    Currently kept separate to aid error messages, common lines factored out
    --
    -- Suggestions for UI:
    --
    -- - An IO () -> IO () that wraps the main xmonad action and wrests control
    --   from it if the user asks for --keys.
    --
    -- Just a separate binary: keep this as the only way to show keys for simplicity
    --
    -- - An X () that toggles a cute little overlay like the ? window for gmail
    --   and reader.
    --
    -- Add dzen binding

    deriving instance Show XMonad.Resize
    deriving instance Show XMonad.IncMasterN

    -- | 'sendMessage' but add a description that is @show message@. Note that not
    -- all messages have show instances.
    sendMessage' :: (Message a, Show a) => a -> NamedAction
    sendMessage' :: forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' a
    x = (X (), String) -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction (a -> X ()
    forall a. Message a => a -> X ()
    XMonad.sendMessage a
    x,a -> String
    forall a. Show a => a -> String
    show a
    x)

    -- | 'spawn' but the description is the string passed
    spawn' :: String -> NamedAction
    spawn' :: String -> NamedAction
    spawn' String
    x = String -> X () -> NamedAction
    addName String
    x (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn String
    x

    class HasName a where
        {-# MINIMAL getAction #-}
        showName :: a -> [String]
        showName = [String] -> a -> [String]
    forall a b. a -> b -> a
    const [String
    ""]
        getAction :: a -> X ()

    instance HasName (X ()) where
        getAction :: X () -> X ()
    getAction = X () -> X ()
    forall a. a -> a
    id

    instance HasName (IO ()) where
        getAction :: IO () -> X ()
    getAction = IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io

    instance HasName [Char] where
        getAction :: String -> X ()
    getAction String
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        showName :: String -> [String]
    showName = (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[])

    instance HasName (X (),String) where
        showName :: (X (), String) -> [String]
    showName = (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[]) (String -> [String])
    -> ((X (), String) -> String) -> (X (), String) -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (X (), String) -> String
    forall a b. (a, b) -> b
    snd
        getAction :: (X (), String) -> X ()
    getAction = (X (), String) -> X ()
    forall a b. (a, b) -> a
    fst

    instance HasName (X (),[String]) where
        showName :: (X (), [String]) -> [String]
    showName = (X (), [String]) -> [String]
    forall a b. (a, b) -> b
    snd
        getAction :: (X (), [String]) -> X ()
    getAction = (X (), [String]) -> X ()
    forall a b. (a, b) -> a
    fst

    -- show only the outermost description
    instance HasName (NamedAction,String) where
        showName :: (NamedAction, String) -> [String]
    showName = (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[]) (String -> [String])
    -> ((NamedAction, String) -> String)
    -> (NamedAction, String)
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NamedAction, String) -> String
    forall a b. (a, b) -> b
    snd
        getAction :: (NamedAction, String) -> X ()
    getAction = NamedAction -> X ()
    forall a. HasName a => a -> X ()
    getAction (NamedAction -> X ())
    -> ((NamedAction, String) -> NamedAction)
    -> (NamedAction, String)
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NamedAction, String) -> NamedAction
    forall a b. (a, b) -> a
    fst

    instance HasName NamedAction where
        showName :: NamedAction -> [String]
    showName (NamedAction a
    x) = a -> [String]
    forall a. HasName a => a -> [String]
    showName a
    x
        getAction :: NamedAction -> X ()
    getAction (NamedAction a
    x) = a -> X ()
    forall a. HasName a => a -> X ()
    getAction a
    x

    -- | An existential wrapper so that different types can be combined in lists,
    -- and maps
    data NamedAction = forall a. HasName a => NamedAction a

    -- | 'submap', but propagate the descriptions of the actions. Does this belong
    -- in "XMonad.Actions.Submap"?
    submapName :: (HasName a) => [((KeyMask, KeySym), a)] -> NamedAction
    submapName :: forall a. HasName a => [((KeyMask, KeySym), a)] -> NamedAction
    submapName = (X (), [String]) -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction ((X (), [String]) -> NamedAction)
    -> ([((KeyMask, KeySym), a)] -> (X (), [String]))
    -> [((KeyMask, KeySym), a)]
    -> NamedAction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map (KeyMask, KeySym) (X ()) -> X ()
    submap (Map (KeyMask, KeySym) (X ()) -> X ())
    -> ([((KeyMask, KeySym), NamedAction)]
        -> Map (KeyMask, KeySym) (X ()))
    -> [((KeyMask, KeySym), NamedAction)]
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NamedAction -> X ())
    -> Map (KeyMask, KeySym) NamedAction
    -> Map (KeyMask, KeySym) (X ())
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map NamedAction -> X ()
    forall a. HasName a => a -> X ()
    getAction (Map (KeyMask, KeySym) NamedAction -> Map (KeyMask, KeySym) (X ()))
    -> ([((KeyMask, KeySym), NamedAction)]
        -> Map (KeyMask, KeySym) NamedAction)
    -> [((KeyMask, KeySym), NamedAction)]
    -> Map (KeyMask, KeySym) (X ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [((KeyMask, KeySym), NamedAction)]
    -> Map (KeyMask, KeySym) NamedAction
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, KeySym), NamedAction)] -> X ())
    -> ([((KeyMask, KeySym), NamedAction)] -> [String])
    -> [((KeyMask, KeySym), NamedAction)]
    -> (X (), [String])
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& [((KeyMask, KeySym), NamedAction)] -> [String]
    showKm)
                    ([((KeyMask, KeySym), NamedAction)] -> (X (), [String]))
    -> ([((KeyMask, KeySym), a)] -> [((KeyMask, KeySym), NamedAction)])
    -> [((KeyMask, KeySym), a)]
    -> (X (), [String])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((KeyMask, KeySym), a) -> ((KeyMask, KeySym), NamedAction))
    -> [((KeyMask, KeySym), a)] -> [((KeyMask, KeySym), NamedAction)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> NamedAction)
    -> ((KeyMask, KeySym), a) -> ((KeyMask, KeySym), NamedAction)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second a -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction)

    -- | Combine keymap lists with actions that may or may not have names
    (^++^) :: (HasName b, HasName b1) =>
         [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
    [(d, b)]
    a ^++^ :: forall b b1 d.
    (HasName b, HasName b1) =>
    [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
    ^++^ [(d, b1)]
    b = ((d, b) -> (d, NamedAction)) -> [(d, b)] -> [(d, NamedAction)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b -> NamedAction) -> (d, b) -> (d, NamedAction)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second b -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction) [(d, b)]
    a [(d, NamedAction)] -> [(d, NamedAction)] -> [(d, NamedAction)]
    forall a. [a] -> [a] -> [a]
    ++ ((d, b1) -> (d, NamedAction)) -> [(d, b1)] -> [(d, NamedAction)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b1 -> NamedAction) -> (d, b1) -> (d, NamedAction)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second b1 -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction) [(d, b1)]
    b

    showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]]
    showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [String]
    showKmSimple = (((KeyMask, KeySym), NamedAction) -> [String])
    -> [((KeyMask, KeySym), NamedAction)] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\((KeyMask, KeySym)
    k,NamedAction
    e) -> if (KeyMask, KeySym) -> KeySym
    forall a b. (a, b) -> b
    snd (KeyMask, KeySym)
    k KeySym -> KeySym -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeySym
    0 then String
    ""String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :NamedAction -> [String]
    forall a. HasName a => a -> [String]
    showName NamedAction
    e else ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (((KeyMask, KeySym) -> String
    keyToString (KeyMask, KeySym)
    k String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    smartSpace) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ NamedAction -> [String]
    forall a. HasName a => a -> [String]
    showName NamedAction
    e)

    smartSpace :: String -> String
    smartSpace :: ShowS
    smartSpace [] = []
    smartSpace String
    xs = Char
    ' 'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    xs

    _test :: String
    _test :: String
    _test = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [((KeyMask, KeySym), NamedAction)] -> [String]
    showKm ([((KeyMask, KeySym), NamedAction)] -> [String])
    -> [((KeyMask, KeySym), NamedAction)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    defaultKeysDescr XConfig (Choose Tall (Choose (Mirror Tall) Full))
    forall a. Default a => a
    XMonad.def { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.def }

    showKm :: [((KeyMask, KeySym), NamedAction)] -> [String]
    showKm :: [((KeyMask, KeySym), NamedAction)] -> [String]
    showKm [((KeyMask, KeySym), NamedAction)]
    keybindings = [(String, String)] -> [String]
    padding ([(String, String)] -> [String]) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ do
        ((KeyMask, KeySym)
    k,NamedAction
    e) <- [((KeyMask, KeySym), NamedAction)]
    keybindings
        if (KeyMask, KeySym) -> KeySym
    forall a b. (a, b) -> b
    snd (KeyMask, KeySym)
    k KeySym -> KeySym -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeySym
    0 then (String -> (String, String)) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "",) ([String] -> [(String, String)]) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ NamedAction -> [String]
    forall a. HasName a => a -> [String]
    showName NamedAction
    e
            else (String -> (String, String)) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((,) ((KeyMask, KeySym) -> String
    keyToString (KeyMask, KeySym)
    k) (String -> (String, String)) -> ShowS -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    smartSpace) ([String] -> [(String, String)]) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ NamedAction -> [String]
    forall a. HasName a => a -> [String]
    showName NamedAction
    e
        where padding :: [(String, String)] -> [String]
    padding = let pad :: Int -> (String, String) -> String
    pad Int
    n (String
    k,String
    e) = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    k then String
    "\n>> "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    e else Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    n (String
    kString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Char -> String
    forall a. a -> [a]
    repeat Char
    ' ') String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    e
                            expand :: [(String, String)] -> Int -> [String]
    expand [(String, String)]
    xs Int
    n = ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> (String, String) -> String
    pad Int
    n) [(String, String)]
    xs
                            getMax :: [[([a], b)]] -> [Int]
    getMax = ([([a], b)] -> Int) -> [[([a], b)]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> ([([a], b)] -> [Int]) -> [([a], b)] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([a], b) -> Int) -> [([a], b)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> Int) -> (([a], b) -> [a]) -> ([a], b) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([a], b) -> [a]
    forall a b. (a, b) -> a
    fst))
                in [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String])
    -> ([(String, String)] -> [[String]])
    -> [(String, String)]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([(String, String)] -> Int -> [String])
    -> [[(String, String)]] -> [Int] -> [[String]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [(String, String)] -> Int -> [String]
    expand ([[(String, String)]] -> [Int] -> [[String]])
    -> ([[(String, String)]] -> [Int])
    -> [[(String, String)]]
    -> [[String]]
    forall a b.
    ([[(String, String)]] -> a -> b)
    -> ([[(String, String)]] -> a) -> [[(String, String)]] -> b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [[(String, String)]] -> [Int]
    forall {a} {b}. [[([a], b)]] -> [Int]
    getMax) ([[(String, String)]] -> [[String]])
    -> ([(String, String)] -> [[(String, String)]])
    -> [(String, String)]
    -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, String) -> (String, String) -> Bool)
    -> [(String, String)] -> [[(String, String)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (((String, String) -> Bool)
    -> (String, String) -> (String, String) -> Bool
    forall a b. a -> b -> a
    const (((String, String) -> Bool)
     -> (String, String) -> (String, String) -> Bool)
    -> ((String, String) -> Bool)
    -> (String, String)
    -> (String, String)
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool)
    -> ((String, String) -> Bool) -> (String, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (String -> Bool)
    -> ((String, String) -> String) -> (String, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> a
    fst)

    -- | An action to send to 'addDescrKeys' for showing the keybindings. See also 'showKm' and 'showKmSimple'
    xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
    xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
    xMessage [((KeyMask, KeySym), NamedAction)]
    x = String -> X () -> NamedAction
    addName String
    "Show Keybindings" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    xmessage (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [((KeyMask, KeySym), NamedAction)] -> [String]
    showKm [((KeyMask, KeySym), NamedAction)]
    x

    -- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding
    -- to run an action for showing the keybindings.
    addDescrKeys :: (HasName b1, HasName b) =>
        ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b)
        -> (XConfig Layout -> [((KeyMask, KeySym), b1)])
        -> XConfig l
        -> XConfig l
    addDescrKeys :: forall b1 b (l :: * -> *).
    (HasName b1, HasName b) =>
    ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    -> (XConfig Layout -> [((KeyMask, KeySym), b1)])
    -> XConfig l
    -> XConfig l
    addDescrKeys ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    k XConfig Layout -> [((KeyMask, KeySym), b1)]
    ks = ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)])
    -> XConfig l
    -> XConfig l
    forall b (l :: * -> *).
    HasName b =>
    ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)])
    -> XConfig l
    -> XConfig l
    addDescrKeys' ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    k (\XConfig Layout
    l -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    defaultKeysDescr XConfig Layout
    l [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), b1)] -> [((KeyMask, KeySym), NamedAction)]
    forall b b1 d.
    (HasName b, HasName b1) =>
    [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
    ^++^ XConfig Layout -> [((KeyMask, KeySym), b1)]
    ks XConfig Layout
    l)

    -- | Without merging with 'defaultKeysDescr'
    addDescrKeys' :: (HasName b) =>
        ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b)
        -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)]) -> XConfig l -> XConfig l
    addDescrKeys' :: forall b (l :: * -> *).
    HasName b =>
    ((KeyMask, KeySym), [((KeyMask, KeySym), NamedAction)] -> b)
    -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)])
    -> XConfig l
    -> XConfig l
    addDescrKeys' ((KeyMask, KeySym)
    k,[((KeyMask, KeySym), NamedAction)] -> b
    f) XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    ks XConfig l
    conf =
        let shk :: XConfig Layout -> b
    shk XConfig Layout
    l = [((KeyMask, KeySym), NamedAction)] -> b
    f ([((KeyMask, KeySym), NamedAction)] -> b)
    -> [((KeyMask, KeySym), NamedAction)] -> b
    forall a b. (a -> b) -> a -> b
    $ [((KeyMask, KeySym)
    k,[((KeyMask, KeySym), NamedAction)] -> b
    f ([((KeyMask, KeySym), NamedAction)] -> b)
    -> [((KeyMask, KeySym), NamedAction)] -> b
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    ks XConfig Layout
    l)] [((KeyMask, KeySym), b)]
    -> [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    forall b b1 d.
    (HasName b, HasName b1) =>
    [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
    ^++^ XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    ks XConfig Layout
    l
            keylist :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
    keylist XConfig Layout
    l = (NamedAction -> X ())
    -> Map (KeyMask, KeySym) NamedAction
    -> Map (KeyMask, KeySym) (X ())
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map NamedAction -> X ()
    forall a. HasName a => a -> X ()
    getAction (Map (KeyMask, KeySym) NamedAction -> Map (KeyMask, KeySym) (X ()))
    -> Map (KeyMask, KeySym) NamedAction
    -> Map (KeyMask, KeySym) (X ())
    forall a b. (a -> b) -> a -> b
    $ [((KeyMask, KeySym), NamedAction)]
    -> Map (KeyMask, KeySym) NamedAction
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, KeySym), NamedAction)]
     -> Map (KeyMask, KeySym) NamedAction)
    -> [((KeyMask, KeySym), NamedAction)]
    -> Map (KeyMask, KeySym) NamedAction
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    ks XConfig Layout
    l [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), b)] -> [((KeyMask, KeySym), NamedAction)]
    forall b b1 d.
    (HasName b, HasName b1) =>
    [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
    ^++^ [((KeyMask, KeySym)
    k, XConfig Layout -> b
    shk XConfig Layout
    l)]
         in XConfig l
    conf { keys = keylist <> keys conf }

    -- | A version of the default keys from the default configuration, but with
    -- 'NamedAction'  instead of @X ()@
    defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
    defaultKeysDescr conf :: XConfig Layout
    conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
    XMonad.modMask = KeyMask
    modm} =
        [ String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "launching and killing programs"
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_Return), String -> X () -> NamedAction
    addName String
    "Launch Terminal" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> String
    forall (l :: * -> *). XConfig l -> String
    XMonad.terminal XConfig Layout
    conf) -- %! Launch terminal
        , ((KeyMask
    modm,               KeySym
    xK_p     ), String -> X () -> NamedAction
    addName String
    "Launch dmenu" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn String
    "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_p     ), String -> X () -> NamedAction
    addName String
    "Launch gmrun" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn String
    "gmrun") -- %! Launch gmrun
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_c     ), String -> X () -> NamedAction
    addName String
    "Close the focused window" X ()
    kill) -- %! Close the focused window

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "changing layouts"
        , ((KeyMask
    modm,               KeySym
    xK_space ), ChangeLayout -> NamedAction
    forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' ChangeLayout
    NextLayout) -- %! Rotate through the available layout algorithms
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_space ), String -> X () -> NamedAction
    addName String
    "Reset the layout" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ Layout KeySym -> X ()
    setLayout (Layout KeySym -> X ()) -> Layout KeySym -> X ()
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> Layout KeySym
    forall (l :: * -> *). XConfig l -> l KeySym
    XMonad.layoutHook XConfig Layout
    conf) -- %!  Reset the layouts on the current workspace to default

        , ((KeyMask, KeySym), NamedAction)
    separator
        , ((KeyMask
    modm,               KeySym
    xK_n     ), String -> X () -> NamedAction
    addName String
    "Refresh" X ()
    refresh) -- %! Resize viewed windows to the correct size

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "move focus up or down the window stack"
        , ((KeyMask
    modm,               KeySym
    xK_Tab   ), String -> X () -> NamedAction
    addName String
    "Focus down" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusDown) -- %! Move focus to the next window
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_Tab   ), String -> X () -> NamedAction
    addName String
    "Focus up"   (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusUp  ) -- %! Move focus to the previous window
        , ((KeyMask
    modm,               KeySym
    xK_j     ), String -> X () -> NamedAction
    addName String
    "Focus down" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusDown) -- %! Move focus to the next window
        , ((KeyMask
    modm,               KeySym
    xK_k     ), String -> X () -> NamedAction
    addName String
    "Focus up"   (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusUp  ) -- %! Move focus to the previous window
        , ((KeyMask
    modm,               KeySym
    xK_m     ), String -> X () -> NamedAction
    addName String
    "Focus the master" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusMaster  ) -- %! Move focus to the master window

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "modifying the window order"
        , ((KeyMask
    modm,               KeySym
    xK_Return), String -> X () -> NamedAction
    addName String
    "Swap with the master" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.swapMaster) -- %! Swap the focused window and the master window
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_j     ), String -> X () -> NamedAction
    addName String
    "Swap down" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.swapDown  ) -- %! Swap the focused window with the next window
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_k     ), String -> X () -> NamedAction
    addName String
    "Swap up"   (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.swapUp    ) -- %! Swap the focused window with the previous window

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "resizing the master/slave ratio"
        , ((KeyMask
    modm,               KeySym
    xK_h     ), Resize -> NamedAction
    forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' Resize
    Shrink) -- %! Shrink the master area
        , ((KeyMask
    modm,               KeySym
    xK_l     ), Resize -> NamedAction
    forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' Resize
    Expand) -- %! Expand the master area

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "floating layer support"
        , ((KeyMask
    modm,               KeySym
    xK_t     ), String -> X () -> NamedAction
    addName String
    "Push floating to tiled" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (KeySym -> X ()) -> X ()
    withFocused ((KeySym -> X ()) -> X ()) -> (KeySym -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (KeySym -> WindowSet -> WindowSet) -> KeySym -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeySym -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.sink) -- %! Push window back into tiling

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "change the number of windows in the master area"
        , ((KeyMask
    modm              , KeySym
    xK_comma ), IncMasterN -> NamedAction
    forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' (Int -> IncMasterN
    IncMasterN Int
    1)) -- %! Increment the number of windows in the master area
        , ((KeyMask
    modm              , KeySym
    xK_period), IncMasterN -> NamedAction
    forall a. (Message a, Show a) => a -> NamedAction
    sendMessage' (Int -> IncMasterN
    IncMasterN (-Int
    1))) -- %! Deincrement the number of windows in the master area

        , String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "quit, or restart"
        , ((KeyMask
    modm KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    shiftMask, KeySym
    xK_q     ), String -> X () -> NamedAction
    addName String
    "Quit" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO ()
    forall a. IO a
    exitSuccess) -- %! Quit xmonad
        , ((KeyMask
    modm              , KeySym
    xK_q     ), String -> X () -> NamedAction
    addName String
    "Restart" (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn String
    "xmonad --recompile && xmonad --restart") -- %! Restart xmonad
        ]

        -- mod-[1..9] %! Switch to workspace N
        -- mod-shift-[1..9] %! Move client to workspace N
        [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    forall a. [a] -> [a] -> [a]
    ++
        String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "switching workspaces"((KeyMask, KeySym), NamedAction)
    -> [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    forall a. a -> [a] -> [a]
    :
        [((KeyMask
    m KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    modm, KeySym
    k), String -> X () -> NamedAction
    addName (String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    i) (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> WindowSet -> WindowSet
    f String
    i)
            | (String -> WindowSet -> WindowSet
    f, KeyMask
    m, String
    n) <- [(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, KeyMask
    0, String
    "Switch to workspace "), (String -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.shift, KeyMask
    shiftMask, String
    "Move client to workspace ")]
            , (String
    i, KeySym
    k) <- [String] -> [KeySym] -> [(String, KeySym)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (XConfig Layout -> [String]
    forall (l :: * -> *). XConfig l -> [String]
    XMonad.workspaces XConfig Layout
    conf) [KeySym
    xK_1 .. KeySym
    xK_9]]
        -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
        -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3
       [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    forall a. [a] -> [a] -> [a]
    ++
       String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    "switching screens" ((KeyMask, KeySym), NamedAction)
    -> [((KeyMask, KeySym), NamedAction)]
    -> [((KeyMask, KeySym), NamedAction)]
    forall a. a -> [a] -> [a]
    :
       [((KeyMask
    m KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    modm, KeySym
    key), String -> X () -> NamedAction
    addName (String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ScreenId -> String
    forall a. Show a => a -> String
    show ScreenId
    sc) (X () -> NamedAction) -> X () -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ ScreenId -> X (Maybe String)
    screenWorkspace ScreenId
    sc X (Maybe String) -> (Maybe String -> 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 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
    f))
            | (String -> WindowSet -> WindowSet
    f, KeyMask
    m, String
    n) <- [(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, KeyMask
    0, String
    "Switch to screen number "), (String -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.shift, KeyMask
    shiftMask, String
    "Move client to screen number ")]
            , (KeySym
    key, ScreenId
    sc) <- [KeySym] -> [ScreenId] -> [(KeySym, ScreenId)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [KeySym
    xK_w, KeySym
    xK_e, KeySym
    xK_r] [ScreenId
    0..]]

    -- | For a prettier presentation: keymask, keysym of 0 are reserved for this
    -- purpose: they do not happen, afaik, and keysymToString 0 would raise an
    -- error otherwise
    separator :: ((KeyMask,KeySym), NamedAction)
    separator :: ((KeyMask, KeySym), NamedAction)
    separator = ((KeyMask
    0,KeySym
    0), (X (), [String]) -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction (() -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () :: X (),[] :: [String]))

    subtitle ::  String -> ((KeyMask, KeySym), NamedAction)
    subtitle :: String -> ((KeyMask, KeySym), NamedAction)
    subtitle String
    x = ((KeyMask
    0,KeySym
    0), String -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction (String -> NamedAction) -> String -> NamedAction
    forall a b. (a -> b) -> a -> b
    $ String
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":")

    -- | These are just the @NamedAction@ constructor but with a more specialized
    -- type, so that you don't have to supply any annotations, for ex coercing
    -- spawn to @X ()@ from the more general @MonadIO m => m ()@
    noName :: X () -> NamedAction
    noName :: X () -> NamedAction
    noName = X () -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction

    oneName :: (X (), String) -> NamedAction
    oneName :: (X (), String) -> NamedAction
    oneName = (X (), String) -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction

    addName :: String -> X () -> NamedAction
    addName :: String -> X () -> NamedAction
    addName = (X () -> String -> NamedAction) -> String -> X () -> NamedAction
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (((X (), String) -> NamedAction) -> X () -> String -> NamedAction
    forall a b c. ((a, b) -> c) -> a -> b -> c
    curry (X (), String) -> NamedAction
    forall a. HasName a => a -> NamedAction
    NamedAction)