[xmonad] Re: Compile-time verification of keymaps

Gwern Branwen gwern0 at gmail.com
Tue Mar 23 19:12:06 EDT 2010


On Sun, Nov 16, 2008 at 1:14 PM, Gwern Branwen <gwern0 at gmail.com> wrote:
> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA512
>
> So today I edited into my xmonad.hs a binding to the Isohunt.com
> XMonad.Actions.Search engine for convenience. I naturally chose xK_i
> for the bound key. When I reloaded, I was surprised to see that mod-i
> failed to do as it was supposed to.
>
> Trying it again, it brought up irssi. That was when I realized mod-i
> had already been bound in my xmonad.hs, to runOrRaise for irssi, and
> that the irssi binding happened to be later in the list and so it
> quietly overwrote the Isohunt binding. After picking a new & unused
> key, I began reflecting on this.
>
> Certainly, this is expected behavior if you're familiar with Data.Map.
> fromList will do that - a list may have multiple values for a single
> key (such as xK_i) and the last value wins. But I think in an
> xmonad.hs, the context is somewhat different. There the semantics are
> somewhat different. We use 'M.fromList [stuff, more stuff, and the
> rest]' syntax because Haskell supports list syntax, and it makes life
> easier on the user to use such a common method.
>
> But do we *really* mean to say that it is a sensible thing to bind the
> same key to multiple contradictory definitions? It just so happens
> that [xK_i isohunt, xK_i irssi] is equivalent to a destructive update
> style of 'i = isohunt; i = irssi' when fed through the Map functions.
>
> So I thought to myself that maybe there was some static way of
> specifying a list without duplicates we could use in xmonad.hs. It
> would be nice to know that one cannot run xmonad.hs with inconsistent
> sets of bindings*. This checking would, even better, be done at
> compile-time so one could verify this by simply loading in GHCi (good
> for everyone who routinely reloads in Emacs or Vim).
>
> How to do this? Someone in #haskell suggested extensible records, but
> that sounds quite difficult. Another approach would be to scrap the
> static requirement, and simply provide the user a redefined 'fromList'
> which runs something like 'let x = map fst list in nub x == x' and
> does something if there are duplicates (calls error, spawns xmessage,
> etc.)


