{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Config.Prime
-- Description :  Draft of a brand new config syntax for xmonad.
-- Copyright   :  Devin Mullins <devin.mullins@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Devin Mullins <devin.mullins@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a draft of a brand new config syntax for xmonad. It aims to be:
--
--  * easier to copy/paste snippets from the docs
--
--  * easier to get the gist for what's going on, for you imperative programmers
--
-- It's brand new, so it's pretty much guaranteed to break or change syntax.
-- But what's the worst that could happen? Xmonad crashes and logs you out?
-- It probably won't do that. Give it a try.
--
-----------------------------------------------------------------------------

module XMonad.Config.Prime {-# DEPRECATED "This module is a perpetual draft and will therefore be removed from xmonad-contrib in the near future." #-} (
-- Note: The identifiers here are listed in the order that makes the most sense
-- for a user, while the definitions below are listed in the order that makes
-- the most sense for a developer.

-- * Start here
-- $start_here
xmonad,
nothing,
-- * Attributes you can set
-- $settables
normalBorderColor,
focusedBorderColor,
terminal,
modMask,
borderWidth,
focusFollowsMouse,
clickJustFocuses,
SettableClass(..),
UpdateableClass(..),

-- * Attributes you can add to
-- $summables
manageHook,
handleEventHook,
workspaces,
logHook,
startupHook,
clientMask,
rootMask,
SummableClass(..),

-- * Attributes you can add to or remove from
-- $removables
keys,
mouseBindings,
RemovableClass(..),

-- * Modifying the list of workspaces
-- $workspaces
withWorkspaces,
wsNames,
wsKeys,
wsActions,
wsSetName,

-- * Modifying the screen keybindings
-- $screens
withScreens,
sKeys,
sActions,
onScreens,

-- * Modifying the layoutHook
-- $layout
addLayout,
resetLayout,
modifyLayout,

-- * Updating the XConfig en masse
-- $update
startWith,
apply,
applyIO,

-- * The rest of the world
-- | Everything you know and love from the core "XMonad" module is available
-- for use in your config file, too.
module XMonad,
-- | (Almost) everything you know and love from the Haskell "Prelude" is
-- available for use in your config file. Note that '>>' has been overriden, so
-- if you want to create do-blocks for normal monads, you'll need some let
-- statements or a separate module. (See the Troubleshooting section.)
module Prelude,

-- * Core
-- | These are the building blocks on which the config language is built.
-- Regular people shouldn't need to know about these.
Prime,
Arr,
(>>),
ifThenElse,

-- * Example config
-- $example

-- * Troubleshooting
-- $troubleshooting
) where

import Prelude hiding ((>>), mod)
import qualified Prelude as P ((>>=), (>>))

import XMonad.Prelude (All)

import XMonad hiding (xmonad, XConfig(..))
import XMonad (XConfig(XConfig))
import qualified XMonad.StackSet as W
import qualified XMonad as X (xmonad, XConfig(..))

import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)

-- $start_here
-- To start with, create a @xmonad.hs@ that looks like this:
--
-- > {-# LANGUAGE RebindableSyntax #-}
-- > import XMonad.Config.Prime
-- >
-- > -- Imports go here.
-- >
-- > main = xmonad $ do
-- >   nothing
-- >   -- Configs go here.
--
-- This will give you a default xmonad install, with room to grow. The lines
-- starting with double dashes are comments. You may delete them. Note that
-- Haskell is a bit precise about indentation. Make sure all the statements in
-- your do-block start at the same column, and make sure that any multi-line
-- statements are formatted with a hanging indent. (For an example, see the
-- 'keys =+' statement in the /Example config/ section, below.)
--
-- After changing your config file, restart xmonad with mod-q (where, by
-- default, "mod" == "alt").

--
-- The Prime "Monad"
--

-- | A Prime is a function that transforms an XConfig. It's not a monad, but we
-- turn on RebindableSyntax so we can abuse the pretty do notation.
type Prime l l' = Arr (XConfig l) (XConfig l')

-- | An Arr is a generalization of Prime. Don't reference the type, if you can
-- avoid it. It might go away in the future.
type Arr x y = x -> IO y

-- | Composes two Arrs using 'Prelude.>>=' from "Prelude".
(>>) :: Arr x y -> Arr y z -> Arr x z
>> :: forall x y z. Arr x y -> Arr y z -> Arr x z
(>>) Arr x y
x Arr y z
y x
c = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr x y
x x
c) Arr y z
y

-- | Because of RebindableSyntax, this is necessary to enable you to use
-- if-then-else expressions. No need to call it directly.
ifThenElse :: Bool -> a -> a -> a
ifThenElse :: forall a. Bool -> a -> a -> a
ifThenElse Bool
True  a
a a
_ = a
a
ifThenElse Bool
False a
_ a
b = a
b

