--------------------------------------------------------------------
-- |
-- Module      : XMonad.Util.CustomKeys
-- Description : Configure key bindings.
-- Copyright   : (c) 2007 Valery V. Vorotyntsev
-- License     : BSD3-style (see LICENSE)
--
-- Customized key bindings.
--
-- See also "XMonad.Util.EZConfig" in xmonad-contrib.
--------------------------------------------------------------------

module XMonad.Util.CustomKeys (
                              -- * Usage
                              -- $usage
                               customKeys
                              , customKeysFrom
                              ) where

import XMonad
import XMonad.Prelude ((<&>))
import Control.Monad.Reader

import qualified Data.Map as M

-- $usage
--
-- In @xmonad.hs@ add:
--
-- > import XMonad.Util.CustomKeys
--
-- Set key bindings with 'customKeys':
--
-- > main = xmonad def { keys = customKeys delkeys inskeys }
-- >     where
-- >       delkeys :: XConfig l -> [(KeyMask, KeySym)]
-- >       delkeys XConfig {modMask = modm} =
-- >           [ (modm .|. shiftMask, xK_Return) -- > terminal
-- >           , (modm .|. shiftMask, xK_c)      -- > close the focused window
-- >           ]
-- >           ++
-- >           [ (modm .|. m, k) | m <- [0, shiftMask], k <- [xK_w, xK_e, xK_r] ]
-- >
-- >       inskeys :: XConfig l -> [((KeyMask, KeySym), X ())]
-- >       inskeys conf@(XConfig {modMask = modm}) =
-- >           [ ((mod1Mask,             xK_F2  ), spawn $ terminal conf) -- mod1-f2 %! Run a terminal emulator
-- >           , ((modm,                 xK_Delete), kill) -- %! Close the focused window
-- >           , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock")
-- >           , ((mod1Mask,             xK_Down), spawn "amixer set Master 1-")
-- >           , ((mod1Mask,             xK_Up  ), spawn "amixer set Master 1+")
-- >           ]

-- | Customize 'XMonad.Config.def' -- delete needless
-- shortcuts and insert those you will use.
customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete
           -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert
           -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
customKeys :: (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
customKeys = XConfig (Choose Tall (Choose (Mirror Tall) Full))
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
customKeysFrom XConfig (Choose Tall (Choose (Mirror Tall) Full))
forall a. Default a => a
def

-- | General variant of 'customKeys': customize key bindings of
-- third-party configuration.
customKeysFrom :: XConfig l -- ^ original configuration
               -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete
               -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert
               -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
customKeysFrom :: forall (l :: * -> *).
XConfig l
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
customKeysFrom XConfig l
conf = (Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
-> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall r a. Reader r a -> r -> a
runReader (Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
 -> XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> ((XConfig Layout -> [((KeyMask, KeySym), X ())])
    -> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ())))
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((XConfig Layout -> [((KeyMask, KeySym), X ())])
  -> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ())))
 -> (XConfig Layout -> [((KeyMask, KeySym), X ())])
 -> XConfig Layout
 -> Map (KeyMask, KeySym) (X ()))
-> ((XConfig Layout -> [(KeyMask, KeySym)])
    -> (XConfig Layout -> [((KeyMask, KeySym), X ())])
    -> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ())))
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall (l :: * -> *).
XConfig l
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
customize XConfig l
conf

customize :: XConfig l
          -> (XConfig Layout -> [(KeyMask, KeySym)])
          -> (XConfig Layout -> [((KeyMask, KeySym), X ())])
          -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ()))
customize :: forall (l :: * -> *).
XConfig l
-> (XConfig Layout -> [(KeyMask, KeySym)])
-> (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
customize XConfig l
conf XConfig Layout -> [(KeyMask, KeySym)]
ds XConfig Layout -> [((KeyMask, KeySym), X ())]
is = (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf) Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
-> (Map (KeyMask, KeySym) (X ())
    -> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ())))
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall a b.
ReaderT (XConfig Layout) Identity a
-> (a -> ReaderT (XConfig Layout) Identity b)
-> ReaderT (XConfig Layout) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (XConfig Layout -> [(KeyMask, KeySym)])
-> Map (KeyMask, KeySym) (X ())
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall r (m :: * -> *) a b.
(MonadReader r m, Ord a) =>
(r -> [a]) -> Map a b -> m (Map a b)
delete XConfig Layout -> [(KeyMask, KeySym)]
ds Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
-> (Map (KeyMask, KeySym) (X ())
    -> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ())))
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall a b.
ReaderT (XConfig Layout) Identity a
-> (a -> ReaderT (XConfig Layout) Identity b)
-> ReaderT (XConfig Layout) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (XConfig Layout -> [((KeyMask, KeySym), X ())])
-> Map (KeyMask, KeySym) (X ())
-> Reader (XConfig Layout) (Map (KeyMask, KeySym) (X ()))
forall r (m :: * -> *) a b.
(MonadReader r m, Ord a) =>
(r -> [(a, b)]) -> Map a b -> m (Map a b)
insert XConfig Layout -> [((KeyMask, KeySym), X ())]
is

delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b)
delete :: forall r (m :: * -> *) a b.
(MonadReader r m, Ord a) =>
(r -> [a]) -> Map a b -> m (Map a b)
delete r -> [a]
dels Map a b
kmap = (r -> [a]) -> m [a]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> [a]
dels m [a] -> ([a] -> Map a b) -> m (Map a b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a -> Map a b -> Map a b) -> Map a b -> [a] -> Map a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Map a b -> Map a b
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Map a b
kmap

insert :: (MonadReader r m, Ord a) =>
          (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b)
insert :: forall r (m :: * -> *) a b.
(MonadReader r m, Ord a) =>
(r -> [(a, b)]) -> Map a b -> m (Map a b)
insert r -> [(a, b)]
ins Map a b
kmap = (r -> [(a, b)]) -> m [(a, b)]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> [(a, b)]
ins m [(a, b)] -> ([(a, b)] -> Map a b) -> m (Map a b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((a, b) -> Map a b -> Map a b) -> Map a b -> [(a, b)] -> Map a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> b -> Map a b -> Map a b) -> (a, b) -> Map a b -> Map a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Map a b -> Map a b
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert) Map a b
kmap