Making XMonad menus with dhall

Here is a menu effect in XMonad.

These can be a fun and useful addition to your desktop, but very annoying to write. We don’t want to keep lots of hardcoded string in Haskell, but we’d be unable to program any interactivity from a yaml or json config format. Let’s see how far we can get with dhall.

Let’s make a simple menu that executes some system commands in a terminal. We’ll use the alacritty terminal, but you can substitute your own terminal emulator here.

First the dhall sample we would like to interpret:

-- menus.dhall
let Title = Text

let XCommand = Text

let MenuEntry = { title : Title, command : XCommand }

in [ { title = "My Test Menu", command = "alacritty --title \"Hello world\" --hold -e echo \"Hello World\" "}] : List MenuEntry

And the corresponding Haskell type:

data MenuEntry = MenuEntry {command :: String, title :: String}
  deriving stock (Generic)
  deriving anyclass (FromDhall)

We can then make a small function to generate the menu entries that will run the commands in Haskell.

generateMenuEntries :: [MenuEntry] -> [(String, X ())]
generateMenuEntries = fmap (\x -> (Main.title x, unsafeSpawn (command x)))

Now this list of X actions can be turned into a grid using runSelectedAction like so, (using F10 as a hotkey)

main :: IO
main = do
  x <- input auto "/home/USER/.xmonad/menus.dhall"
  xmonad $ def {
    keys = keys def <> \c -> Map.fromList [
     ((0, xK_F10), runSelectedAction def {gs_cellwidth = 400} (generateMenuEntries x))
    ]

Let’s add some error handling so it doesn’t explode if it can’t find the file.

main = do
    x <-
      ( do
          a <- D.input D.auto "/home/USER/.xmonad/menus.dhall"
          pure [ ((0, xK_F10), runSelectedAction def {gs_cellwidth = 400} (generateMenuEntries $ ssh a))]
      )
      `catch` (\(e :: SomeException) -> pure [])
    xmonad $ def {
        keys = keys def <> x
      }

This is actually all the haskell we need. Recompile xmonad, and voila, a menu appears.

Let’s make our config a little more semantic. We can make a TermConfig type to capture the different fields of the call to the terminal emulator.

let ShellCommand = Text

let Dir = Text

let TermConfig = { title : Title, command : ShellCommand, dir : Optional Dir }

And a menu with some commands in.

-- nixos-menu.dhall
[ { title = "NixOS Rebuild"
  , command = "sudo nixos-rebuild switch"
  , dir = None Text
  }
, { title = "NixOS Rebuild Upgrade"
  , command = "sudo nixos-rebuild switch --upgrade"
  , dir = None Text
  }
, { title = "Edit NixOS Config"
  , command = "sudo vim /etc/nixos/"
  , dir = None Text
  }
]

Now we can generate the command string from the typed specification:

let toWDOption
    : forall (x : Optional Dir) -> Text
    = \(x : Optional Dir) ->
        merge { Some = \(a : Text) -> "--working-directory ${a}", None = "" } x

let inAlacritty
    : forall (x : TermConfig) -> XCommand
    = \(x : TermConfig) ->
        "alacritty ${toWDOption x.dir} --title \"${x.title}\" -e ${x.command}"

let toMenuEntry =
    : forall (x : TermConfig) -> MenuEntry
    = \(x : TermConfig) ->
        let z = inAlacritty x in { title = x.title, command = z }

in Prelude.List.map TermConfig MenuEntry toMenuEntry ./nixos-menu.dhall

What’s nice about this separation is that we can see the commands that will be generated by running dhall --file menus.dhall.

[ { command =
      "alacritty  --title \"NixOS Rebuild\" -e sudo nixos-rebuild switch"
  , title = "NixOS Rebuild"
  }
, { command =
      "alacritty  --title \"Nixos Rebuild Upgrade\" -e sudo nixos-rebuild switch --upgrade"
  , title = "Nixos Rebuild Upgrade"
  }
, { command =
     "alacritty  --title \"Edit NixOS Config\" -e sudo vim /etc/nixos/"
  , title = "Edit NixOS Config"
  }
]

We could if we wanted, print these commands to a bash file for manual verification with Prelude.List.map MenuEntry Text (\(x : MenuEntry) -> x.command) and use the dhall text command.

Dealing With Input Prompts

Sometimes we want to generate a menu entry which requires some input from the user. We can do this by passing a lambda from dhall back into haskell and allowing haskell to fill it. Let’s make a slight modification to our MenuEntry type in Haskell.

data MenuEntry a = MenuEntry {command :: a -> String, title :: String}
  deriving stock (Generic)
  deriving anyclass (FromDhall)

generateMenuEntries :: [MenuEntry ()] -> [(String, X ())]
generateMenuEntries = fmap (\x -> (Main.title x, unsafeSpawn (command x ())))

generatePromptMenuEntries :: [MenuEntry String] -> [(String, X ())]
generatePromptMenuEntries = fmap (\x -> (Main.title x, inputPrompt def "Input" ?+ unsafeSpawn . (command x)))

Now we can parameterise a MenuEntry based on whether or not it should expect input or not. The corresponding dhall type would look something like this:

let MenuEntry =
      \(x : Type) -> { title : Title, command : forall (a : x) -> XCommand }

The new version of TermConfig will be similar, with a parameterised command field.

let TermConfig =
      \(x : Type) ->
        { title : Title
        , command : forall (a : x) -> ShellCommand
        , dir : Optional Dir
        }

Now we can express the following menu entry:

-- stack-menu.dhall
[ { title = "New Stack Project", command = \(x : Text) -> "stack new ${x}", dir = "/home/USER/Source" } ]

We don’t want to have to deal with this when we only have a simple command though, so let’s keep our old one and introduce a way to lift between them. Unlike haskell, dhall requires explicit forall on type parameters.

let TermConfig_ = { title : Title, command : ShellCommand, dir : Optional Dir }

let liftTermConfig : TermConfig_ -> TermConfig {} = \(x : TermConfig_) -> { title = x.title, command = \(_: {}) -> x.command, dir = x.dir }

let inAlacritty
    : forall (k : Type) ->
      forall (x : TermConfig k) ->
      forall (a : k) ->
        XCommand
    = \(k : Type) ->
      \(x : TermConfig k) ->
      \(a : k) ->
        "alacritty ${toOption x.dir} --title \"${x.title}\" -e ${x.command a}"

let inAlacritty_
    : forall (x : TermConfig_) -> XCommand
    = \(x : TermConfig_) -> inAlacritty {} (liftTermConfig x) {=}

let toMenuEntry
    : forall (k : Type) ->
      forall (x : TermConfig k) ->
        MenuEntry k
    = \(k : Type) ->
      \(x : TermConfig k) ->
        let z = inAlacritty k x in { title = x.title, command = z }

let toMenuEntry_
    : forall (x : TermConfig_) -> MenuEntry {}
    = \(x : TermConfig_) -> toMenuEntry {} (liftTermConfig x)

in { nixos =
        Prelude.List.map TermConfig_ (MenuEntry {}) toMenuEntry_ ./nixos-menu.dhall
    , stack = Prelude.List.map (TermConfig Text) (MenuEntry Text) (toMenuEntry Text) ./stack-menu.dhall
    }

Now we have two menus, we can make a bigger type on the Haskell side to hold both of them.

data Menus = Menus {nixos :: [MenuEntry ()], stack :: [MenuEntry String]}
  deriving stock (Generic)
  deriving anyclass (FromDhall)

--- *snip

   ((0, xK_F9), runSelectedAction def {gs_cellwidth = 400} (generatePromptMenuEntries $ stack x)),
   ((0, xK_F10), runSelectedAction def {gs_cellwidth = 400} (generateMenuEntries $ nixos x))

Of course, shell commands are just a special case of text templating, so you can apply the same principles to anything where you need to inject a type into a text format string (like html snippets).

The code for this is available as a dhall package at gitlab.homotopic.tech.

Homotopic.Tech

A Simple Menu

Dealing With Input Prompts