-- | This is the xmonad main function. It passes 'XMonad.Config.def' (the
-- default 'XConfig') into your do-block, takes the modified config out of your
-- do-block, and then runs xmonad.
--
-- The do-block is a 'Prime'. Advanced readers can skip right to that
-- definition.

xmonad :: (Default a, Read (l Window), LayoutClass l Window) =>
          (a -> IO (XConfig l)) -> IO ()
xmonad :: forall a (l :: * -> *).
(Default a, Read (l Window), LayoutClass l Window) =>
(a -> IO (XConfig l)) -> IO ()
xmonad a -> IO (XConfig l)
prime = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (a -> IO (XConfig l)
prime forall a. Default a => a
def) forall (l :: * -> *).
(LayoutClass l Window, Read (l Window)) =>
XConfig l -> IO ()
X.xmonad

-- | This doesn't modify the config in any way. It's just here for your initial
-- config because Haskell doesn't allow empty do-blocks. Feel free to delete it
-- once you've added other stuff.
nothing :: Prime l l
nothing :: forall (l :: * -> *). Prime l l
nothing = forall (m :: * -> *) a. Monad m => a -> m a
return

-- $settables
-- These are a bunch of attributes that you can set. Syntax looks like this:
--
-- >   terminal =: "urxvt"
--
-- Strings are double quoted, Dimensions are unquoted integers, booleans are
-- 'True' or 'False' (case-sensitive), and 'modMask' is usually 'mod1Mask' or
-- 'mod4Mask'.

class UpdateableClass s x y | s -> x y where
  -- | This lets you apply a function to an attribute (i.e. read, modify, write).
  (=.) :: s c -> (x -> y) -> Arr c c

class SettableClass s x y | s -> x y where
  -- | This lets you modify an attribute.
  (=:) :: s c -> y -> Arr c c

-- Undecideable instance. But it's nice to leave open the possibility to write
-- fields you can't read (e.g. `wmName =: ...`).
instance UpdateableClass s x y => SettableClass s x y where
  s c
s =: :: forall c. s c -> y -> Arr c c
=: y
y = s c
s forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. forall a b. a -> b -> a
const y
y

data Settable x c = Settable (c -> x)      -- getter
                             (x -> c -> c) -- setter

instance UpdateableClass (Settable x) x x where
  (Settable c -> x
g x -> c -> c
s =. :: forall c. Settable x c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f forall a b. (a -> b) -> a -> b
$ c -> x
g c
c) c
c

-- | Non-focused windows border color. Default: @\"#dddddd\"@
normalBorderColor :: Settable String (XConfig l)
normalBorderColor :: forall (l :: * -> *). Settable String (XConfig l)
normalBorderColor = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.normalBorderColor (\String
x XConfig l
c -> XConfig l
c { normalBorderColor :: String
X.normalBorderColor = String
x })

-- | Focused windows border color. Default: @\"#ff0000\"@
focusedBorderColor :: Settable String (XConfig l)
focusedBorderColor :: forall (l :: * -> *). Settable String (XConfig l)
focusedBorderColor = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.focusedBorderColor (\String
x XConfig l
c -> XConfig l
c { focusedBorderColor :: String
X.focusedBorderColor = String
x })

-- | The preferred terminal application. Default: @\"xterm\"@
terminal :: Settable String (XConfig l)
terminal :: forall (l :: * -> *). Settable String (XConfig l)
terminal = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> String
X.terminal (\String
x XConfig l
c -> XConfig l
c { terminal :: String
X.terminal = String
x })

-- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is
-- probably alt on your computer).
modMask :: Settable KeyMask (XConfig l)
modMask :: forall (l :: * -> *). Settable KeyMask (XConfig l)
modMask = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> KeyMask
X.modMask (\KeyMask
x XConfig l
c -> XConfig l
c { modMask :: KeyMask
X.modMask = KeyMask
x })

-- | The border width (in pixels). Default: @1@
borderWidth :: Settable Dimension (XConfig l)
borderWidth :: forall (l :: * -> *). Settable Dimension (XConfig l)
borderWidth = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Dimension
X.borderWidth (\Dimension
x XConfig l
c -> XConfig l
c { borderWidth :: Dimension
X.borderWidth = Dimension
x })

