{-# Language RankNTypes, OverloadedStrings #-}
{-|
Module      : Client.EventLoop.Actions
Description : Programmable keyboard actions
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

-}

module Client.EventLoop.Actions
  ( Action(..)
  , KeyMap
  , keyToAction
  , initialKeyMap
  , addKeyBinding
  , removeKeyBinding
  , keyMapEntries

  -- * Keys as text
  , parseKey
  , prettyModifierKey
  , actionName
  ) where

import Config.Schema.Spec (anyAtomSpec, customSpec, HasSpec(..))
import Control.Applicative (Alternative(empty))
import Control.Lens (Lens', (^.), non', (?~), set, At(at), AsEmpty(_Empty))
import Data.Char (showLitChar)
import Data.Functor.Compose (Compose(Compose, getCompose))
import Data.HashMap.Lazy (HashMap)
import Data.HashMap.Lazy qualified as HashMap
import Data.List (nub, sort)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Graphics.Vty.Input.Events
import Text.Read (readMaybe)

-- | Actions that can be invoked using the keyboard.
data Action

  = ActBackspace
  | ActDelete
  | ActLeft
  | ActRight
  | ActHome
  | ActEnd
  | ActOlderLine
  | ActNewerLine
  | ActScrollUp
  | ActScrollDown
  | ActScrollUpSmall
  | ActScrollDownSmall
  | ActBackWord
  | ActForwardWord

  | ActYank
  | ActKillHome
  | ActKillEnd
  | ActKillWordBack
  | ActKillWordForward
  | ActToggle

  | ActBold
  | ActColor
  | ActItalic
  | ActUnderline
  | ActStrikethrough
  | ActReverseVideo
  | ActMonospace
  | ActClearFormat
  | ActInsertEnter
  | ActDigraph

  | ActRetreatFocus
  | ActAdvanceFocus
  | ActAdvanceNetwork
  | ActJumpToActivity
  | ActJumpPrevious
  | ActJump Char

  | ActTabComplete
  | ActTabCompleteBack

  | ActEnter
  | ActReset
  | ActRefresh
  | ActCommand Text
  | ActInsert Char
  | ActIgnored
  deriving (Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Eq Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmax :: Action -> Action -> Action
>= :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c< :: Action -> Action -> Bool
compare :: Action -> Action -> Ordering
$ccompare :: Action -> Action -> Ordering
Ord, ReadPrec [Action]
ReadPrec Action
Int -> ReadS Action
ReadS [Action]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Action]
$creadListPrec :: ReadPrec [Action]
readPrec :: ReadPrec Action
$creadPrec :: ReadPrec Action
readList :: ReadS [Action]
$creadList :: ReadS [Action]
readsPrec :: Int -> ReadS Action
$creadsPrec :: Int -> ReadS Action
Read, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

-- | Lookup table for keyboard events to actions. Use with
-- keyToAction.
newtype KeyMap = KeyMap (Map [Modifier] (Map Key Action))
  deriving (Int -> KeyMap -> ShowS
[KeyMap] -> ShowS
KeyMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMap] -> ShowS
$cshowList :: [KeyMap] -> ShowS
show :: KeyMap -> String
$cshow :: KeyMap -> String
showsPrec :: Int -> KeyMap -> ShowS
$cshowsPrec :: Int -> KeyMap -> ShowS
Show)

keyMapEntries :: KeyMap -> [([Modifier], Key, Action)]
keyMapEntries :: KeyMap -> [([Modifier], Key, Action)]
keyMapEntries (KeyMap Map [Modifier] (Map Key Action)
m) =
  [ ([Modifier]
mods, Key
k, Action
a)
     | ([Modifier]
mods, Map Key Action
m1) <- forall k a. Map k a -> [(k, a)]
Map.toList Map [Modifier] (Map Key Action)
m
     , (Key
k,Action
a) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Key Action
m1
     ]

instance HasSpec Action where
  anySpec :: ValueSpec Action
anySpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"action" ValueSpec Text
anyAtomSpec
          forall a b. (a -> b) -> a -> b
