    {-# LANGUAGE FlexibleContexts #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.Prefix
    -- Description :  Use an Emacs-style prefix argument for commands.
    -- Copyright   :  (c) Matus Goljer <matus.goljer@gmail.com>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Matus Goljer <matus.goljer@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A module that allows the user to use a prefix argument (raw or numeric).
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.Prefix
           (
          -- * Usage
          -- $usage

          -- * Installation
          -- $installation

             PrefixArgument(..)
           , usePrefixArgument
           , useDefaultPrefixArgument
           , withPrefixArgument
           , isPrefixRaw
           , isPrefixNumeric
           , orIfPrefixed
           , ppFormatPrefix
           ) where

    import qualified Data.Map as M

    import XMonad.Prelude
    import XMonad
    import XMonad.Util.ExtensibleState as XS
    import XMonad.Util.Paste (sendKey)
    import XMonad.Actions.Submap (submapDefaultWithKey)
    import XMonad.Util.EZConfig (readKeySequence)
    import qualified Data.List.NonEmpty as NE
    import Data.List.NonEmpty ((<|))

    {- $usage

    This module implements Emacs-style prefix argument.  The argument
    comes in two flavours, 'Raw' and 'Numeric'.

    To initiate the "prefix mode" you hit the prefix keybinding (default
    C-u).  This sets the Raw argument value to 1.  Repeatedly hitting this
    key increments the raw value by 1.  The Raw argument is usually used
    as a toggle, changing the behaviour of the function called in some way.

    An example might be calling "mpc add" to add new song to the playlist,
    but with C-u we also clean up the playlist beforehand.

    When in the "Raw mode", you can hit numeric keys 0..9 (with no
    modifier) to enter a "Numeric argument".  Numeric argument represents
    a natural number.  Hitting numeric keys in sequence produces the
    decimal number that would result from typing them.  That is, the
    sequence C-u 4 2 sets the Numeric argument value to the number 42.

    If you have a function which understands the prefix argument, for example:

    >    addMaybeClean :: PrefixArgument -> X ()
    >    addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"
    >    addMaybeClean _ = spawn "mpc add <file>"

    you can turn it into an X action with the function 'withPrefixArgument'.

    Binding it in your config

    >    ((modm, xK_a), withPrefixArgument addMaybeClean)

    Hitting MOD-a will add the @\<file\>@ to the playlist while C-u MOD-a will
    clear the playlist and then add the file.

    You can of course use an anonymous action, like so:

    >    ((modm, xK_a), withPrefixArgument $ \prefix -> do
    >        case prefix of ...
    >    )

    If the prefix key is followed by a binding which is unknown to XMonad,
    the prefix along with that binding is sent to the active window.

    There is one caveat: when you use an application which has a nested
    C-u binding, for example C-c C-u in Emacs org-mode, you have to hit
    C-g (or any other non-recognized key really) to get out of the "xmonad
    grab" and let the C-c C-u be sent to the application.

    -}

    {- $installation

    The simplest way to enable this is to use 'useDefaultPrefixArgument'

    >    xmonad $ useDefaultPrefixArgument $ def { .. }

    The default prefix argument is C-u.  If you want to customize the
    prefix argument, 'usePrefixArgument' can be used:

    >    xmonad $ usePrefixArgument "M-u" $ def { .. }

    where the key is entered in Emacs style (or "XMonad.Util.EZConfig"
    style) notation.  The letter `M` stands for your chosen modifier.  The
    function defaults to C-u if the argument could not be parsed.
    -}

    data PrefixArgument = Raw Int | Numeric Int | None
                          deriving (ReadPrec [PrefixArgument]
    ReadPrec PrefixArgument
    Int -> ReadS PrefixArgument
    ReadS [PrefixArgument]
    (Int -> ReadS PrefixArgument)
    -> ReadS [PrefixArgument]
    -> ReadPrec PrefixArgument
    -> ReadPrec [PrefixArgument]
    -> Read PrefixArgument
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS PrefixArgument
    readsPrec :: Int -> ReadS PrefixArgument
    $creadList :: ReadS [PrefixArgument]
    readList :: ReadS [PrefixArgument]
    $creadPrec :: ReadPrec PrefixArgument
    readPrec :: ReadPrec PrefixArgument
    $creadListPrec :: ReadPrec [PrefixArgument]
    readListPrec :: ReadPrec [PrefixArgument]
    Read, Int -> PrefixArgument -> ShowS
    [PrefixArgument] -> ShowS
    PrefixArgument -> String
    (Int -> PrefixArgument -> ShowS)
    -> (PrefixArgument -> String)
    -> ([PrefixArgument] -> ShowS)
    -> Show PrefixArgument
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PrefixArgument -> ShowS
    showsPrec :: Int -> PrefixArgument -> ShowS
    $cshow :: PrefixArgument -> String
    show :: PrefixArgument -> String
    $cshowList :: [PrefixArgument] -> ShowS
    showList :: [PrefixArgument] -> ShowS
    Show)
    instance ExtensionClass PrefixArgument where
      initialValue :: PrefixArgument
    initialValue = PrefixArgument
    None
      extensionType :: PrefixArgument -> StateExtension
    extensionType = PrefixArgument -> StateExtension
    forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
    PersistentExtension

    -- | Run 'job' in the 'X' monad and then execute 'cleanup'.  In case
    -- of exception, 'cleanup' is executed anyway.
    --
    -- Return the return value of 'job'.
    finallyX :: X a -> X a -> X a
    finallyX :: forall a. X a -> X a -> X a
    finallyX X a
    job X a
    cleanup = X a -> X a -> X a
    forall a. X a -> X a -> X a
    catchX (X a
    job X a -> (a -> X a) -> X a
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    r -> X a
    cleanup X a -> X a -> X a
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> a -> X a
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r) X a
    cleanup

    -- | Set up Prefix.  Defaults to C-u when given an invalid key.
    --
    -- See usage section.
    usePrefixArgument :: LayoutClass l Window
                      => String
                      -> XConfig l
                      -> XConfig l
    usePrefixArgument :: forall (l :: * -> *).
    LayoutClass l Window =>
    String -> XConfig l -> XConfig l
    usePrefixArgument String
    prefix XConfig l
    conf =
      XConfig l
    conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }
     where
      binding :: (ButtonMask, Window)
    binding = case XConfig l -> String -> Maybe (NonEmpty (ButtonMask, Window))
    forall (l :: * -> *).
    XConfig l -> String -> Maybe (NonEmpty (ButtonMask, Window))
    readKeySequence XConfig l
    conf String
    prefix of
        Just ((ButtonMask, Window)
    key :| []) -> (ButtonMask, Window)
    key
        Maybe (NonEmpty (ButtonMask, Window))
    _                -> (ButtonMask
    controlMask, Window
    xK_u)

    -- | Set Prefix up with default prefix key (C-u).
    useDefaultPrefixArgument :: LayoutClass l Window
                             => XConfig l
                             -> XConfig l
    useDefaultPrefixArgument :: forall (l :: * -> *).
    LayoutClass l Window =>
    XConfig l -> XConfig l
    useDefaultPrefixArgument = String -> XConfig l -> XConfig l
    forall (l :: * -> *).
    LayoutClass l Window =>
    String -> XConfig l -> XConfig l
    usePrefixArgument String
    "C-u"

    handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()
    handlePrefixArg :: NonEmpty (ButtonMask, Window) -> X ()
    handlePrefixArg NonEmpty (ButtonMask, Window)
    events = do
      Map (ButtonMask, Window) (X ())
    ks <- (XConf -> Map (ButtonMask, Window) (X ()))
    -> X (Map (ButtonMask, Window) (X ()))
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Map (ButtonMask, Window) (X ())
    keyActions
      X ()
    logger <- (XConf -> X ()) -> X (X ())
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> X ()
    forall (l :: * -> *). XConfig l -> X ()
    logHook (XConfig Layout -> X ())
    -> (XConf -> XConfig Layout) -> XConf -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
      (X () -> X () -> X ()) -> X () -> X () -> X ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip X () -> X () -> X ()
    forall a. X a -> X a -> X a
    finallyX (PrefixArgument -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put PrefixArgument
    None 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 ()
    logger) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        PrefixArgument
    prefix <- X PrefixArgument
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
        case PrefixArgument
    prefix of
          Raw Int
    a -> PrefixArgument -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (PrefixArgument -> X ()) -> PrefixArgument -> X ()
    forall a b. (a -> b) -> a -> b
    $ Int -> PrefixArgument
    Raw (Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
          PrefixArgument
    None -> PrefixArgument -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (PrefixArgument -> X ()) -> PrefixArgument -> X ()
    forall a b. (a -> b) -> a -> b
    $ Int -> PrefixArgument
    Raw Int
    1
          PrefixArgument
    _ -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        X ()
    logger
        ((ButtonMask, Window) -> X ())
    -> Map (ButtonMask, Window) (X ()) -> X ()
    submapDefaultWithKey (ButtonMask, Window) -> X ()
    defaultKey Map (ButtonMask, Window) (X ())
    ks
      where defaultKey :: (ButtonMask, Window) -> X ()
    defaultKey key :: (ButtonMask, Window)
    key@(ButtonMask
    m, Window
    k) =
              if Window
    k Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Window
    xK_0 Window -> [Window] -> [Window]
    forall a. a -> [a] -> [a]
    : [Window
    xK_1 .. Window
    xK_9]) Bool -> Bool -> Bool
    && ButtonMask
    m ButtonMask -> ButtonMask -> Bool
    forall a. Eq a => a -> a -> Bool
    == ButtonMask
    noModMask
              then do
                PrefixArgument
    prefix <- X PrefixArgument
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
                let x :: Int
    x = Maybe Int -> Int
    forall a. HasCallStack => Maybe a -> a
    fromJust (Window -> [(Window, Int)] -> Maybe Int
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    Prelude.lookup Window
    k [(Window, Int)]
    keyToNum)
                case PrefixArgument
    prefix of
                  Raw Int
    _ -> PrefixArgument -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (PrefixArgument -> X ()) -> PrefixArgument -> X ()
    forall a b. (a -> b) -> a -> b
    $ Int -> PrefixArgument
    Numeric Int
    x
                  Numeric Int
    a -> PrefixArgument -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (PrefixArgument -> X ()) -> PrefixArgument -> X ()
    forall a b. (a -> b) -> a -> b
    $ Int -> PrefixArgument
    Numeric (Int -> PrefixArgument) -> Int -> PrefixArgument
    forall a b. (a -> b) -> a -> b
    $ Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x
                  PrefixArgument
    None -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- should never happen
                NonEmpty (ButtonMask, Window) -> X ()
    handlePrefixArg ((ButtonMask, Window)
    key (ButtonMask, Window)
    -> NonEmpty (ButtonMask, Window) -> NonEmpty (ButtonMask, Window)
    forall a. a -> NonEmpty a -> NonEmpty a
    <| NonEmpty (ButtonMask, Window)
    events)
              else do
                PrefixArgument
    prefix <- X PrefixArgument
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
                ((ButtonMask, Window) -> X ()) -> [(ButtonMask, Window)] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((ButtonMask -> Window -> X ()) -> (ButtonMask, Window) -> X ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ButtonMask -> Window -> X ()
    sendKey) ([(ButtonMask, Window)] -> X ()) -> [(ButtonMask, Window)] -> X ()
    forall a b. (a -> b) -> a -> b
    $ case PrefixArgument
    prefix of
                  Raw Int
    a -> Int -> (ButtonMask, Window) -> [(ButtonMask, Window)]
    forall a. Int -> a -> [a]
    replicate Int
    a (NonEmpty (ButtonMask, Window) -> (ButtonMask, Window)
    forall a. NonEmpty a -> a
    NE.head NonEmpty (ButtonMask, Window)
    events) [(ButtonMask, Window)]
    -> [(ButtonMask, Window)] -> [(ButtonMask, Window)]
    forall a. [a] -> [a] -> [a]
    ++ [(ButtonMask, Window)
    key]
                  PrefixArgument
    _ -> [(ButtonMask, Window)] -> [(ButtonMask, Window)]
    forall a. [a] -> [a]
    reverse ((ButtonMask, Window)
    key (ButtonMask, Window)
    -> [(ButtonMask, Window)] -> [(ButtonMask, Window)]
    forall a. a -> [a] -> [a]
    : NonEmpty (ButtonMask, Window)
    -> [Item (NonEmpty (ButtonMask, Window))]
    forall l. IsList l => l -> [Item l]
    toList NonEmpty (ButtonMask, Window)
    events)
            keyToNum :: [(Window, Int)]
    keyToNum = (Window
    xK_0, Int
    0) (Window, Int) -> [(Window, Int)] -> [(Window, Int)]
    forall a. a -> [a] -> [a]
    : [Window] -> [Int] -> [(Window, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Window
    xK_1 .. Window
    xK_9] [Int
    1..Int
    9]

    -- | Turn a prefix-aware X action into an X-action.
    --
    -- First, fetch the current prefix, then pass it as argument to the
    -- original function.  You should use this to "run" your commands.
    withPrefixArgument :: (PrefixArgument -> X a) -> X a
    withPrefixArgument :: forall a. (PrefixArgument -> X a) -> X a
    withPrefixArgument = X PrefixArgument -> (PrefixArgument -> X a) -> X a
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=) X PrefixArgument
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get

    -- | Test if 'PrefixArgument' is 'Raw' or not.
    isPrefixRaw :: PrefixArgument -> Bool
    isPrefixRaw :: PrefixArgument -> Bool
    isPrefixRaw (Raw Int
    _) = Bool
    True
    isPrefixRaw PrefixArgument
    _ = Bool
    False

    -- | Test if 'PrefixArgument' is 'Numeric' or not.
    isPrefixNumeric :: PrefixArgument -> Bool
    isPrefixNumeric :: PrefixArgument -> Bool
    isPrefixNumeric (Numeric Int
    _) = Bool
    True
    isPrefixNumeric PrefixArgument
    _ = Bool
    False

    -- | Execute the first action, unless any prefix argument is given,
    -- in which case the second action is chosen instead.
    --
    -- > action1 `orIfPrefixed` action2
    orIfPrefixed :: X a -> X a -> X a
    orIfPrefixed :: forall a. X a -> X a -> X a
    orIfPrefixed X a
    xa X a
    xb = (PrefixArgument -> X a) -> X a
    forall a. (PrefixArgument -> X a) -> X a
    withPrefixArgument ((PrefixArgument -> X a) -> X a) -> (PrefixArgument -> X a) -> X a
    forall a b. (a -> b) -> a -> b
    $ X a -> X a -> Bool -> X a
    forall a. a -> a -> Bool -> a
    bool X a
    xa X a
    xb (Bool -> X a) -> (PrefixArgument -> Bool) -> PrefixArgument -> X a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrefixArgument -> Bool
    isPrefixRaw

    -- | Format the prefix using the Emacs convetion for use in a
    -- statusbar, like xmobar.
    --
    -- To add this formatted prefix to printer output, you can set it up
    -- like so
    --
    -- > myPrinter :: PP
    -- > myPrinter = def { ppExtras = [ppFormatPrefix] }
    --
    -- And then add to your status bar using "XMonad.Hooks.StatusBar":
    --
    -- > mySB = statusBarProp "xmobar" myPrinter
    -- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
    --
    -- Or, directly in your 'logHook' configuration
    --
    -- > logHook = dynamicLogWithPP myPrinter
    ppFormatPrefix :: X (Maybe String)
    ppFormatPrefix :: X (Maybe String)
    ppFormatPrefix = do
      PrefixArgument
    prefix <- X PrefixArgument
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      Maybe String -> X (Maybe String)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String -> X (Maybe String))
    -> Maybe String -> X (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ case PrefixArgument
    prefix of
        Raw Int
    n -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ (String -> ShowS) -> [String] -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\String
    a String
    b -> String
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    b) ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> [String]
    forall a. Int -> a -> [a]
    replicate Int
    n String
    "C-u"
        Numeric Int
    n -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String
    "C-u " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n
        PrefixArgument
    None -> Maybe String
    forall a. Maybe a
    Nothing