-- | Whether window focus follows the mouse cursor on move, or requires a mouse
-- click. (Mouse? What's that?) Default: @True@
focusFollowsMouse :: Settable Bool (XConfig l)
focusFollowsMouse :: forall (l :: * -> *). Settable Bool (XConfig l)
focusFollowsMouse = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Bool
X.focusFollowsMouse (\Bool
x XConfig l
c -> XConfig l
c { focusFollowsMouse :: Bool
X.focusFollowsMouse = Bool
x })

-- | If True, a mouse click on an inactive window focuses it, but the click is
-- not passed to the window. If False, the click is also passed to the window.
-- Default @True@
clickJustFocuses :: Settable Bool (XConfig l)
clickJustFocuses :: forall (l :: * -> *). Settable Bool (XConfig l)
clickJustFocuses = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable forall (l :: * -> *). XConfig l -> Bool
X.clickJustFocuses (\Bool
x XConfig l
c -> XConfig l
c { clickJustFocuses :: Bool
X.clickJustFocuses = Bool
x })

-- $summables
-- In addition to being able to set these attributes, they have a special
-- syntax for being able to add to them. The operator is @=+@ (the plus comes
-- /after/ the equals), but each attribute has a different syntax for what
-- comes after the operator.

class SummableClass s y | s -> y where
  -- | This lets you add to an attribute.
  (=+) :: s c -> y -> Arr c c
  infix 0 =+

data Summable x y c = Summable (c -> x)      -- getter
                               (x -> c -> c) -- setter
                               (x -> y -> x) -- accumulator

instance UpdateableClass (Summable x y) x x where
  (Summable c -> x
g x -> c -> c
s x -> y -> x
_ =. :: forall c. Summable x y c -> (x -> x) -> Arr c c
=. x -> x
f) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (x -> x
f forall a b. (a -> b) -> a -> b
$ c -> x
g c
c) c
c

instance SummableClass (Summable x y) y where
  (Summable c -> x
g x -> c -> c
s x -> y -> x
a =+ :: forall c. Summable x y c -> y -> Arr c c
=+ y
y) c
c = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x -> c -> c
s (c -> x
g c
c x -> y -> x
`a` y
y) c
c

-- | The action to run when a new window is opened. Default:
--
-- >   manageHook =: composeAll [className =? "MPlayer" --> doFloat, className =? "Gimp" --> doFloat]
--
-- To add more rules to this list, you can say, for instance:
--
-- > import XMonad.StackSet
-- > ...
-- >   manageHook =+ (className =? "Emacs" --> doF kill)
-- >   manageHook =+ (className =? "Vim" --> doF shiftMaster)
--
-- Note that operator precedence mandates the parentheses here.
manageHook :: Summable ManageHook ManageHook (XConfig l)
manageHook :: forall (l :: * -> *). Summable ManageHook ManageHook (XConfig l)
manageHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> ManageHook
X.manageHook (\ManageHook
x XConfig l
c -> XConfig l
c { manageHook :: ManageHook
X.manageHook = ManageHook
x }) forall a. Semigroup a => a -> a -> a
(<>)

-- | Custom X event handler. Return @All True@ if the default handler should
-- also be run afterwards. Default does nothing. To add an event handler:
--
-- > import XMonad.Hooks.ServerMode
-- > ...
-- >   handleEventHook =+ serverModeEventHook
handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook :: forall (l :: * -> *).
Summable (Event -> X All) (Event -> X All) (XConfig l)
handleEventHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Event -> X All
X.handleEventHook (\Event -> X All
x XConfig l
c -> XConfig l
c { handleEventHook :: Event -> X All
X.handleEventHook = Event -> X All
x }) forall a. Semigroup a => a -> a -> a
(<>)

-- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding
-- appends to the end:
--
-- >   workspaces =+ ["0"]
--
-- This is useless unless you also create keybindings for this.
workspaces :: Summable [String] [String] (XConfig l)
workspaces :: forall (l :: * -> *). Summable [String] [String] (XConfig l)
workspaces = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> [String]
X.workspaces (\[String]
x XConfig l
c -> XConfig l
c { workspaces :: [String]
X.workspaces = [String]
x }) forall a. [a] -> [a] -> [a]
(++)

-- | The action to perform when the windows set is changed. This happens
-- whenever focus change, a window is moved, etc. @logHook =+@ takes an @X ()@
-- and appends it via '(>>)'. For instance:
--
-- > import XMonad.Hooks.ICCCMFocus
-- > ...
-- >   logHook =+ takeTopFocus
--
-- Note that if your expression is parametrically typed (e.g. of type
-- @MonadIO m => m ()@), you'll need to explicitly annotate it, like so:
--
-- >   logHook =+ (io $ putStrLn "Hello, world!" :: X ())
logHook :: Summable (X ()) (X ()) (XConfig l)
logHook :: forall (l :: * -> *). Summable (X ()) (X ()) (XConfig l)
logHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> X ()
X.logHook (\X ()
x XConfig l
c -> XConfig l
c { logHook :: X ()
X.logHook = X ()
x }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)

-- | The action to perform on startup. @startupHook =+@ takes an @X ()@ and
-- appends it via '(>>)'. For instance:
--
-- > import XMonad.Hooks.SetWMName
-- > ...
-- >   startupHook =+ setWMName "LG3D"
--
-- Note that if your expression is parametrically typed (e.g. of type
-- @MonadIO m => m ()@), you'll need to explicitly annotate it, as documented
-- in 'logHook'.
startupHook :: Summable (X ()) (X ()) (XConfig l)
startupHook :: forall (l :: * -> *). Summable (X ()) (X ()) (XConfig l)
startupHook = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> X ()
X.startupHook (\X ()
x XConfig l
c -> XConfig l
c { startupHook :: X ()
X.startupHook = X ()
x }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>)

-- | The client events that xmonad is interested in. This is useful in
-- combination with handleEventHook. Default: @structureNotifyMask .|.
-- enterWindowMask .|. propertyChangeMask@
--
-- >   clientMask =+ keyPressMask .|. keyReleaseMask
clientMask :: Summable EventMask EventMask (XConfig l)
clientMask :: forall (l :: * -> *). Summable Window Window (XConfig l)
clientMask = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Window
X.clientMask (\Window
x XConfig l
c -> XConfig l
c { clientMask :: Window
X.clientMask = Window
x }) forall a. Bits a => a -> a -> a
(.|.)

-- | The root events that xmonad is interested in. This is useful in
-- combination with handleEventHook. Default: @substructureRedirectMask .|.
-- substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|.
-- structureNotifyMask .|. buttonPressMask@
rootMask :: Summable EventMask EventMask (XConfig l)
rootMask :: forall (l :: * -> *). Summable Window Window (XConfig l)
rootMask = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable forall (l :: * -> *). XConfig l -> Window
X.rootMask (\Window
x XConfig l
c -> XConfig l
c { rootMask :: Window
X.rootMask = Window
x }) forall a. Bits a => a -> a -> a
(.|.)

-- $removables
-- The following support the the @=+@ for adding items and the @=-@ operator
-- for removing items.

class RemovableClass r y | r -> y where
  -- | This lets you remove from an attribute.
  (=-) :: r c -> y -> Arr c c
  infix 0 =-

data Keys c = Keys { forall c. Keys c -> [(String, X ())] -> c -> c
kAdd :: [(String, X ())] -> c -> c,
                     forall c. Keys c -> [String] -> c -> c
kRemove :: [String] -> c -> c }

instance SummableClass Keys [(String, X ())] where
  Keys { kAdd :: forall c. Keys c -> [(String, X ())] -> c -> c
kAdd = [(String, X ())] -> c -> c
a } =+ :: forall c. Keys c -> [(String, X ())] -> Arr c c
=+ [(String, X ())]
newKeys = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, X ())] -> c -> c
a [(String, X ())]
newKeys