$ \Text
a -> case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
a HashMap Text (Action, [([Modifier], Key)])
actionInfos of
                    Maybe (Action, [([Modifier], Key)])
Nothing -> forall a b. a -> Either a b
Left Text
"unknown action"
                    Just (Action, [([Modifier], Key)])
x  -> forall a b. b -> Either a b
Right (forall a b. (a, b) -> a
fst (Action, [([Modifier], Key)])
x)


-- | Names and default key bindings for each action.
--
-- Note that Jump, Insert and Ignored are excluded. These will
-- be computed on demand by keyToAction.
actionInfos :: HashMap Text (Action, [([Modifier],Key)])
actionInfos :: HashMap Text (Action, [([Modifier], Key)])
actionInfos =
  let norm :: b -> ([a], b)
norm = (,) [     ]
      ctrl :: b -> ([Modifier], b)
ctrl = (,) [Modifier
MCtrl]
      meta :: b -> ([Modifier], b)
meta = (,) [Modifier
MMeta] in

  forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

  [(Text
"delete"            , (Action
ActDelete           , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'd'), forall {b} {a}. b -> ([a], b)
norm Key
KDel]))
  ,(Text
"backspace"         , (Action
ActBackspace        , [forall {b} {a}. b -> ([a], b)
norm Key
KBS]))
  ,(Text
"home"              , (Action
ActHome             , [forall {b} {a}. b -> ([a], b)
norm Key
KHome, forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'a')]))
  ,(Text
"end"               , (Action
ActEnd              , [forall {b} {a}. b -> ([a], b)
norm Key
KEnd , forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'e')]))
  ,(Text
"kill-home"         , (Action
ActKillHome         , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'u')]))
  ,(Text
"kill-end"          , (Action
ActKillEnd          , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'k')]))
  ,(Text
"yank"              , (Action
ActYank             , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'y')]))
  ,(Text
"toggle"            , (Action
ActToggle           , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
't')]))
  ,(Text
"kill-word-left"    , (Action
ActKillWordBack     , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'w'), forall {b}. b -> ([Modifier], b)
meta Key
KBS]))
  ,(Text
"kill-word-right"   , (Action
ActKillWordForward  , [forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
'd')]))

  ,(Text
"bold"              , (Action
ActBold             , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'b')]))
  ,(Text
"color"             , (Action
ActColor            , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'c')]))
  ,(Text
"italic"            , (Action
ActItalic           , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
']')]))
  ,(Text
"strikethrough"     , (Action
ActStrikethrough    , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'^')]))
  ,(Text
"underline"         , (Action
ActUnderline        , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'_')]))
  ,(Text
"clear-format"      , (Action
ActClearFormat      , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'o')]))
  ,(Text
"reverse-video"     , (Action
ActReverseVideo     , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'v')]))
  ,(Text
"monospace"         , (Action
ActMonospace        , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'q')]))

  ,(Text
"insert-newline"    , (Action
ActInsertEnter      , [forall {b}. b -> ([Modifier], b)
meta Key
KEnter]))
  ,(Text
"insert-digraph"    , (Action
ActDigraph          , [forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
'k')]))

  ,(Text
"next-window"       , (Action
ActAdvanceFocus     , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'n')]))
  ,(Text
"prev-window"       , (Action
ActRetreatFocus     , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'p')]))
  ,(Text
"next-network"      , (Action
ActAdvanceNetwork   , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'x')]))
  ,(Text
"refresh"           , (Action
ActRefresh          , [forall {b}. b -> ([Modifier], b)
ctrl (Char -> Key
KChar Char
'l')]))
  ,(Text
"jump-to-activity"  , (Action
ActJumpToActivity   , [forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
'a')]))
  ,(Text
"jump-to-previous"  , (Action
ActJumpPrevious     , [forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
's')]))

  ,(Text
"reset"             , (Action
ActReset            , [forall {b} {a}. b -> ([a], b)
norm Key
KEsc]))

  ,(Text
"left-word"         , (Action
ActBackWord         , [forall {b}. b -> ([Modifier], b)
meta Key
KLeft, forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
'b')]))
  ,(Text
"right-word"        , (Action
ActForwardWord      , [forall {b}. b -> ([Modifier], b)
meta Key
KRight, forall {b}. b -> ([Modifier], b)
meta (Char -> Key
KChar Char
'f')]))
  ,(Text
"left"              , (Action
ActLeft             , [forall {b} {a}. b -> ([a], b)
norm Key
KLeft]))
  ,(Text
"right"             , (Action
ActRight            , [forall {b} {a}. b -> ([a], b)
norm Key
KRight]))
  ,(Text
"up"                , (Action
ActOlderLine        , [forall {b} {a}. b -> ([a], b)
norm Key
KUp]))
  ,(Text
"down"              , (Action
ActNewerLine        , [forall {b} {a}. b -> ([a], b)
norm Key
KDown]))
  ,(Text
"scroll-up"         , (Action
ActScrollUp         , [forall {b} {a}. b -> ([a], b)
norm Key
KPageUp]))
  ,(Text
"scroll-down"       , (Action
ActScrollDown       , [forall {b} {a}. b -> ([a], b)
norm Key
KPageDown]))
  ,(Text
"scroll-up-small"   , (Action
ActScrollUpSmall    , [forall {b}. b -> ([Modifier], b)
meta Key
KPageUp]))
  ,(Text
"scroll-down-small" , (Action
ActScrollDownSmall  , [forall {b}. b -> ([Modifier], b)
meta Key
KPageDown]))
  ,(Text
"enter"             , (Action
ActEnter            , [forall {b} {a}. b -> ([a], b)
norm Key
KEnter]))
  ,(Text
"word-complete-back", (Action
ActTabCompleteBack  , [forall {b} {a}. b -> ([a], b)
norm Key
KBackTab]))
  ,(Text
"word-complete"     , (Action
ActTabComplete      , [forall {b} {a}. b -> ([a], b)
norm (Char -> Key
KChar Char
'\t')]))
  ]


