    {-# LANGUAGE LambdaCase #-}

    --------------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.Grab
    -- Description :  Utilities for grabbing/ungrabbing keys.
    -- Copyright   :  (c) 2018  L. S. Leary
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  L. S. Leary
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This module should not be directly used by users. Its purpose is to
    -- facilitate grabbing and ungrabbing keys.
    --------------------------------------------------------------------------------

    -- --< Imports & Exports >-- {{{

    module XMonad.Util.Grab
      (
     -- * Usage
     -- $Usage
        grabKP
      , ungrabKP
      , grabUngrab
      , grab
      , customRegrabEvHook
      ) where

    -- core
    import           XMonad                         hiding (mkGrabs)

    import           Control.Monad                  ( when )
    import           Data.Bits                      ( setBit )
    import           Data.Foldable                  ( traverse_ )
    -- base
    import qualified Data.Map.Strict               as M
    import           Data.Semigroup                 ( All(..) )
    import           Data.Traversable               ( for )

    -- }}}

    -- --< Usage >-- {{{

    -- $Usage
    --
    -- This module should not be directly used by users. Its purpose is to
    -- facilitate grabbing and ungrabbing keys.

    -- }}}

    -- --< Public Utils >-- {{{

    -- | A more convenient version of 'grabKey'.
    grabKP :: KeyMask -> KeyCode -> X ()
    grabKP :: KeyMask -> KeyCode -> X ()
    grabKP KeyMask
    mdfr KeyCode
    kc = do
      XConf { display :: XConf -> Display
    display = Display
    dpy, theRoot :: XConf -> KeySym
    theRoot = KeySym
    rootw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display
    -> KeyCode -> KeyMask -> KeySym -> Bool -> CInt -> CInt -> IO ()
    grabKey Display
    dpy KeyCode
    kc KeyMask
    mdfr KeySym
    rootw Bool
    True CInt
    grabModeAsync CInt
    grabModeAsync)

    -- | A more convenient version of 'ungrabKey'.
    ungrabKP :: KeyMask -> KeyCode -> X ()
    ungrabKP :: KeyMask -> KeyCode -> X ()
    ungrabKP KeyMask
    mdfr KeyCode
    kc = do
      XConf { display :: XConf -> Display
    display = Display
    dpy, theRoot :: XConf -> KeySym
    theRoot = KeySym
    rootw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> KeyCode -> KeyMask -> KeySym -> IO ()
    ungrabKey Display
    dpy KeyCode
    kc KeyMask
    mdfr KeySym
    rootw)

    -- | A convenience function to grab and ungrab keys
    grabUngrab
      :: [(KeyMask, KeySym)] -- ^  Keys to grab
      -> [(KeyMask, KeySym)] -- ^ Keys to ungrab
      -> X ()
    grabUngrab :: [(KeyMask, KeySym)] -> [(KeyMask, KeySym)] -> X ()
    grabUngrab [(KeyMask, KeySym)]
    gr [(KeyMask, KeySym)]
    ugr = do
      [(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]
    f <- X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    mkGrabs
      ((KeyMask, KeyCode) -> X ()) -> [(KeyMask, KeyCode)] -> X ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ ((KeyMask -> KeyCode -> X ()) -> (KeyMask, KeyCode) -> X ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry KeyMask -> KeyCode -> X ()
    ungrabKP) ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]
    f [(KeyMask, KeySym)]
    ugr)
      ((KeyMask, KeyCode) -> X ()) -> [(KeyMask, KeyCode)] -> X ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ ((KeyMask -> KeyCode -> X ()) -> (KeyMask, KeyCode) -> X ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry KeyMask -> KeyCode -> X ()
    grabKP)   ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]
    f [(KeyMask, KeySym)]
    gr)

    -- | A convenience function to grab keys. This also ungrabs all
    -- previously grabbed keys.
    grab :: [(KeyMask, KeySym)] -> X ()
    grab :: [(KeyMask, KeySym)] -> X ()
    grab [(KeyMask, KeySym)]
    ks = do
      XConf { display :: XConf -> Display
    display = Display
    dpy, theRoot :: XConf -> KeySym
    theRoot = KeySym
    rootw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> KeyCode -> KeyMask -> KeySym -> IO ()
    ungrabKey Display
    dpy KeyCode
    anyKey KeyMask
    anyModifier KeySym
    rootw)
      [(KeyMask, KeySym)] -> [(KeyMask, KeySym)] -> X ()
    grabUngrab [(KeyMask, KeySym)]
    ks []

    -- | An event hook that runs a custom action to regrab the necessary keys.
    customRegrabEvHook :: X () -> Event -> X All
    customRegrabEvHook :: X () -> Event -> X All
    customRegrabEvHook X ()
    regr = \case
      e :: Event
    e@MappingNotifyEvent{} -> do
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Event -> IO ()
    refreshKeyboardMapping Event
    e)
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Event -> CInt
    ev_request Event
    e CInt -> [CInt] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CInt
    mappingKeyboard, CInt
    mappingModifier])
          (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $  X ()
    setNumlockMask
          X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> X ()
    regr
        All -> X All
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool -> All
    All Bool
    False)
      Event
    _ -> All -> X All
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool -> All
    All Bool
    True)

    -- }}}

    -- --< Private Utils >-- {{{

    -- | Private action shamelessly copied and restyled from XMonad.Main source.
    setNumlockMask :: X ()
    setNumlockMask :: X ()
    setNumlockMask = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
      [(KeyMask, [KeyCode])]
    ms <- IO [(KeyMask, [KeyCode])] -> X [(KeyMask, [KeyCode])]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> IO [(KeyMask, [KeyCode])]
    getModifierMapping Display
    dpy)
      [KeyMask]
    xs <- [X KeyMask] -> X [KeyMask]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence
        [ do
            KeySym
    ks <- IO KeySym -> X KeySym
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> KeyCode -> CInt -> IO KeySym
    keycodeToKeysym Display
    dpy KeyCode
    kc CInt
    0)
            KeyMask -> X KeyMask
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (KeyMask -> X KeyMask) -> KeyMask -> X KeyMask
    forall a b. (a -> b) -> a -> b
    $ if KeySym
    ks KeySym -> KeySym -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeySym
    xK_Num_Lock
              then KeyMask -> Int -> KeyMask
    forall a. Bits a => a -> Int -> a
    setBit KeyMask
    0 (KeyMask -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral KeyMask
    m)
              else KeyMask
    0 :: KeyMask
        | (KeyMask
    m, [KeyCode]
    kcs) <- [(KeyMask, [KeyCode])]
    ms
        , KeyCode
    kc       <- [KeyCode]
    kcs
        , KeyCode
    kc KeyCode -> KeyCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= KeyCode
    0
        ]
      (XState -> XState) -> X ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \XState
    s -> XState
    s { numberlockMask = foldr (.|.) 0 xs }

    -- | Private function shamelessly copied and refactored from XMonad.Main source.
    mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    mkGrabs = (Display -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]))
    -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]))
     -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]))
    -> (Display -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]))
    -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
      let (CInt
    minCode, CInt
    maxCode) = Display -> (CInt, CInt)
    displayKeycodes Display
    dpy
          allCodes :: [KeyCode]
    allCodes           = [CInt -> KeyCode
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    minCode .. CInt -> KeyCode
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    maxCode]
      [KeySym]
    syms <- IO [KeySym] -> X [KeySym]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [KeySym] -> X [KeySym])
    -> ((KeyCode -> IO KeySym) -> IO [KeySym])
    -> (KeyCode -> IO KeySym)
    -> X [KeySym]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [KeyCode] -> (KeyCode -> IO KeySym) -> IO [KeySym]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [KeyCode]
    allCodes ((KeyCode -> IO KeySym) -> X [KeySym])
    -> (KeyCode -> IO KeySym) -> X [KeySym]
    forall a b. (a -> b) -> a -> b
    $ \KeyCode
    code -> Display -> KeyCode -> CInt -> IO KeySym
    keycodeToKeysym Display
    dpy KeyCode
    code CInt
    0
      let keysymMap :: Map KeySym [KeyCode]
    keysymMap = ([KeyCode] -> [KeyCode] -> [KeyCode])
    -> [(KeySym, [KeyCode])] -> Map KeySym [KeyCode]
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith [KeyCode] -> [KeyCode] -> [KeyCode]
    forall a. [a] -> [a] -> [a]
    (++) ([KeySym] -> [[KeyCode]] -> [(KeySym, [KeyCode])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [KeySym]
    syms ([[KeyCode]] -> [(KeySym, [KeyCode])])
    -> [[KeyCode]] -> [(KeySym, [KeyCode])]
    forall a b. (a -> b) -> a -> b
    $ KeyCode -> [KeyCode]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (KeyCode -> [KeyCode]) -> [KeyCode] -> [[KeyCode]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [KeyCode]
    allCodes)
          keysymToKeycodes :: KeySym -> [KeyCode]
    keysymToKeycodes KeySym
    sym = [KeyCode] -> KeySym -> Map KeySym [KeyCode] -> [KeyCode]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] KeySym
    sym Map KeySym [KeyCode]
    keysymMap
      [KeyMask]
    extraMods <- X [KeyMask]
    extraModifiers
      ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
     -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]))
    -> ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    -> X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
    forall a b. (a -> b) -> a -> b
    $ \[(KeyMask, KeySym)]
    ks -> do
        (KeyMask
    mask, KeySym
    sym) <- [(KeyMask, KeySym)]
    ks
        KeyCode
    keycode     <- KeySym -> [KeyCode]
    keysymToKeycodes KeySym
    sym
        KeyMask
    extraMod    <- [KeyMask]
    extraMods
        (KeyMask, KeyCode) -> [(KeyMask, KeyCode)]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (KeyMask
    mask KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    extraMod, KeyCode
    keycode)

    -- }}}

    -- NOTE: there is some duplication between this module and core. The
    -- latter probably will never change, but this needs to be kept in sync
    -- with any potential bugs that might arise.