instance RemovableClass Keys [String] where
  Keys { kRemove :: forall c. Keys c -> [String] -> c -> c
kRemove = [String] -> c -> c
r } =- :: forall c. Keys c -> [String] -> Arr c c
=- [String]
sadKeys = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> c -> c
r [String]
sadKeys

-- | Key bindings to 'X' actions. Default: see @`man xmonad`@. 'keys'
-- takes a list of keybindings specified emacs-style, as documented in
-- 'XMonad.Util.EZConfig.mkKeyMap'. For example, to change the "kill window"
-- key:
--
-- >   keys =- ["M-S-c"]
-- >   keys =+ [("M-M1-x", kill)]
keys :: Keys (XConfig l)
keys :: forall (l :: * -> *). Keys (XConfig l)
keys = Keys {
  -- Note that since checkKeymap happens on newKeys, it doesn't check for
  -- duplicates between repeated applications. Probably OK. (Especially since
  -- overriding defaults is a common behavior.) Also note that there's no
  -- reference cycle here. Yay!
  kAdd :: [(String, X ())] -> XConfig l -> XConfig l
kAdd = \[(String, X ())]
newKeys XConfig l
c -> (XConfig l
c forall (l :: * -> *). XConfig l -> [(String, X ())] -> XConfig l
`additionalKeysP` [(String, X ())]
newKeys) { startupHook :: X ()
X.startupHook = forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(P.>>) (forall (l :: * -> *). XConfig l -> X ()
X.startupHook XConfig l
c) (forall (l :: * -> *) a. XConfig l -> [(String, a)] -> X ()
checkKeymap XConfig l
c [(String, X ())]
newKeys) },
  kRemove :: [String] -> XConfig l -> XConfig l
kRemove = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *). XConfig l -> [String] -> XConfig l
removeKeysP
}

data MouseBindings c = MouseBindings { forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> c -> c
mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c,
                                       forall c. MouseBindings c -> [(KeyMask, Dimension)] -> c -> c
mRemove :: [(ButtonMask, Button)] -> c -> c }

instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where
  MouseBindings { mAdd :: forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> c -> c
mAdd = [((KeyMask, Dimension), Window -> X ())] -> c -> c
a } =+ :: forall c.
MouseBindings c
-> [((KeyMask, Dimension), Window -> X ())] -> Arr c c
=+ [((KeyMask, Dimension), Window -> X ())]
newBindings = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, Dimension), Window -> X ())] -> c -> c
a [((KeyMask, Dimension), Window -> X ())]
newBindings

