GenerateManpage: Drop all dependencies except base and invoke in CI

pandoc's API changes often enough that distros like Debian were patching
our GenerateManpage.hs to work with their version of pandoc, and it
doesn't build against any Stackage LTS except the recently released
LTS-17. Also, building pandoc from source takes quite some time and
resources.

But for what benefit? We're not using any special pandoc functionality
whatsoever. It's just that it was all in Haskell and the entire build
was orchestrated by cabal, but is all that complexity and resource
consumption worth it? I think not.

(Frankly, this whole thing was just a massive waste of time as the help
text in Config.hs isn't generated at all, so we still need to do this
manually. And then, the default key-bindings in core are unlikely to
change ever again.)

Let's simplify this:

* drop all dependencies except base and just run it through runhaskell

* add a Makefile and GH Actions workflow that invokes this after push

* only ship the results in release tarball, not the scripts which are
  considered our dev infrastructure

Closes: https://github.com/xmonad/xmonad/issues/283
Related: https://github.com/xmonad/xmonad/pull/260
Related: https://github.com/xmonad/xmonad/pull/261
Related: https://github.com/xmonad/xmonad/pull/265
Related: https://github.com/xmonad/xmonad/pull/266
Related: https://github.com/xmonad/xmonad/pull/267
Related: https://github.com/xmonad/xmonad/pull/268

.github/workflows/generatemanpage.yml

