Josh Munn's Website
Emacs Lisp in Haskell [2022-11-23 Wed]

Home

Table of Contents

Since first migrating from OSX to Linux, I have been a user of the dwm tiling window manager. It is great software, my thanks to the authors. Lately, however, I've had an itch to change things up. I've been spending some time learning Haskell, so Xmonad is an obvious choice.

Disclaimer: I am a Haskell beginner, and the Haskell snippets in this post will likely reflect that fact.

I like my window manager to have keybindings that allow me to open Emacs frames1 containing specific files or tools, so I can conveniently:

and so on.

xmonad-contrib has a great submap module, which enables behaviour that will be familiar to Emacs users (and similar to leader-key functionality in Vim).

myKeys =
  [ ( (winKey, xK_e),
      submap . Map.fromList $
        [ ( (0, xK_c),
            spawn $ getEmacsClientCommand emacsClientDefaults
          ),
          ( (0, xK_equal),
            spawn $ getEmacsClientCommand emacsCalcArgs
          ),
          ( (0, xK_a),
            spawn $ getEmacsClientCommand orgAgendaArgs
          )
          -- etc. ...
        ]
    )
  ]

With the above declaration, I can activate my "Emacs submap" by pressing M-e (Windows key + "e"), then trigger some action dependent on the next keypress. For example, M-e followed by = will spawn a new Emacs frame with calc ready to go.

I like to run Emacs as a daemon, and use emacsclient to edit. A typical invocation to edit a file in a new frame looks like this:

emacsclient --create-frame /path/to/my-file  

emacsclient also lets you evaluate arbitrary Emacs Lisp (Elisp). For example, to create a new frame with calc maximised, I could execute:

emacsclient --create-frame --eval "(full-calc)"

This begins to get a little hairy when passing strings, as quote-marks and backslashes in strings need escaping, eg.:

emacsclient --create-frame --eval "(org-tags-view nil \"TODO=\\\"NEXT\\\"\")"

An obvious solution is to define Emacs Lisp functions and call them from --eval, so Elisp is restricted to simple expressions and strings don't need the extra level of escaping. However, my "I wonder if I can…" instinct is triggered by the faint smell of an embedded language.

String → ElispExpr: Parsing (a very small subset of) Emacs Lisp

I would like to be able to write Emacs Lisp directly in my Xmonad config file, and have it transformed to Haskell data types so I can programatically generate the program strings to pass to emacsclient for evaluation. Conveniently, GHC (the Glasgow Haskell Compiler) has extensions for compile-time metaprogramming - namely, TemplateHaskell and QuasiQuotes.

Quasi-quoters allow us to embed arbitrary syntax in a Haskell source file, so long as we transform it to valid Haskell syntax. To represent an Elisp program in Haskell, I define the following data type:

data ElispExpr
  = EString String
  | ESymbol String
  | EQuoted ElispExpr
  | EList [ElispExpr]
  | EDot
  deriving (Show, Data)

This datatype says that an expression in Elisp is either an atom (a string or a symbol) or a list of atoms. This is not exactly representative of a Lisp program, and is probably more fairly compared to a representation of S-expressions. There's no distinction between lists and function application, and EDot (the dot used in pair syntax, e.g. (foo . bar)) isn't really an atom. But, for my purposes it will work.

We need a parser, to take a String and transform it to an ElispExpr. I used the megaparsec parser combinator2 library. megaparsec has a very thorough tutorial here, so I will not go into details. The parser itself is quite short, so I will reproduce it in full:

type ElispParser = Parsec Void String

-- consume space
sc :: ElispParser ()
sc = L.space space1 empty empty

-- parse a lexeme and consume trailing spaces
lexeme :: ElispParser String -> ElispParser String
lexeme = L.lexeme sc

-- takes a string, returns a parser that matches that string
symbol :: String -> ElispParser String
symbol = L.symbol sc

-- takes a parser, returns a parser that succeeds if that parser
-- is surrounded by parens
parens :: ElispParser a -> ElispParser a
parens = between (symbol "(") (symbol ")")

-- valid chars that make up a symbol
symChar :: ElispParser Char
symChar =
  alphaNumChar
    <|> char '!'
    <|> char '#'
    <|> char '@'
    <|> char '$'
    <|> char '%'
    <|> char '^'
    <|> char '&'
    <|> char '*'
    <|> char '_'
    <|> char '-'
    <|> char '+'
    <|> char '='
    <|> char '/'
    <|> char '<'
    <|> char '>'

-- parse a string literal
eStringLiteral :: ElispParser ElispExpr
eStringLiteral =
  Elisp.lexeme (char '\"' *> manyTill L.charLiteral (char '\"'))
    <&> EString

-- parse a symbol, e.g. a variable name
eSymbol :: ElispParser ElispExpr
eSymbol = Elisp.lexeme (some symChar) <&> ESymbol

-- parse a symbol or a string literal
eAtom :: ElispParser ElispExpr
eAtom = eSymbol <|> eStringLiteral

-- parse the '.' character - discards the input
eDot :: ElispParser ElispExpr
eDot = Elisp.symbol "." >> return EDot

-- parse an expression preceded by the single quote
eQuoted :: ElispParser ElispExpr
eQuoted = char '\'' *> (eAtom <|> eList) <&> EQuoted

-- parse a list
eList :: ElispParser ElispExpr
eList = parens (many (eAtom <|> eQuoted <|> eDot <|> eList)) <&> EList

-- top-level parser, parse an expression
elispExpr :: ElispParser ElispExpr
elispExpr = eQuoted <|> eAtom <|> eList

This is a quick-and-dirty parser, but the brevity and readability of combinatorial parsers is evident. I have omitted code that exists to improve error messages from this reproduction to make the structure of the parser clearer.