instance RemovableClass MouseBindings [(ButtonMask, Button)] where
  MouseBindings { mRemove :: forall c. MouseBindings c -> [(KeyMask, Dimension)] -> c -> c
mRemove = [(KeyMask, Dimension)] -> c -> c
r } =- :: forall c. MouseBindings c -> [(KeyMask, Dimension)] -> Arr c c
=- [(KeyMask, Dimension)]
sadBindings = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyMask, Dimension)] -> c -> c
r [(KeyMask, Dimension)]
sadBindings

-- | Mouse button bindings to an 'X' actions on a window. Default: see @`man
-- xmonad`@. To make @mod-\<scrollwheel\>@ switch workspaces:
--
-- > import XMonad.Actions.CycleWS (nextWS, prevWS)
-- > ...
-- >   mouseBindings =+ [((mod4Mask, button4), const prevWS),
-- >                     ((mod4Mask, button5), const nextWS)]
--
-- Note that you need to specify the numbered mod-mask e.g. 'mod4Mask' instead
-- of just 'modMask'.
mouseBindings :: MouseBindings (XConfig l)
mouseBindings :: forall (l :: * -> *). MouseBindings (XConfig l)
mouseBindings = MouseBindings {
  mAdd :: [((KeyMask, Dimension), Window -> X ())] -> XConfig l -> XConfig l
mAdd = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [((KeyMask, Dimension), Window -> X ())] -> XConfig a
additionalMouseBindings,
  mRemove :: [(KeyMask, Dimension)] -> XConfig l -> XConfig l
mRemove = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [(KeyMask, Dimension)] -> XConfig a
removeMouseBindings
}

-- $workspaces
-- Workspaces can be configured through 'workspaces', but then the 'keys' need
-- to be set, and this can be a bit laborious. 'withWorkspaces' provides a
-- convenient mechanism for common workspace updates.

-- | Configure workspaces through a Prime-like interface. Example:
--
-- >   withWorkspaces $ do
-- >     wsKeys =+ ["0"]
-- >     wsActions =+ [("M-M1-", windows . swapWithCurrent)]
-- >     wsSetName 1 "mail"
--
-- This will set 'workspaces' and add the necessary keybindings to 'keys'. Note
-- that it won't remove old keybindings; it's just not that clever.
withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces :: forall (l :: * -> *).
Arr WorkspaceConfig WorkspaceConfig -> Prime l l
withWorkspaces Arr WorkspaceConfig WorkspaceConfig
wsarr XConfig l
xconf = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr WorkspaceConfig WorkspaceConfig
wsarr forall a. Default a => a
def) forall a b. (a -> b) -> a -> b
$ \WorkspaceConfig
wsconf -> forall (l :: * -> *). WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf XConfig l
xconf
  where wsprime :: WorkspaceConfig -> Prime l l
        wsprime :: forall (l :: * -> *). WorkspaceConfig -> Prime l l
wsprime WorkspaceConfig
wsconf =
          (forall (l :: * -> *). Summable [String] [String] (XConfig l)
workspaces forall (s :: * -> *) x y c.
SettableClass s x y =>
s c -> y -> Arr c c
=: [String]
allNames) forall x y z. Arr x y -> Arr y z -> Arr x z
>>
          (forall (l :: * -> *). Keys (XConfig l)
keys forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod forall a. [a] -> [a] -> [a]
++ String
key, String -> X ()
action String
name) | (String
name, String
key) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
allNames (WorkspaceConfig -> [String]
wsKeys_ WorkspaceConfig
wsconf),
                                                (String
mod, String -> X ()
action) <- WorkspaceConfig -> [(String, String -> X ())]
wsActions_ WorkspaceConfig
wsconf])
          where allNames :: [String]
allNames = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t :: * -> *} {a}. Foldable t => t a -> t a -> t a
chooseName (WorkspaceConfig -> [String]
wsNames_ WorkspaceConfig
wsconf) (WorkspaceConfig -> [String]
wsKeys_ WorkspaceConfig
wsconf)
                chooseName :: t a -> t a -> t a
chooseName t a
name t a
keyspec = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
name) then t a
name else t a
keyspec

data WorkspaceConfig = WorkspaceConfig {
  WorkspaceConfig -> [String]
wsNames_ :: [String],
  WorkspaceConfig -> [String]
wsKeys_ :: [String],
  WorkspaceConfig -> [(String, String -> X ())]
wsActions_ :: [(String, String -> X ())]
}

instance Default WorkspaceConfig where
  def :: WorkspaceConfig