actionNames :: Map Action Text
actionNames :: Map Action Text
actionNames = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (Action
action, Text
name) | (Text
name, (Action
action,[([Modifier], Key)]
_)) <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text (Action, [([Modifier], Key)])
actionInfos ]


-- | Render action as human-readable text.
actionName :: Action -> Text
actionName :: Action -> Text
actionName (ActCommand Text
txt) = Text
"command: " forall a. Semigroup a => a -> a -> a
<> Text
txt
actionName Action
a = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (String -> Text
Text.pack (forall a. Show a => a -> String
show Action
a)) Action
a Map Action Text
actionNames


keyMapLens :: [Modifier] -> Key -> Lens' KeyMap (Maybe Action)
keyMapLens :: [Modifier] -> Key -> Lens' KeyMap (Maybe Action)
keyMapLens [Modifier]
mods Key
key Maybe Action -> f (Maybe Action)
f (KeyMap Map [Modifier] (Map Key Action)
m) =
  Map [Modifier] (Map Key Action) -> KeyMap
KeyMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at ([Modifier] -> [Modifier]
normalizeModifiers [Modifier]
mods) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. APrism' a () -> Iso' (Maybe a) a
non' forall a. AsEmpty a => Prism' a ()
_Empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
key) Maybe Action -> f (Maybe Action)
f Map [Modifier] (Map Key Action)
m


-- | Lookup the action to perform in response to a particular key event.
keyToAction ::
  KeyMap     {- ^ actions         -} ->
  [Modifier] {- ^ jump modifier   -} ->
  Text       {- ^ window names    -} ->
  [Modifier] {- ^ actual modifier -} ->
  Key        {- ^ key             -} ->
  Action     {- ^ action          -}
keyToAction :: KeyMap -> [Modifier] -> Text -> [Modifier] -> Key -> Action
keyToAction KeyMap
_ [Modifier]
jumpMods Text
names [Modifier]
mods (KChar Char
c)
  | [Modifier] -> [Modifier]