> The idea is that one should be able to do something like this in xmonad.hs
>> '{-# LANGUAGE TemplateHaskell #-}
>> import XMonad.Utils.VerifyKeys
>> ....
>> myKeys conf@(XConfig {modMask = m}) = M.fromList $(uniqueTupleListQ [ -- rebind standard actions
>>             ((m .|. shiftMask,xK_p), shellPrompt greenXPConfig)
>>           , ((m,              xK_d), raiseBrowser) ] )
>
> VerifyKeys looks something like this:
>
>> {-# LANGUAGE TemplateHaskell #-}
>> module XMonad.Utils.VerifyKeys where
>>
>> import Data.List(nub)
>> import qualified Data.Map
>> import Language.Haskell.TH.Lib
>> import Language.Haskell.TH.Syntax
>>
>> uniqueTupleListQ :: (Eq a, Lift a, Lift b) => [(a, b)] -> ExpQ
>> uniqueTupleListQ xs = let ys = map fst xs
>>                      ns = nub ys
>>                   in case ys == ns of
>>                       False -> fail "uniqueTupleListQ: List has conflicting entries."
>>                       True  -> lift xs
>
> The idea is that since we know the keymap at compile-time, we pass it,
> before it gets turned into a Map (and the relevant information lost),
> we analyze the list. 'fail' aborts the compilation if the list is bad.
> You can easily test this out in a different module with some simple
> expressions:
>
>> keymap1, keymap2 :: [(Char, String)]
>> keymap1 = $(uniqueTupleListQ [('a', "foo"), ('b', "bar")] )
>> keymap2 = $(uniqueTupleListQ [('a', "foo"), ('b', "bar"), ('c', "bar"), ('a', "quux")] )
>
> Compiling, this gives us something like this:
>
>> [1 of 2] Compiling Tmp              ( Tmp.hs, Tmp.o )
>> [2 of 2] Compiling Main             ( xmonad.hs, xmonad.o )
>> Loading package base ... linking ... done.
>> Loading package array-0.1.0.0 ... linking ... done.
>> Loading package packedstring-0.1.0.0 ... linking ... done.
>> Loading package containers-0.1.0.1 ... linking ... done.
>> Loading package pretty-1.0.0.0 ... linking ... done.
>> Loading package template-haskell ... linking ... done.
>>
>> xmonad.hs:113:12: uniqueTupleListQ: List has conflicting entries.
>
> Line 133 is keymap2. If we remove '('a', "quux")', which conflicts
> with the very first entry, we get:
>
>> [1 of 2] Compiling Tmp              ( Tmp.hs, Tmp.o )
>> [2 of 2] Compiling Main             ( xmonad.hs, xmonad.o )
>> Loading package base ... linking ... done.
>> Loading package array-0.1.0.0 ... linking ... done.
>> Loading package packedstring-0.1.0.0 ... linking ... done.
>> Loading package containers-0.1.0.1 ... linking ... done.
>> Loading package pretty-1.0.0.0 ... linking ... done.
>> Loading package template-haskell ... linking ... done.
>> Linking foo ...
>
> Now, this seems to be exactly what we want, doesn't it? But ultimately
> I had to admit failure. Template Haskell has a number of restrictions
> and omissions that make it unfeasible to use.
>
> For starters: If we apply uniqueTupleList to an actual keymap (like
> mine), we discover that uniqueTupleList's constraints are unworkable.
> Per the type sig, we need 'Lift b', the second half of each tuple in
> the key list. But XMonad requires b to be a X (), and X () is not
> instantiated for Lift**. Were it, we would still need Lift instances
> for Word64 and also CUInt.
>
> Lift instances probably wouldn't be too hard to write. The real
> killer, from an xmonad.hs perspective, is the module restrictions.
> Fundamentally, one *cannot* use inside a $() anything defined in the
> same file. {modMask = m}? Nope. greenXPConfig? Nope. 'term =
> XMonad.terminal conf'? Nope. And so on. It is a minimal set of
> bindings indeed which only makes use of literals and imported
> functions.
>
> So until Template Haskell improves, that avenue seems to be out.
>
> I'm not sure where to go from here. Had Template Haskell worked out,
> the path would've been easy, a matter of having users make a
> relatively small modification to their xmonad.hs, and perhaps avoiding
> entirely TH syntax.
>
> Does anyone have a better approach, or is this a foolish thing to want
> static safety in? ksf suggested that Yi has a combinator approach to
> keybindings which could solve it, but I am unsure how that works or
> could be adapted for XMonad.***
>
> * Obviously the consistency is only valuable _in_ a specific Map; if
> we insisted that all Maps be consistent, then we couldn't override the
> default Map with our own.
> ** I may be misinterpreting the type error; possibly we actually need
> Lift for (X())
> *** I'm cc'ing yi-devel since I suspect the topic may be of interest.

I brought this technique up in #haskell today, where aavogt pointed
out that the issue about not being able to access config parameters
inside the TH splice could be worked around as long as the TH splice
returned a partially applied function which wanted the necessary
parameters and would use them appropriately inside itself - that is
(very loosely), instead of $(check fookeymap), it'd be more $(check
(\x y -> fookeymap x y)). The TH would only inspect the keys of the
tuples, and not the functions inside the second space in the tuple.

His basic code, using Matt Morrow's haskell-src-meta package:
http://hpaste.org/fastcgi/hpaste.fcgi/view?id=24296#a24302

The checking module:

{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module KM where

import XMonad

import KM.Private

import Control.Monad
import Data.List
import qualified Data.Map as M

import Language.Haskell.Meta.Parse
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax

{- | Use in a record update of XConfig like:

To the top of your file:

> {-# LANGUAGE QuasiQuotes #-}

> import KM

> main = xmonad $ defaultConfig
>  { terminal = "xterm"
>  , keys = keys defaultConfig <+> \conf@(XConfig { .. }) -> [$fromUniqueList|
>                       ((modMask .|. shiftMask, xK_v), spawn terminal),
>                       ((modMask .|. shiftMask, xK_v), print workspaces)
>                   |]

-}
fromUniqueList = QuasiQuoter
    { quoteExp = either fail (\input -> do
        ListE input' <- return input
        duplicates <- liftM getDupes $ forM input' $ \x -> do
            TupE [a,b] <- return x
            return a

        runIO $ print duplicates
        unless (null duplicates) $ fail ("Keys overlap:" ++ show duplicates)
        [| M.fromList $(return input) |]
        )
      . parseExp . ('[':) . (++"]")
    , quotePat = error "KM.fromUniqueList: quotePat"
    }

getDupes :: Eq a => [a] -> [a]
getDupes [] = []
getDupes (x:xs) = case (x==) `find` xs of
                Just _ -> x : dupes
                _ -> dupes
    where dupes = getDupes xs

An example xmonad.hs:

>{-# LANGUAGE QuasiQuotes #-}
>{-# LANGUAGE RecordWildCards #-}

> import XMonad
> import KM

> main = xmonad $ defaultConfig
>  { terminal = "xterm"
>  , keys = keys defaultConfig <+> \conf@(XConfig { .. }) -> [$fromUniqueList|
>                       ((modMask .|. shiftMask, xK_v), spawn terminal),
>                       ((modMask .|. shiftMask, xK_v), io $ print workspaces) |]
>  }

This would trigger a compile error like:

xmonad.hs:11:120: Keys overlap:[TupE [VarE m,VarE xK_v]]

(No dupes mean no messages, of course.)

One doesn't have to write the lambda inline, of course. It can be
split out as usual. For example, here's my full config with a
duplicate hidden inside it:

{-# LANGUAGE QuasiQuotes #-}
import KM

import Data.Bits (Bits((.|.)))
import Data.Map as M (fromList, Map())
import XMonad
import XMonad.Actions.GridSelect (defaultGSConfig, goToSelected)
import XMonad.Actions.Search (google, isohunt, wayback, wikipedia,
selectSearch, promptSearch)
import XMonad.Actions.WindowGo (raiseMaybe, raiseBrowser, raiseEditor,
runOrRaise)
import XMonad.Config.Gnome (gnomeConfig)
import XMonad.Hooks.EwmhDesktops (ewmhDesktopsLogHook)
import XMonad.Hooks.ManageDocks (avoidStruts, manageDocks)
import XMonad.Hooks.UrgencyHook (withUrgencyHook, FocusHook(..))
import XMonad.Layout.NoBorders (smartBorders)
import XMonad.Prompt (greenXPConfig)
import XMonad.Prompt.Shell (shellPrompt, prompt, safePrompt)
import XMonad.StackSet as W (focusUp, focusDown, sink)
import XMonad.Util.Run (unsafeSpawn, runInTerm, safeSpawnProg)
import XMonad.Util.XSelection (safePromptSelection)
import XMonad.Hooks.SetWMName (setWMName)

main :: IO ()
main = spawn "emacs --daemon" >> xmonad myConfig
 where myConfig = withUrgencyHook FocusHook $ gnomeConfig {
focusedBorderColor = "red"
                        , keys = keys defaultConfig <+> mykeymap
                         , layoutHook =  avoidStruts $ smartBorders
(Full ||| Mirror tiled ||| tiled)
                         , logHook    = ewmhDesktopsLogHook >> setWMName "LG3D"
                         , manageHook = myManageHook
                         , modMask = mod4Mask
                         , normalBorderColor  = "grey"
                         , terminal = "urxvt"
                         , XMonad.workspaces = ["web", "irc", "code", "4"] }
           where tiled = Tall 1 0.03 0.5

{- Important things to note: We specifically don't use 'managehook
   defaultConfig, since I don't like floating mplayer and I don't use the other
   specified applications. Otherwise, we have manageDocks there to allow use of
   gnome-panel; Firefox/Emacs/Irssi go to their designated workspaces. -}
myManageHook :: ManageHook
myManageHook = composeAll [moveToT "Amphetype" "code",
                           moveToT "Brain Workshop 4.7" "code",
                           moveToC "Emacs"     "code",
                           moveToC "Firefox" "web",
                           moveToC "Gimp"      "irc",
                           moveToC "gscan2pdf" "code",
                           moveToC "Mnemosyne" "code",
                           moveToT "irssi"     "irc",
                           className =? "defcon.bin.x86" --> unfloat,
                           className =? "Darwinia" --> unfloat,
                           className =? "gnome-panel" --> doIgnore,
                           className =? "Mnemosyne" --> unfloat,
                           title     =? "Brain Workshop 4.7" --> unfloat]
                           <+> manageDocks
          where moveToC c w = className =? c --> doShift w
                moveToT t w = title     =? t --> doShift w
                unfloat = ask >>= doF . W.sink

mykeymap = \(XConfig { modMask = m, terminal = term }) -> [$fromUniqueList|
            ((m .|. shiftMask,xK_p), shellPrompt greenXPConfig)
          , ((m,              xK_k), kill)
          , ((m,              xK_n), windows W.focusDown)
          , ((m,              xK_p), windows W.focusUp)
          , ((m,              xK_z), withFocused $ windows . W.sink) -- unfloat
          -- Custom bindings and commands
          , ((m,              xK_s), goToSelected defaultGSConfig)
          , ((m               ,xK_a), safeSpawnProg
"/home/gwern/bin/bin/amphetype")
          , ((m,              xK_b), safePrompt "firefox" greenXPConfig)
          , ((m .|. shiftMask,xK_b), safePromptSelection "firefox")
          , ((m,              xK_c), safeSpawnProg term)
          , ((m .|. shiftMask,xK_c), prompt (term ++ " -e") greenXPConfig)
          , ((m .|. shiftMask,xK_d), raiseMaybe (runInTerm "-title
elinks" "elinks") (title =? "elinks"))
          , ((m,              xK_e), raiseEditor)
          , ((m .|. shiftMask,xK_e), prompt "emacsclient -c -a emacs"
greenXPConfig)
          , ((m,              xK_g), promptSearch greenXPConfig google)
          , ((m .|. shiftMask,xK_g), selectSearch google)
          , ((m,              xK_t), promptSearch greenXPConfig wikipedia)
          , ((m .|. shiftMask,xK_t), selectSearch wikipedia)
          , ((m,              xK_u), promptSearch greenXPConfig isohunt)
          , ((m .|. shiftMask,xK_u), selectSearch isohunt)
          , ((m,              xK_y), promptSearch greenXPConfig wayback)
          , ((m .|. shiftMask,xK_y), selectSearch wayback)
          , ((m,              xK_w), safeSpawnProg
"/home/gwern/bin/bin/brainworkshop")
          , ((m,          xK_Print), unsafeSpawn "import -quality 90
-window root png:$HOME/xwd-$(date +%s)$$.png")
          , ((m,              xK_i), raiseMaybe (runInTerm "-title
irssi" "sh -c 'screen -r irssi'") (title =? "irssi"))
          , ((m,              xK_m), runOrRaise "mnemosyne" (className
=? "Mnemosyne"))
          , ((m,              xK_r), raiseMaybe (runInTerm "-title
rtorrent" "sh -c 'screen -r rtorrent'") (title =? "rtorrent"))
          , ((m,              xK_p), selectSearch wayback)
          , ((m,              xK_d), raiseBrowser)
                   |]

We can verify that the duplicate bindings of mod-p is caught as an error:


[07:06 PM] 2Mb$ ghci xmonad.hs
GHCi, version 6.10.4: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
package flags have changed, resetting and loading new packages...
Loading package extensible-exceptions-0.1.1.0 ... linking ... done.
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package containers-0.2.0.1 ... linking ... done.
Loading package filepath-1.1.0.2 ... linking ... done.
Loading package old-locale-1.0.0.1 ... linking ... done.
Loading package old-time-1.0.0.2 ... linking ... done.
Loading package unix-2.3.2.0 ... linking ... done.
Loading package directory-1.0.0.3 ... linking ... done.
Loading package pretty-1.0.1.0 ... linking ... done.
Loading package process-1.0.1.1 ... linking ... done.
Loading package Cabal-1.6.0.3 ... linking ... done.
Loading package bytestring-0.9.1.4 ... linking ... done.
Loading package random-1.0.0.1 ... linking ... done.
Loading package haskell98 ... linking ... done.
Loading package hpc-0.5.0.3 ... linking ... done.
Loading package packedstring-0.1.0.1 ... linking ... done.
Loading package template-haskell ... linking ... done.
Loading package ghc-6.10.4 ... linking ... done.
Loading package base-3.0.3.1 ... linking ... done.
Loading package mtl-1.1.0.2 ... linking ... done.
Loading package QuickCheck-2.1.0.3 ... linking ... done.
[1 of 2] Compiling KM               ( KM.hs, interpreted )

KM.hs:11:0:
    Warning: Module `Language.Haskell.TH' is imported, but nothing
from it is used,
               except perhaps instances visible in `Language.Haskell.TH'
             To suppress this warning, use: import Language.Haskell.TH()

KM.hs:31:0:
    Warning: Definition but no type signature for `fromUniqueList'
             Inferred type: fromUniqueList :: QuasiQuoter

KM.hs:35:20: Warning: Defined but not used: `b'
[2 of 2] Compiling Main             ( xmonad.hs, interpreted )
Loading package cpphs-1.11 ... linking ... done.
Loading package haskell-src-exts-1.2.0 ... linking ... done.
Loading package haskell-src-meta-0.0.6 ... linking ... done.
[TupE [VarE m,VarE xK_p]]

xmonad.hs:58:75: Keys overlap:[TupE [VarE m,VarE xK_p]]
Failed, modules loaded: KM.

So, with a basic solution working, we ought to consider whether to use
it. (I assume there's some way to hide the TH splice inside
xmonad-core so we don't require any user-visible changes.) This is
additional static checking, and it removes one unfortunate feature of
list syntax, so it seems good to me.

I recall Don has in the past on Reddit & Hacker News asserted that
Template Haskell is quite as satisfactory as Lisp systems' macros;
they use macros in all sorts of places, so presumably there would be
no issue with switching xmonad's thousands* of users over to using
Template Haskell.

* hyperbole? We can hope not.

-- 
gwern


More information about the xmonad mailing list