def = WorkspaceConfig {
    wsNames_ :: [String]
wsNames_ = forall a. a -> [a]
repeat String
"",
    wsKeys_ :: [String]
wsKeys_ = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [Char
'1'..Char
'9'], -- The hungry monkey eats dots and turns them into numbers.
    wsActions_ :: [(String, String -> X ())]
wsActions_ = [(String
"M-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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),
                  (String
"M-S-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)]
  }

-- | The list of workspace names, like 'workspaces' but with two differences:
--
--   1. If any entry is the empty string, it'll be replaced with the
--      corresponding entry in 'wsKeys'.
--   2. The list is truncated to the size of 'wsKeys'.
--
-- The default value is @'repeat' ""@.
--
-- If you'd like to create workspaces without associated keyspecs, you can do
-- that afterwards, outside the 'withWorkspaces' block, with @'workspaces' =+@.
wsNames :: Settable [String] WorkspaceConfig
wsNames :: Settable [String] WorkspaceConfig
wsNames = forall x c. (c -> x) -> (x -> c -> c) -> Settable x c
Settable WorkspaceConfig -> [String]
wsNames_ (\[String]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsNames_ :: [String]
wsNames_ = [String]
x })

-- | The list of workspace keys. These are combined with the modifiers in
-- 'wsActions' to form the keybindings for navigating to workspaces. Default:
-- @["1","2",...,"9"]@.
wsKeys :: Summable [String] [String] WorkspaceConfig
wsKeys :: Summable [String] [String] WorkspaceConfig
wsKeys = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable WorkspaceConfig -> [String]
wsKeys_ (\[String]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsKeys_ :: [String]
wsKeys_ = [String]
x }) forall a. [a] -> [a] -> [a]
(++)

-- | Mapping from key prefix to command. Its type is @[(String, String ->
-- X())]@. The key prefix may be a modifier such as @\"M-\"@, or a submap
-- prefix such as @\"M-a \"@, or both, as in @\"M-a M-\"@. The command is a
-- function that takes a workspace name and returns an @X ()@. 'withWorkspaces'
-- creates keybindings for the cartesian product of 'wsKeys' and 'wsActions'.
--
-- Default:
--
-- > [("M-", windows . W.greedyView),
-- >  ("M-S-", windows . W.shift)]
wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig
wsActions :: Summable
  [(String, String -> X ())]
  [(String, String -> X ())]
  WorkspaceConfig
wsActions = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable WorkspaceConfig -> [(String, String -> X ())]
wsActions_ (\[(String, String -> X ())]
x WorkspaceConfig
c -> WorkspaceConfig
c { wsActions_ :: [(String, String -> X ())]
wsActions_ = [(String, String -> X ())]
x }) forall a. [a] -> [a] -> [a]
(++)

-- | A convenience for just modifying one entry in 'wsNames', in case you only
-- want a few named workspaces. Example:
--
-- >     wsSetName 1 "mail"
-- >     wsSetName 2 "web"
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
wsSetName Int
index String
newName = Settable [String] WorkspaceConfig
wsNames forall (s :: * -> *) x y c.
UpdateableClass s x y =>
s c -> (x -> y) -> Arr c c
=. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int, String) -> String
maybeSet) [Int
0..]
  where maybeSet :: (Int, String) -> String
maybeSet (Int
i, String
oldName) | Int
i forall a. Eq a => a -> a -> Bool
== (Int
index forall a. Num a => a -> a -> a
- Int
1) = String
newName
                              | Bool
otherwise = String
oldName

-- $screens
-- 'withScreens' provides a convenient mechanism to set keybindings for moving
-- between screens, much like 'withWorkspaces'.

-- | Configure screen keys through a Prime-like interface:
--
-- >   withScreens $ do
-- >     sKeys =: ["e", "r"]
--
-- This will add the necessary keybindings to 'keys'. Note that it won't remove
-- old keybindings; it's just not that clever.
withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
withScreens :: forall (l :: * -> *). Arr ScreenConfig ScreenConfig -> Prime l l
withScreens Arr ScreenConfig ScreenConfig
sarr XConfig l
xconf = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(P.>>=) (Arr ScreenConfig ScreenConfig
sarr forall a. Default a => a
def) forall a b. (a -> b) -> a -> b
$ \ScreenConfig
sconf -> forall (l :: * -> *). ScreenConfig -> Prime l l
sprime ScreenConfig
sconf XConfig l
xconf
  where sprime :: ScreenConfig -> Prime l l
        sprime :: forall (l :: * -> *). ScreenConfig -> Prime l l
sprime ScreenConfig
sconf =
          forall (l :: * -> *). Keys (XConfig l)
keys forall (s :: * -> *) y c. SummableClass s y => s c -> y -> Arr c c
=+ [(String
mod forall a. [a] -> [a] -> [a]
++ String
key, ScreenId -> X ()
action ScreenId
sid) | (ScreenId
sid, String
key) <- forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId
0..] (ScreenConfig -> [String]
sKeys_ ScreenConfig
sconf),
                                              (String
mod, ScreenId -> X ()
action) <- ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ ScreenConfig
sconf]

data ScreenConfig = ScreenConfig {
  ScreenConfig -> [String]
sKeys_ :: [String],
  ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ :: [(String, ScreenId -> X ())]
}

instance Default ScreenConfig where
  def :: ScreenConfig