normalizeModifiers [Modifier]
jumpMods forall a. Eq a => a -> a -> Bool
== [Modifier] -> [Modifier]
normalizeModifiers [Modifier]
mods
  , Char -> Text
Text.singleton Char
c Text -> Text -> Bool
`Text.isInfixOf` Text
names = Char -> Action
ActJump Char
c
keyToAction KeyMap
m [Modifier]
_ Text
_ [Modifier]
modifier Key
key =
  case KeyMap
m forall s a. s -> Getting a s a -> a
^. [Modifier] -> Key -> Lens' KeyMap (Maybe Action)
keyMapLens [Modifier]
modifier Key
key of
    Just Action
a -> Action
a
    Maybe Action
Nothing | KChar Char
c <- Key
key, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
modifier -> Char -> Action
ActInsert Char
c
            | Bool
otherwise                     -> Action
ActIgnored


-- | Bind a keypress event to a new action.
addKeyBinding ::
  [Modifier] {- ^ modifiers -} ->
  Key        {- ^ key       -} ->
  Action     {- ^ action    -} ->
  KeyMap     {- ^ actions   -} ->
  KeyMap
addKeyBinding :: [Modifier] -> Key -> Action -> KeyMap -> KeyMap
addKeyBinding [Modifier]
mods Key
k Action
a = [Modifier] -> Key -> Lens' KeyMap (Maybe Action)
keyMapLens [Modifier]
mods Key
k forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Action
a

-- | Unbind the action associated with a key.
removeKeyBinding ::
  [Modifier] {- ^ modifiers -} ->
  Key        {- ^ key       -} ->
  KeyMap     {- ^ actions   -} ->
  KeyMap
removeKeyBinding :: [Modifier] -> Key -> KeyMap -> KeyMap
removeKeyBinding [Modifier]
mods Key
k = forall s t a b. ASetter s t a b -> b -> s -> t
set ([Modifier] -> Key -> Lens' KeyMap (Maybe Action)
keyMapLens [Modifier]
mods Key
k) forall a. Maybe a
Nothing


normalizeModifiers :: [Modifier] -> [Modifier]
normalizeModifiers :: [Modifier] -> [Modifier]
normalizeModifiers = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort


-- | Default key bindings
initialKeyMap :: KeyMap
initialKeyMap :: KeyMap
initialKeyMap = Map [Modifier] (Map Key Action) -> KeyMap
KeyMap forall a b. (a -> b) -> a -> b
$
  forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall a b. (a -> b) -> a -> b
$

   ([], forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Int -> Key
KFun Int
2, Text -> Action
ActCommand Text
"toggle-detail")
          , (Int -> Key
KFun Int
3, Text -> Action
ActCommand Text
"toggle-activity-bar")
          , (Int -> Key
KFun Int
4, Text -> Action
ActCommand Text
"toggle-metadata")
          , (Int -> Key
KFun Int
5, Text -> Action
ActCommand Text
"toggle-layout")
          , (Int -> Key
KFun Int
6, Text -> Action
ActCommand Text
"toggle-editor")
          , (Int -> Key
KFun Int
7, Text -> Action
ActCommand Text
"toggle-edit-lock")
          ])
    forall a. a -> [a] -> [a]
:

    [ ([Modifier]
mods, forall k a. k -> a -> Map k a
Map.singleton Key
k Action
act)
      | (Action
act, [([Modifier], Key)]
mks) <- forall k v. HashMap k v -> [v]
HashMap.elems HashMap Text (Action, [([Modifier], Key)])
actionInfos
      , ([Modifier]
mods, Key
k)  <- [([Modifier], Key)]
mks
      ]


parseKey :: String -> Maybe ([Modifier], Key)
parseKey :: String -> Maybe ([Modifier], Key)
parseKey = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Compose Maybe ((,) [Modifier]) Key
go
  where
    modifier :: a -> Compose Maybe ((,) [a]) ()
