Stack script that remaps the caps lock key to control

remap-caps-to-control.hs

#!/usr/bin/env stack
--stack --resolver lts-13.21 script --package process --package optparse-applicative

import Options.Applicative
import System.Process (callProcess)

main :: IO ()
main = execParser options >>= run

run :: Options -> IO ()
run (Options program logger) = program logger

data Options = Options { undo :: Program, verbose :: Logger }
type Program = Logger -> IO ()
type Logger = String -> IO ()

options :: ParserInfo Options
options = info
  (Options
    <$> flag remap demap
      (long "reset" <> short 'r' <> help "Reset key mappings")
    <*> flag ignoreStr putStrLn
      (long "verbose" <> short 'v' <> help "Log to stdout")
    <**> helper)
  (fullDesc <> progDesc "Remap the CapsLock key to Ctrl")

ignoreStr :: Logger
ignoreStr _ = return ()

traceCallProcess :: Logger -> String -> [String] -> IO ()
traceCallProcess log executable args = do
  log $ unwords ("$" : (executable : args))
  callProcess executable args

remap, demap :: Program
remap log = do
  log "# Remap [CapsLock] -> [Ctrl]"
  traceCallProcess log "setxkbmap" ["-option", "ctrl:nocaps"]
demap log = do
  log "# Reset key mappings"
  traceCallProcess log "setxkbmap" ["-option"]