def = ScreenConfig {
    sKeys_ :: [String]
sKeys_ = [String
"w", String
"e", String
"r"],
    sActions_ :: [(String, ScreenId -> X ())]
sActions_ = [(String
"M-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens 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),
                 (String
"M-S-", (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens 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)]
  }


-- | The list of screen keys. These are combined with the modifiers in
-- 'sActions' to form the keybindings for navigating to workspaces. Default:
-- @["w","e","r"]@.
sKeys :: Summable [String] [String] ScreenConfig
sKeys :: Summable [String] [String] ScreenConfig
sKeys = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable ScreenConfig -> [String]
sKeys_ (\[String]
x ScreenConfig
c -> ScreenConfig
c { sKeys_ :: [String]
sKeys_ = [String]
x }) forall a. [a] -> [a] -> [a]
(++)

-- | Mapping from key prefix to command. Its type is @[(String, ScreenId ->
-- X())]@. Works the same as 'wsActions' except for a different function type.
--
-- Default:
--
-- > [("M-", windows . onScreens W.view),
-- >  ("M-S-", windows . onScreens W.shift)]
sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig
sActions :: Summable
  [(String, ScreenId -> X ())]
  [(String, ScreenId -> X ())]
  ScreenConfig
sActions = forall x y c.
(c -> x) -> (x -> c -> c) -> (x -> y -> x) -> Summable x y c
Summable ScreenConfig -> [(String, ScreenId -> X ())]
sActions_ (\[(String, ScreenId -> X ())]
x ScreenConfig
c -> ScreenConfig
c { sActions_ :: [(String, ScreenId -> X ())]
sActions_ = [(String, ScreenId -> X ())]
x }) forall a. [a] -> [a] -> [a]
(++)

-- | Converts a stackset transformer parameterized on the workspace type into one
-- parameterized on the screen type. For example, you can use @onScreens W.view
-- 0@ to navigate to the workspace on the 0th screen. If the screen id is not
-- recognized, the returned transformer acts as an identity function.
onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) ->
                     s -> W.StackSet i l a s sd -> W.StackSet i l a s sd
onScreens :: forall s i l a sd.
Eq s =>
(i -> StackSet i l a s sd -> StackSet i l a s sd)
-> s -> StackSet i l a s sd -> StackSet i l a s sd
onScreens i -> StackSet i l a s sd -> StackSet i l a s sd
f s
sc StackSet i l a s sd
ws = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id i -> StackSet i l a s sd -> StackSet i l a s sd
f (forall s i l a sd. Eq s => s -> StackSet i l a s sd -> Maybe i
W.lookupWorkspace s
sc StackSet i l a s sd
ws) StackSet i l a s sd
ws

-- $layout
-- Layouts are special. You can't modify them using the @=:@ or @=.@ operator.
-- You need to use the following functions.

-- | Add a layout to the list of layouts choosable with mod-space. For instance:
--
-- > import XMonad.Layout.Tabbed
-- > ...
-- >   addLayout simpleTabbed
addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r)
addLayout :: forall (l :: * -> *) (r :: * -> *).
(LayoutClass l Window, LayoutClass r Window) =>
r Window -> Prime l (Choose l r)
addLayout r Window
r XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: Choose l r Window
X.layoutHook = forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| r Window
r }

-- | Reset the layoutHook from scratch. For instance, to get rid of the wide
-- layout:
--
-- >   resetLayout $ Tall 1 (3/100) (1/2) ||| Full
--
-- (The dollar is like an auto-closing parenthesis, so all the stuff to the
-- right of it is treated like an argument to resetLayout.)
resetLayout :: (LayoutClass r Window) => r Window -> Prime l r
resetLayout :: forall (r :: * -> *) (l :: * -> *).
LayoutClass r Window =>
r Window -> Prime l r
resetLayout r Window
r XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: r Window
X.layoutHook = r Window
r }

-- | Modify your 'layoutHook' with some wrapper function. You probably want to call
-- this after you're done calling 'addLayout'. Example:
--
-- > import XMonad.Layout.NoBorders
-- > ...
-- >   modifyLayout smartBorders
modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r
modifyLayout :: forall (r :: * -> *) (l :: * -> *).
LayoutClass r Window =>
(l Window -> r Window) -> Prime l r
modifyLayout l Window -> r Window
f XConfig l
c = forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
c { layoutHook :: r Window
X.layoutHook = l Window -> r Window
f forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l Window
X.layoutHook XConfig l
c }

-- $update
-- Finally, there are a few contrib modules that bundle multiple attribute
-- updates together. There are three types: 1) wholesale replacements for the
-- default config, 2) pure functions on the config, and 3) IO actions on the
-- config. The syntax for each is different. Examples:
--
-- 1) To start with a 'XMonad.Config.Gnome.gnomeConfig' instead of the default,
-- we use 'startWith':
--
-- > import XMonad.Config.Gnome
-- > ...
-- >   startWith gnomeConfig
--
-- 2) 'XMonad.Hooks.UrgencyHook.withUrgencyHook' is a pure function, so we need
-- to use 'apply':
--
-- > import XMonad.Hooks.UrgencyHook
-- > ...
-- >   apply $ withUrgencyHook dzenUrgencyHook
--
-- 3) 'XMonad.Hooks.DynamicLog.xmobar' returns an @IO (XConfig l)@, so we need
-- to use 'applyIO':
--
-- > import XMonad.Hooks.DynamicLog
-- > ...
-- >   applyIO xmobar