We now have a way to take a string of Elisp and turn it into a Haskell representation of our Elisp program. The final step towards being able to write Elisp inline in Haskell source is defining a QuasiQuoter.

elisp :: QuasiQuoter
elisp =
  QuasiQuoter
    { quoteExp = \s ->
        -- use `sc' to consume leading space
        case runParser (sc *> elispExpr) "" s of
          Left err -> error $ errorBundlePretty err
          Right expr -> liftData expr,
    }

Because we derived Data on the ElispExpr type, we can use liftData to take care of some necessary processing, and end up with our Elisp source transformed to ElispExprs in our Haskell program. Neat! A quasi-quoted Elisp expression, such as the following:

orgNextActionsCommand =
  [elisp|
(let ((org-agenda-window-setup 'only-window))
  (org-tags-view nil "TODO=\"NEXT\""))
|]

will be encoded in our Haskell program as:

EList
  [ ESymbol "let",
    EList
    [ EList
      [ ESymbol "org-agenda-window-setup",
        EQuoted (ESymbol "only-window")
      ]
    ],
    EList
    [ ESymbol "org-tags-view",
      ESymbol "nil",
      EString "TODO=\"NEXT\""
    ]
  ]

ElispExpr → String

To use our Haskell-encoded Elisp program as an argument to emacsclient, we need to render it back to a string. For this I defined a prettyPrint function.

prettyPrint :: ElispExpr -> String
prettyPrint (EString s) = show s
prettyPrint (ESymbol s) = s
prettyPrint EDot = "."
prettyPrint (EQuoted e) = "'" ++ prettyPrint e
prettyPrint (EList es) = "(" ++ unwords (map prettyPrint es) ++ ")"

Putting it together

To encapsulate the arguments to an emacsclient invocation, I created an EmacsClientArgs datatype.

data EmacsClientArgs = EmacsClientArgs
  { emacsClientEval :: ElispExpr,
    emacsClientFrameParams :: ElispExpr,
    emacsClientFile :: String
  }

emacsClientDefaults :: EmacsClientArgs
emacsClientDefaults =
  EmacsClientArgs
    { emacsClientEval = [elisp|()|],
      emacsClientFrameParams = [elisp|()|],
      emacsClientFile = ""
    }

To take care of putting it all together, I use toArgString.

class ToArgString a where
  toArgString :: a -> String

instance ToArgString EmacsClientArgs where
  toArgString args =
    let eval = case emacsClientEval args of
          EList [] -> ""
          expr -> "--eval " ++ show (prettyPrint expr)
        frameParams = case emacsClientFrameParams args of
          EList [] -> ""
          expr -> "--frame-parameters " ++ show (prettyPrint expr)
        file = emacsClientFile args
     in unwords [eval, frameParams, file]

So, with the following definitions:

orgAgendaEval =
  [elisp|
(let ((org-agenda-window-setup 'only-window))
  (org-agenda-list))
|]

orgAgendaArgs :: EmacsClientArgs
orgAgendaArgs =
  emacsClientDefaults
    { emacsClientEval = orgAgendaEval,
      emacsClientFrameParams = [elisp|((name . "*Org Agenda*"))|]
    }

We can generate the following string:

ghci> toArgString orgAgendaArgs
"--eval \"(let ((org-agenda-window-setup 'only-window)) (org-agenda-list))\" --frame-parameters \"((name . \\\"*Org Agenda*\\\"))\" "

Being able to write Elisp directly in my Xmonad config feels good. I would, of course, write anything remotely complex in my Emacs config, or an Emacs package, but for experimenting with short snippets this is convenient!

Inline elisp-mode in Haskell buffers!

My next line of thought was that it would be cool to get Elisp syntax highlighting in the elisp quasi-quoter in my Xmonad config. Having used web-mode I was sure there would be a way, and as it turns out polymode makes this fairly straightforward. With the following polymode definition:

(define-hostmode poly-haskell-hostmode
  :mode nil)

(define-innermode poly-haskell-elisp-innermode
  :mode 'emacs-lisp-mode
  :head-matcher "\\[elisp|\n?"
  :tail-matcher "|\\]"
  :head-mode 'host
  :tail-mode 'host)

(define-polymode poly-haskell-mode
  :hostmode 'poly-haskell-hostmode
  :innermodes '(poly-haskell-elisp-innermode))

Elisp quasi-quoter regions are treated as distinct buffers running under elisp-mode! The following screenshot (apologies for the picture of text) shows a portion of my Xmonad config, with Prot's ef-summer theme, using the polymode. With this minor-mode activated I get Elisp syntax highlighting, indentation and code completion inline in the Haskell buffer.

EmacsYiejUp.svg

Issues

When launching an emacsclient frame via Xmonad, I like to have some particular frames open in specific window layouts. For example, org-capture and org-agenda should open in a floating, centered window. As these buffers are created by calling an Elisp function, the initial title of the X window does not match the name of the frame that you see when you load the org-agenda buffer, i.e. "*Org Agenda*". To get around this, we can use the --frame-parameters option to emacsclient to give the frame a specific name.

orgAgendaArgs =
  emacsClientDefaults
    { emacsClientEval = orgAgendaEval,
      emacsClientFrameParams = [elisp|((name . "*Org Agenda*"))|]
    }

Now we can match on the name in the manageHook:

myManageHook =
  composeAll
    [ title =? "*Org Agenda*" --> doCenterFloat
      -- ... etc
    ]

Footnotes:

1

In this post I refer to frames and windows. In the context of Emacs, a frame is what most computer users would think of as a "window" in their graphical desktop environment, and a window is like a "pane" within the frame. See the Emacs manual for more detail.

2

For a comprehensive introduction to Monadic Parser Combinators that reads like a tutorial, Graham Hutton and Erik Meijer's paper is hard to beat.