modifier a
x   = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall a. a -> Maybe a
Just ([a
x], ()))
    liftMaybe :: f a -> Compose f ((,) [a]) a
liftMaybe f a
mb = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((,)[] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
mb)
    go :: String -> Compose Maybe ((,) [Modifier]) Key
go String
str =
      case String
str of
        String
"Space"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Key
KChar Char
' ')
        String
"Tab"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Key
KChar Char
'\t')
        String
"BackTab"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KBackTab
        String
"Enter"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KEnter
        String
"Home"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KHome
        String
"End"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KEnd
        String
"Esc"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KEsc
        String
"PageUp"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KPageUp
        String
"PageDown"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KPageDown
        String
"Backspace" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KBS
        String
"Delete"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KDel
        String
"Left"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KLeft
        String
"Right"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KRight
        String
"Up"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KUp
        String
"Down"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
KDown
        [Char
c]         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Key
KChar Char
c)
        Char
'F':String
xs      -> Int -> Key
KFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *} {a} {a}.
Functor f =>
f a -> Compose f ((,) [a]) a
liftMaybe (forall a. Read a => String -> Maybe a
readMaybe String
xs)
        Char
'C':Char
'-':String
xs  -> forall {a}. a -> Compose Maybe ((,) [a]) ()
modifier Modifier
MCtrl  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Compose Maybe ((,) [Modifier]) Key
go String
xs
        Char
'M':Char
'-':String
xs  -> forall {a}. a -> Compose Maybe ((,) [a]) ()
modifier Modifier
MMeta  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Compose Maybe ((,) [Modifier]) Key
go String
xs
        Char
'S':Char
'-':String
xs  -> forall {a}. a -> Compose Maybe ((,) [a]) ()
modifier Modifier
MShift forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Compose Maybe ((,) [Modifier]) Key
go String
xs
        Char
'A':Char
'-':String
xs  -> forall {a}. a -> Compose Maybe ((,) [a]) ()
modifier Modifier
MAlt   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Compose Maybe ((,) [Modifier]) Key
go String
xs
        String
_           -> forall (f :: * -> *) a. Alternative f => f a
empty


prettyModifierKey :: [Modifier] -> Key -> String
prettyModifierKey :: [Modifier] -> Key -> String
prettyModifierKey [Modifier]
mods Key
k
  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Modifier -> ShowS
prettyModifier (Key -> String
prettyKey Key
k) [Modifier]
mods

prettyModifier :: Modifier -> ShowS
prettyModifier :: Modifier -> ShowS
prettyModifier Modifier
MCtrl  = String -> ShowS
showString String
"C-"
prettyModifier Modifier
MMeta  = String -> ShowS
showString String
"M-"
prettyModifier Modifier
MShift = String -> ShowS
showString String
"S-"
prettyModifier Modifier
MAlt   = String -> ShowS
showString String
"A-"

prettyKey :: Key -> String
prettyKey :: Key -> String
prettyKey (KChar Char
' ') = String
"Space"
prettyKey (KChar Char
'\t') = String
"Tab"
prettyKey (KChar Char
c) = Char -> ShowS
showLitChar Char
c String
"" -- escapes anything non-ascii
prettyKey (KFun Int
n)  = Char
'F' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n
prettyKey Key
KBackTab  = String
"BackTab"
prettyKey Key
KEnter    = String
"Enter"
prettyKey Key
KEsc      = String
"Esc"
prettyKey Key
KHome     = String
"Home"
prettyKey Key
KEnd      = String
"End"
prettyKey Key
KPageUp   = String
"PageUp"
prettyKey Key
KPageDown = String
"PageDn"
prettyKey Key
KDel      = String
"Delete"
prettyKey Key
KBS       = String
"Backspace"
prettyKey Key
KLeft     = String
"Left"
prettyKey Key
KRight    = String
"Right"
prettyKey Key
KUp       = String
"Up"
prettyKey Key
KDown     = String
"Down"
prettyKey Key
k         = forall a. Show a => a -> String
show Key
k