XMonad.Config.Prime, a do-notation for config

Ignore-this: f7397aa6e6efe5d76acebfa22c567baa
Note that the use of RebindableSyntax is because of the need to vary the
layoutHook type throughout the config. The alternative, using the existential
Layout type, was rejected because it required TemplateHaskell in order to look
nice, and TemplateHaskell is not portable.

I've tried to make a version of (>>) that also worked on normal monads, but
have had no luck as of yet. Maybe some intrepid soul can add it later.

darcs-hash:20140914064828-c7120-fbf2746080bb2410b2b70da290fd50eefd49435d.gz

2 files changed, 512 insertions, 2 deletions

diff --git a/XMonad/Config/Prime.hs b/XMonad/Config/Prime.hs
new file mode 100644
index 0000000..50a4e8c
--- /dev/null
+++ b/XMonad/Config/Prime.hs
@@ -0,0 +1,495 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.Prime
+-- Copyright   :  Devin Mullins <devinmullins@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <devinmullins@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 (
+-- 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 layoutHook
+-- $layout
+addLayout,
+resetLayout,
+modifyLayout,
+
+-- * Update entire XConfig
+-- $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,
+(>>),
+
+-- * Example config
+-- $example
+
+-- * Troubleshooting
+-- $troubleshooting
+) where
+
+import Prelude hiding ((>>))
+import qualified Prelude as P ((>>=), (>>))
+
+import qualified Data.Map as M
+import Data.Monoid (All)
+
+import XMonad hiding (xmonad, XConfig(..))
+import XMonad (XConfig(XConfig))
+import qualified XMonad as X (xmonad, XConfig(..))
+
+import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, mkKeymap, removeKeysP, removeMouseBindings)
+
+-- $start_here
+-- To start with, create a @~\/.xmonad\/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 indented further on the subsequent lines. (For an example,
+-- see the 'addKeys' statement in the /Example config/ section, below.)
+
+--
+-- 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' = XConfig l -> IO (XConfig l')
+
+-- | Composes two Primes using 'Prelude.>>=' from "Prelude".
+(>>) :: Prime l l' -> Prime l' l'' -> Prime l l''
+(>>) x y c = (P.>>=) (x c) y
+
+-- | This is the xmonad main function. It passes the default config 'def' to
+-- your do-block, takes the modified config out of your do-block, and 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 prime = (P.>>=) (prime def) 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 = 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 l -> (x -> y) -> Prime l l
+
+class SettableClass s x y | s -> x y where
+  -- | This lets you modify an attribute.
+  (=:) :: s l -> y -> Prime l l
+
+-- 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 =: y = s =. const y
+
+data Settable x l = Settable (XConfig l -> x)              -- getter
+                             (x -> XConfig l -> XConfig l) -- setter
+
+instance UpdateableClass (Settable x) x x where
+  (Settable g s =. f) c = return $ s (f $ g c) c
+
+-- | Non-focused windows border color. Default: @\"#dddddd\"@
+normalBorderColor  :: Settable String l
+normalBorderColor = Settable X.normalBorderColor (\x c -> c { X.normalBorderColor = x })
+
+-- | Focused windows border color. Default: @\"#ff0000\"@
+focusedBorderColor :: Settable String l
+focusedBorderColor = Settable X.focusedBorderColor (\x c -> c { X.focusedBorderColor = x })
+
+-- | The preferred terminal application. Default: @\"xterm\"@
+terminal :: Settable String l
+terminal = Settable X.terminal (\x c -> c { X.terminal = x })
+
+-- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is
+-- probably alt on your computer).
+modMask :: Settable KeyMask l
+modMask = Settable X.modMask (\x c -> c { X.modMask = x })
+
+-- | The border width (in pixels). Default: @1@
+borderWidth :: Settable Dimension l
+borderWidth = Settable X.borderWidth (\x c -> c { X.borderWidth = x })
+
+-- | Whether window focus follows the mouse cursor on move, or requires a mouse
+-- click. (Mouse? What's that?) Default: @True@
+focusFollowsMouse :: Settable Bool l
+focusFollowsMouse = Settable X.focusFollowsMouse (\x c -> c { X.focusFollowsMouse = 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 l
+clickJustFocuses = Settable X.clickJustFocuses (\x c -> c { X.clickJustFocuses = 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 l -> y -> Prime l l
+  infix 0 =+
+
+data Summable x y l = Summable (XConfig l -> x)              -- getter
+                               (x -> XConfig l -> XConfig l) -- setter
+                               (x -> y -> x)                 -- accumulator
+
+instance UpdateableClass (Summable x y) x x where
+  (Summable g s _ =. f) c = return $ s (f $ g c) c
+
+instance SummableClass (Summable x y) y where
+  (Summable g s a =+ y) c = return $ s (g c `a` y) 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 l
+manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>)
+
+-- | 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) l
+handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>)
+
+-- | 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] l
+workspaces = Summable X.workspaces (\x c -> c { X.workspaces = x }) (++)
+
+-- TODO: Rework the workspaces thing to pair names with keybindings.
+
+-- | 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 ()) l
+logHook = Summable X.logHook (\x c -> c { X.logHook = x }) (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 ()) l
+startupHook = Summable X.startupHook (\x c -> c { X.startupHook = x }) (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 l
+clientMask = Summable X.clientMask (\x c -> c { X.clientMask = x }) (.|.)
+
+-- | 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 l
+rootMask = Summable X.rootMask (\x c -> c { X.rootMask = x }) (.|.)
+
+-- $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 l -> y -> Prime l l
+  infix 0 =-
+
+data Keys (l :: * -> *) = 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!
+
+instance UpdateableClass Keys (XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())) [(String, X ())] where
+  (_ =. f) c = return c { X.keys = \c' -> mkKeymap c' newKeys,
+                          X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) }
+    where newKeys = f $ X.keys c
+
+instance SummableClass Keys [(String, X ())] where
+  (_ =+ newKeys) c = return (c `additionalKeysP` newKeys) { X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) }
+
+instance RemovableClass Keys [String] where
+  (_ =- sadKeys) c = return (c `removeKeysP` 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 l
+keys = Keys
+
+data MouseBindings (l :: * -> *) = MouseBindings
+
+instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where
+  (_ =+ newBindings) c = return (c `additionalMouseBindings` newBindings)
+
+instance RemovableClass MouseBindings [(ButtonMask, Button)] where
+  (_ =- sadBindings) c = return (c `removeMouseBindings` 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 l
+mouseBindings = MouseBindings
+
+-- $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 r c = return c { X.layoutHook = X.layoutHook c ||| 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 r c = return c { X.layoutHook = 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 f c = return c { X.layoutHook = f $ X.layoutHook 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 = const . return
+
+-- | Turns a pure function on 'XConfig' into a 'Prime'.
+apply :: (XConfig l -> XConfig l') -> Prime l l'
+apply f = return . f
+
+-- | Turns an IO function on 'XConfig' into a 'Prime'.
+applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l'
+applyIO = 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.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)
+-- >   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.>>)
diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs
index 386baab..779a1e9 100644
--- a/XMonad/Layout/Fullscreen.hs
+++ b/XMonad/Layout/Fullscreen.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Fullscreen
@@ -15,7 +15,8 @@
 module XMonad.Layout.Fullscreen
     ( -- * Usage:
       -- $usage
-     fullscreenFull
+     fullscreenSupport
+    ,fullscreenFull
     ,fullscreenFocus
     ,fullscreenFullRect
     ,fullscreenFocusRect
@@ -63,6 +64,20 @@ import Control.Arrow (second)
 -- > myLayouts = fullscreenFull someLayout
 --
 
+-- | Modifies your config to apply basic fullscreen support -- fullscreen
+-- windows when they request it. Example usage:
+--
+-- > main = xmonad
+-- >      $ fullscreenSupport
+-- >      $ defaultConfig { ... }
+fullscreenSupport :: LayoutClass l Window =>
+  XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
+fullscreenSupport c = c {
+    layoutHook = fullscreenFull $ layoutHook c,
+    handleEventHook = handleEventHook c <+> fullscreenEventHook,
+    manageHook = manageHook c <+> fullscreenManageHook
+  }
+
 -- | Messages that control the fullscreen state of the window.
 -- AddFullscreen and RemoveFullscreen are sent to all layouts
 -- when a window wants or no longer wants to be fullscreen.