-- | Replace the current 'XConfig' with the given one. If you use this, you
-- probably want it to be the first line of your config.
startWith :: XConfig l' -> Prime l l'
startWith :: forall (l' :: * -> *) (l :: * -> *). XConfig l' -> Prime l l'
startWith = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Turns a pure function on 'XConfig' into a 'Prime'.
apply :: (XConfig l -> XConfig l') -> Prime l l'
apply :: forall (l :: * -> *) (l' :: * -> *).
(XConfig l -> XConfig l') -> Prime l l'
apply XConfig l -> XConfig l'
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l -> XConfig l'
f

-- | Turns an IO function on 'XConfig' into a 'Prime'.
applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l'
applyIO :: forall (l :: * -> *) (l' :: * -> *).
(XConfig l -> IO (XConfig l')) -> XConfig l -> IO (XConfig l')
applyIO = forall a. a -> a
id  -- This is here in case we want to change the Prime type later.

-- $example
-- As an example, I've included below a subset of my current config. Note that
-- my import statements specify individual identifiers in parentheticals.
-- That's optional. The default is to import the entire module. I just find it
-- helpful to remind me where things came from.
--
-- > {-# LANGUAGE RebindableSyntax #-}
-- > import XMonad.Config.Prime
-- >
-- > import XMonad.Actions.CycleWS (prevWS, nextWS)
-- > import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
-- > import XMonad.Actions.WindowNavigation (withWindowNavigation)
-- > import XMonad.Layout.Fullscreen (fullscreenSupport)
-- > import XMonad.Layout.NoBorders (smartBorders)
-- > import XMonad.Layout.Tabbed (simpleTabbed)
-- >
-- > main = xmonad $ do
-- >   modMask =: mod4Mask
-- >   normalBorderColor =: "#222222"
-- >   terminal =: "urxvt"
-- >   focusFollowsMouse =: False
-- >   resetLayout $ Tall 1 (3/100) (1/2) ||| simpleTabbed
-- >   modifyLayout smartBorders
-- >   apply fullscreenSupport
-- >   applyIO $ withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
-- >   withWorkspaces $ do
-- >     wsKeys =+ ["0"]
-- >     wsActions =+ [("M-M1-", windows . swapWithCurrent)]
-- >   keys =+ [
-- >       ("M-,",                      sendMessage $ IncMasterN (-1)),
-- >       ("M-.",                      sendMessage $ IncMasterN 1),
-- >       ("M-M1-d",                   spawn "date | dzen2 -fg '#eeeeee' -p 2"),
-- >       ("C-S-q",                    return ()),
-- >       ("<XF86AudioLowerVolume>",   spawn "amixer set Master 5%-"),
-- >       ("<XF86AudioRaiseVolume>",   spawn "amixer set Master 5%+"),
-- >       ("M-M1-x",                   kill),
-- >       ("M-i",                      prevWS),
-- >       ("M-o",                      nextWS)
-- >     ]

-- $troubleshooting
-- === Only the last line of my config seems to take effect. What gives?
-- You're missing the @{-\# LANGUAGE RebindableSyntax \#-}@ line at the top.
--
-- === How do I do use normal monads like 'X' or 'IO'?
-- Here are a couple of ways:
--
-- > import qualified Prelude as P
-- > ...
-- > test1, test2 :: X ()
-- > test1 = spawn "echo Hi" P.>> spawn "echo Bye"
-- > test2 = do spawn "echo Hi"
-- >            spawn "echo Bye"
-- >   where (>>) = (P.>>)
--
-- === How do I use the old keyboard syntax?
-- You can use 'apply' and supply your own Haskell function. For instance:
--
-- > apply $ flip additionalKeys $ [((mod1Mask, xK_z), spawn "date | dzen2 -fg '#eeeeee' -p 2")]
--
-- === How do I run a command before xmonad starts (like 'spawnPipe')?
-- If you're using it for a status bar, see if 'XMonad.Hooks.DynamicLog.dzen'
-- or 'XMonad.Hooks.DynamicLog.xmobar' does what you want. If so, you can apply
-- it with 'applyIO'.
--
-- If not, you can write your own @XConfig l -> IO (XConfig l)@ and apply it
-- with 'applyIO'. When writing this function, see the above tip about using
-- normal monads.
--
-- Alternatively, you could do something like this this:
--
-- > import qualified Prelude as P (>>)
-- >
-- > main =
-- >   openFile ".xmonad.log" AppendMode >>= \log ->
-- >   hSetBuffering log LineBuffering P.>>
-- >   (xmonad $ do
-- >      nothing -- Prime config here.
-- >   )