@@ -0,0 +1,33 @@
+name: Generate manpage
+
+on:
+  push:
+    branches:
+      - master
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Clone project
+        uses: actions/checkout@v2
+
+      - name: Install dependencies
+        run: |
+          set -ex
+          sudo apt install -y pandoc
+
+      - name: Generate manpage
+        run: |
+          set -ex
+          for d in /opt/ghc/*/bin; do PATH="$d:$PATH"; break; done
+          make -B -C man
+
+      - name: Commit/push if changed
+        run: |
+          set -ex
+          git config user.name github-actions
+          git config user.email github-actions@github.com
+          git diff --quiet --exit-code && exit
+          git commit -a -m 'man: Update'
+          git push

CHANGES.md

@@ -37,6 +37,10 @@
 
   * Added `Foldable`, `Functor`, and `Traversable` instances for `Stack`.
 
+  * `util/GenerateManpage.hs` is no longer distributed in the tarball.
+    Instead, the manpage source is regenerated and manpage rebuilt
+    automatically in CI.
+
 ## 0.15 (September 30, 2018)
 
   * Reimplement `sendMessage` to deal properly with windowset changes made

cabal.project

@@ -2,6 +2,3 @@
 
 packages:
   xmonad.cabal
-
-package xmonad
-  flags: +generatemanpage

man/Makefile

@@ -0,0 +1,11 @@
+.PHONY: all
+all: xmonad.1 xmonad.1.html
+
+xmonad.1.markdown: xmonad.1.markdown.in
+	(cd .. && util/GenerateManpage.hs) <$< >$@
+
+xmonad.1: xmonad.1.markdown
+	pandoc --from=markdown --to=man --standalone --output=$@ $<
+
+xmonad.1.html: xmonad.1.markdown
+	pandoc --from=markdown --to=html --standalone --table-of-contents --output=$@ $<

util/GenerateManpage.hs

@@ -1,47 +1,20 @@
-{-# LANGUAGE FlexibleContexts #-}
+#!/usr/bin/env runhaskell
 
--- Generates a in-memory version of "man/xmonad.1.markdown" that has the list
--- of known key-bindings is inserted automatically from "Config.hs". That
--- document is then rendered with Pandoc as "man/xmonad.1" and
--- "man/xmonad.1.html".
+-- Reads markdown (man/xmonad.1.markdown) from stdin, subtitutes
+-- ___KEYBINDINGS___ for key-binding definitions generated from
+-- src/XMonad/Config.hs, prints result to stdout.
 --
 -- Unlike the rest of xmonad, this file is released under the GNU General
--- Public License version 2 or later.
+-- Public License version 2 or later. (Historical reasons, used to link with
+-- GPL-licensed pandoc.)
 
-import Control.Monad.IO.Class (liftIO)
 import Data.Char
 import Data.List
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import Text.Pandoc
-import Text.Regex.Posix
 
 main :: IO ()
 main = do
     keybindings <- guessBindings
-
-    markdownSource <- readFile "./man/xmonad.1.markdown"
-
-    runIOorExplode $ do
-        parsed <- readMarkdown (def { readerStandalone = True, readerExtensions = pandocExtensions })
-            . T.pack
-            . unlines
-            . replace "___KEYBINDINGS___" keybindings
-            . lines
-            $ markdownSource
-
-        manTemplate <- compileDefaultTemplate (T.pack "man")
-        manBody <- writeMan def { writerTemplate = Just manTemplate } parsed
-        liftIO $ TIO.writeFile "./man/xmonad.1" $ manBody
-        liftIO $ putStrLn "Documentation created: man/xmonad.1"
-
-        htmltemplate <- compileDefaultTemplate (T.pack "html")
-        htmlBody <- writeHtml5String def
-                                     { writerTemplate = Just htmltemplate
-                                     , writerTableOfContents = True }
-                                     parsed
-        liftIO $ TIO.writeFile "./man/xmonad.1.html" htmlBody
-        liftIO $ putStrLn "Documentation created: man/xmonad.1.html"
+    interact $ unlines . replace "___KEYBINDINGS___" keybindings . lines
 
 -- | The format for the docstrings in "Config.hs" takes the following form:
 --
@@ -49,7 +22,7 @@ main = do
 --   -- mod-x %! Frob the whatsit
 -- @
 --
--- "Frob the whatsit" will be used as the description for keybinding "mod-x".--
+-- "Frob the whatsit" will be used as the description for keybinding "mod-x".
 -- If the name of the key binding is omitted, the function tries to guess it
 -- from the rest of the line. For example:
 --
@@ -65,21 +38,29 @@ guessBindings = do
     return (intercalate "\n\n" (map markdownDefn (allBindings buf)))
 
 allBindings :: String -> [(String, String)]
-allBindings xs = map (binding . map trim) (xs =~ "(.*)--(.*)%!(.*)")
-
-binding :: [String] -> (String, String)
-binding [ _, bindingLine, "", desc ] = (guessKeys bindingLine, desc)
-binding [ _, _, keyCombo, desc ] = (keyCombo, desc)
-binding x = error ("binding: called with unexpected argument " ++ show x)
-
-guessKeys :: String -> String
-guessKeys line =
-  case keys of
-    [key] -> concat $ intersperse "-" (modifiers ++ [map toLower key])
-    _     -> error ("guessKeys: unexpected number of keys " ++ show keys)
+allBindings = concatMap parseLine . lines
   where
-    modifiers = map (!!1) (line =~ "(mod|shift|control)Mask")
-    (_, _, _, keys) = line =~ "xK_([_[:alnum:]]+)" :: (String, String, String, [String])
+    parseLine :: String -> [(String, String)]
+    parseLine l
+        | " -- " `isInfixOf` l
+        , Just d <- parseDesc l = [(intercalate "-" (parseKeys l), d)]
+        | otherwise = []
+
+    parseDesc :: String -> Maybe String
+    parseDesc = fmap (trim . drop 4) . find (" %! " `isPrefixOf`) . tails
+
+    parseKeys :: String -> [String]
+    parseKeys l = case lex l of
+        [("", _)] -> []
+        [("--", rest)] -> case words rest of
+            k : "%!" : _ -> [k]
+            _ -> []
+        [(k, rest)] -> parseKey k ++ parseKeys rest
+
+    parseKey :: String -> [String]
+    parseKey k | "Mask" `isSuffixOf` k = [reverse (drop 4 (reverse k))]
+               | "xK_"  `isPrefixOf` k = [map toLower (drop 3 k)]
+               | otherwise             = []
 
 -- FIXME: What escaping should we be doing on these strings?
 markdownDefn :: (String, String) -> String

xmonad.cabal

@@ -43,7 +43,6 @@ extra-source-files: README.md
                     man/xmonad.1
                     man/xmonad.1.html
                     man/xmonad.hs
-                    util/GenerateManpage.hs
                     util/hpcReport.sh
 cabal-version:      >= 1.8
 
@@ -56,11 +55,6 @@ flag pedantic
   default:     False
   manual:      True
 
-flag generatemanpage
-  default:     False
-  manual:      True
-  description: Build the tool for generating the man page
-
 flag quickcheck-classes
 
 library
@@ -107,15 +101,6 @@ executable xmonad
   if flag(pedantic)
     ghc-options:   -Werror
 
-executable generatemanpage
-  main-is:        GenerateManpage.hs
-  hs-source-dirs: util
-
-  if flag(generatemanpage)
-    build-depends: base, pandoc > 2.10, regex-posix, text
-  else
-    buildable: False
-
 test-suite properties
   type:           exitcode-stdio-1.0
   main-is:        Properties.hs