indigo-all-keys.hs

#!/usr/bin/env runghc

{-# LANGUAGE GHC2024 #-}
{-# OPTIONS_GHC -Wall #-}

import Control.Applicative (optional, (<|>))
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Prelude hiding (Either (..))

data Key = Key
  { modifiers :: [KeyModifier]
  , code :: KeyCode
  }

instance Show Key where
  show = \case
    Key{modifiers = [], code} | length (show code) == 1 -> show code
    Key{modifiers = [], code} -> "<" <> show code <> ">"
    Key{modifiers, code} -> "<" <> intercalate "-" (map show modifiers) <> "-" <> show code <> ">"

keys :: [Key]
keys = do
  m1 <- optional keyModifiers
  m2 <- optional (filter (`notElem` catMaybes [m1]) keyModifiers)
  m3 <- optional (filter (`notElem` catMaybes [m1, m2]) keyModifiers)
  let modifiers = catMaybes [m1, m2, m3]
  code <- keyCodes
  pure Key{ modifiers, code }

data KeyCode
  = Backspace
  | Delete
  | Return
  | Left
  | Right
  | Up
  | Down
  | Tab
  | Escape
  | Char Char

instance Show KeyCode where
  show = \case
    Backspace -> "bs"
    Delete -> "del"
    Return -> "ret"
    Left -> "left"
    Right -> "right"
    Up -> "up"
    Down -> "down"
    Tab -> "tab"
    Escape -> "esc"
    Char '<' -> "lt"
    Char '>' -> "gt"
    Char '-' -> "minus"
    Char ' ' -> "space"
    Char c -> [c]

keyCodes :: [KeyCode]
keyCodes =
  [ Backspace
  , Delete
  , Return
  , Left
  , Right
  , Up
  , Down
  , Tab
  , Escape
  ] <|> fmap Char [' ' .. '~']

data KeyModifier
  = Control
  | Alt
  | Shift
  deriving stock (Eq)

instance Show KeyModifier where
  show = \case
    Control -> "c"
    Alt -> "a"
    Shift -> "s"

keyModifiers :: [KeyModifier]
keyModifiers =
  [ Control
  , Alt
  , Shift
  ]

main :: IO ()
main = putStrLn (unlines (map show keys))