module Matterhorn.Types.KeyEvents
  (
  -- * Types
    KeyEvent(..)
  , KeyConfig
  , Binding(..)
  , BindingState(..)

  -- * Data
  , allEvents

  -- * Parsing and pretty-printing
  , parseBinding
  , parseBindingList
  , ppBinding
  , nonCharKeys
  , eventToBinding

  -- * Key event name resolution
  , keyEventFromName
  , keyEventName
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Graphics.Vty as Vty


-- | This enum represents all the possible key events a user might
--   want to use.
data KeyEvent
  = VtyRefreshEvent
  | ShowHelpEvent
  | EnterSelectModeEvent
  | ReplyRecentEvent
  | ToggleMessagePreviewEvent
  | InvokeEditorEvent
  | EnterFastSelectModeEvent
  | QuitEvent
  | NextChannelEvent
  | PrevChannelEvent
  | NextChannelEventAlternate
  | PrevChannelEventAlternate
  | NextUnreadChannelEvent
  | NextUnreadUserOrChannelEvent
  | LastChannelEvent
  | EnterOpenURLModeEvent
  | ClearUnreadEvent
  | ToggleMultiLineEvent
  | EnterFlaggedPostsEvent
  | ToggleChannelListVisibleEvent
  | ToggleExpandedChannelTopicsEvent
  | ShowAttachmentListEvent
  | ChangeMessageEditorFocus

  | EditorKillToBolEvent
  | EditorKillToEolEvent
  | EditorBolEvent
  | EditorEolEvent
  | EditorTransposeCharsEvent
  | EditorDeleteCharacter
  | EditorPrevCharEvent
  | EditorNextCharEvent
  | EditorPrevWordEvent
  | EditorNextWordEvent
  | EditorDeleteNextWordEvent
  | EditorDeletePrevWordEvent
  | EditorHomeEvent
  | EditorEndEvent
  | EditorYankEvent

  | CycleChannelListSorting

  | SelectNextTabEvent
  | SelectPreviousTabEvent

  | SaveAttachmentEvent

  -- generic cancel
  | CancelEvent

  -- channel-scroll-specific
  | LoadMoreEvent
  | OpenMessageURLEvent

  -- scrolling events---maybe rebindable?
  | ScrollUpEvent
  | ScrollDownEvent
  | ScrollLeftEvent
  | ScrollRightEvent
  | PageUpEvent
  | PageDownEvent
  | PageRightEvent
  | PageLeftEvent
  | ScrollTopEvent
  | ScrollBottomEvent
  | SelectOldestMessageEvent
  | ChannelListScrollUpEvent
  | ChannelListScrollDownEvent

  -- select events---not the same as scrolling sometimes!
  | SelectUpEvent
  | SelectDownEvent

  -- search select events---these need to not be valid editor inputs
  -- (such as 'j' and 'k')
  | SearchSelectUpEvent
  | SearchSelectDownEvent

  -- E.g. Pressing enter on an item in a list to do something with it
  | ActivateListItemEvent

  | ViewMessageEvent
  | FillGapEvent
  | CopyPostLinkEvent
  | FlagMessageEvent
  | OpenThreadEvent
  | PinMessageEvent
  | YankMessageEvent
  | YankWholeMessageEvent
  | DeleteMessageEvent
  | EditMessageEvent
  | ReplyMessageEvent
  | ReactToMessageEvent

  -- Attachments
  | AttachmentListAddEvent
  | AttachmentListDeleteEvent
  | AttachmentOpenEvent

  -- Attachment file browser
  | FileBrowserBeginSearchEvent
  | FileBrowserSelectEnterEvent
  | FileBrowserSelectCurrentEvent
  | FileBrowserListPageUpEvent
  | FileBrowserListPageDownEvent
  | FileBrowserListHalfPageUpEvent
  | FileBrowserListHalfPageDownEvent
  | FileBrowserListTopEvent
  | FileBrowserListBottomEvent
  | FileBrowserListNextEvent
  | FileBrowserListPrevEvent


  -- Form submission
  | FormSubmitEvent

  -- Team switching
  | NextTeamEvent
  | PrevTeamEvent
  | MoveCurrentTeamLeftEvent
  | MoveCurrentTeamRightEvent
    deriving (KeyEvent -> KeyEvent -> Bool
(KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool) -> Eq KeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEvent -> KeyEvent -> Bool
$c/= :: KeyEvent -> KeyEvent -> Bool
== :: KeyEvent -> KeyEvent -> Bool
$c== :: KeyEvent -> KeyEvent -> Bool
Eq, Int -> KeyEvent -> ShowS
[KeyEvent] -> ShowS
KeyEvent -> String
(Int -> KeyEvent -> ShowS)
-> (KeyEvent -> String) -> ([KeyEvent] -> ShowS) -> Show KeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEvent] -> ShowS
$cshowList :: [KeyEvent] -> ShowS
show :: KeyEvent -> String
$cshow :: KeyEvent -> String
showsPrec :: Int -> KeyEvent -> ShowS
$cshowsPrec :: Int -> KeyEvent -> ShowS
Show, Eq KeyEvent
Eq KeyEvent
-> (KeyEvent -> KeyEvent -> Ordering)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> Ord KeyEvent
KeyEvent -> KeyEvent -> Bool
KeyEvent -> KeyEvent -> Ordering
KeyEvent -> KeyEvent -> KeyEvent
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 :: KeyEvent -> KeyEvent -> KeyEvent
$cmin :: KeyEvent -> KeyEvent -> KeyEvent
max :: KeyEvent -> KeyEvent -> KeyEvent
$cmax :: KeyEvent -> KeyEvent -> KeyEvent
>= :: KeyEvent -> KeyEvent -> Bool
$c>= :: KeyEvent -> KeyEvent -> Bool
> :: KeyEvent -> KeyEvent -> Bool
$c> :: KeyEvent -> KeyEvent -> Bool
<= :: KeyEvent -> KeyEvent -> Bool
$c<= :: KeyEvent -> KeyEvent -> Bool
< :: KeyEvent -> KeyEvent -> Bool
$c< :: KeyEvent -> KeyEvent -> Bool
compare :: KeyEvent -> KeyEvent -> Ordering
$ccompare :: KeyEvent -> KeyEvent -> Ordering
$cp1Ord :: Eq KeyEvent
Ord, Int -> KeyEvent
KeyEvent -> Int
KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent
KeyEvent -> KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
(KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent)
-> (Int -> KeyEvent)
-> (KeyEvent -> Int)
-> (KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent])
-> Enum KeyEvent
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
enumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFrom :: KeyEvent -> [KeyEvent]
$cenumFrom :: KeyEvent -> [KeyEvent]
fromEnum :: KeyEvent -> Int
$cfromEnum :: KeyEvent -> Int
toEnum :: Int -> KeyEvent
$ctoEnum :: Int -> KeyEvent
pred :: KeyEvent -> KeyEvent
$cpred :: KeyEvent -> KeyEvent
succ :: KeyEvent -> KeyEvent
$csucc :: KeyEvent -> KeyEvent
Enum)

allEvents :: [KeyEvent]
allEvents :: [KeyEvent]
allEvents =
  [ KeyEvent
QuitEvent
  , KeyEvent
VtyRefreshEvent
  , KeyEvent
ClearUnreadEvent

  , KeyEvent
ToggleMessagePreviewEvent
  , KeyEvent
InvokeEditorEvent
  , KeyEvent
ToggleMultiLineEvent
  , KeyEvent
CancelEvent
  , KeyEvent
ReplyRecentEvent
  , KeyEvent
SelectNextTabEvent
  , KeyEvent
SelectPreviousTabEvent

  , KeyEvent
SaveAttachmentEvent

  , KeyEvent
EnterFastSelectModeEvent
  , KeyEvent
NextChannelEvent
  , KeyEvent
PrevChannelEvent
  , KeyEvent
NextChannelEventAlternate
  , KeyEvent
PrevChannelEventAlternate
  , KeyEvent
NextUnreadChannelEvent
  , KeyEvent
NextUnreadUserOrChannelEvent
  , KeyEvent
LastChannelEvent

  , KeyEvent
ShowAttachmentListEvent

  , KeyEvent
ChangeMessageEditorFocus

  , KeyEvent
EditorKillToBolEvent
  , KeyEvent
EditorKillToEolEvent
  , KeyEvent
EditorBolEvent
  , KeyEvent
EditorEolEvent
  , KeyEvent
EditorTransposeCharsEvent
  , KeyEvent
EditorDeleteCharacter
  , KeyEvent
EditorPrevCharEvent
  , KeyEvent
EditorNextCharEvent
  , KeyEvent
EditorPrevWordEvent
  , KeyEvent
EditorNextWordEvent
  , KeyEvent
EditorDeleteNextWordEvent
  , KeyEvent
EditorDeletePrevWordEvent
  , KeyEvent
EditorHomeEvent
  , KeyEvent
EditorEndEvent
  , KeyEvent
EditorYankEvent

  , KeyEvent
CycleChannelListSorting

  , KeyEvent
EnterFlaggedPostsEvent
  , KeyEvent
ToggleChannelListVisibleEvent
  , KeyEvent
ToggleExpandedChannelTopicsEvent
  , KeyEvent
ShowHelpEvent
  , KeyEvent
EnterSelectModeEvent
  , KeyEvent
EnterOpenURLModeEvent

  , KeyEvent
LoadMoreEvent
  , KeyEvent
OpenMessageURLEvent

  , KeyEvent
ScrollUpEvent
  , KeyEvent
ScrollDownEvent
  , KeyEvent
ScrollLeftEvent
  , KeyEvent
ScrollRightEvent
  , KeyEvent
ChannelListScrollUpEvent
  , KeyEvent
ChannelListScrollDownEvent
  , KeyEvent
PageUpEvent
  , KeyEvent
PageDownEvent
  , KeyEvent
PageLeftEvent
  , KeyEvent
PageRightEvent
  , KeyEvent
ScrollTopEvent
  , KeyEvent
ScrollBottomEvent
  , KeyEvent
SelectOldestMessageEvent

  , KeyEvent
SelectUpEvent
  , KeyEvent
SelectDownEvent

  , KeyEvent
ActivateListItemEvent

  , KeyEvent
SearchSelectUpEvent
  , KeyEvent
SearchSelectDownEvent

  , KeyEvent
NextTeamEvent
  , KeyEvent
PrevTeamEvent
  , KeyEvent
MoveCurrentTeamLeftEvent
  , KeyEvent
MoveCurrentTeamRightEvent

  , KeyEvent
OpenThreadEvent
  , KeyEvent
FlagMessageEvent
  , KeyEvent
PinMessageEvent
  , KeyEvent
ViewMessageEvent
  , KeyEvent
FillGapEvent
  , KeyEvent
CopyPostLinkEvent
  , KeyEvent
YankMessageEvent
  , KeyEvent
YankWholeMessageEvent
  , KeyEvent
DeleteMessageEvent
  , KeyEvent
EditMessageEvent
  , KeyEvent
ReplyMessageEvent
  , KeyEvent
ReactToMessageEvent
  , KeyEvent
AttachmentListAddEvent
  , KeyEvent
AttachmentListDeleteEvent
  , KeyEvent
AttachmentOpenEvent

  , KeyEvent
FileBrowserBeginSearchEvent
  , KeyEvent
FileBrowserSelectEnterEvent
  , KeyEvent
FileBrowserSelectCurrentEvent
  , KeyEvent
FileBrowserListPageUpEvent
  , KeyEvent
FileBrowserListPageDownEvent
  , KeyEvent
FileBrowserListHalfPageUpEvent
  , KeyEvent
FileBrowserListHalfPageDownEvent
  , KeyEvent
FileBrowserListTopEvent
  , KeyEvent
FileBrowserListBottomEvent
  , KeyEvent
FileBrowserListNextEvent
  , KeyEvent
FileBrowserListPrevEvent

  , KeyEvent
FormSubmitEvent
  ]

eventToBinding :: Vty.Event -> Binding
eventToBinding :: Event -> Binding
eventToBinding (Vty.EvKey Key
k [Modifier]
mods) = [Modifier] -> Key -> Binding
Binding [Modifier]
mods Key
k
eventToBinding Event
k = String -> Binding
forall a. HasCallStack => String -> a
error (String -> Binding) -> String -> Binding
forall a b. (a -> b) -> a -> b
$ String
"BUG: invalid keybinding " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Event -> String
forall a. Show a => a -> String
show Event
k

data Binding = Binding
  { Binding -> [Modifier]
kbMods :: [Vty.Modifier]
  , Binding -> Key
kbKey  :: Vty.Key
  } deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show, Eq Binding
Eq Binding
-> (Binding -> Binding -> Ordering)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Binding)
-> (Binding -> Binding -> Binding)
-> Ord Binding
Binding -> Binding -> Bool
Binding -> Binding -> Ordering
Binding -> Binding -> Binding
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 :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmax :: Binding -> Binding -> Binding
>= :: Binding -> Binding -> Bool
$c>= :: Binding -> Binding -> Bool
> :: Binding -> Binding -> Bool
$c> :: Binding -> Binding -> Bool
<= :: Binding -> Binding -> Bool
$c<= :: Binding -> Binding -> Bool
< :: Binding -> Binding -> Bool
$c< :: Binding -> Binding -> Bool
compare :: Binding -> Binding -> Ordering
$ccompare :: Binding -> Binding -> Ordering
$cp1Ord :: Eq Binding
Ord)

data BindingState =
    BindingList [Binding]
    | Unbound
    deriving (Int -> BindingState -> ShowS
[BindingState] -> ShowS
BindingState -> String
(Int -> BindingState -> ShowS)
-> (BindingState -> String)
-> ([BindingState] -> ShowS)
-> Show BindingState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingState] -> ShowS
$cshowList :: [BindingState] -> ShowS
show :: BindingState -> String
$cshow :: BindingState -> String
showsPrec :: Int -> BindingState -> ShowS
$cshowsPrec :: Int -> BindingState -> ShowS
Show, BindingState -> BindingState -> Bool
(BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool) -> Eq BindingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingState -> BindingState -> Bool
$c/= :: BindingState -> BindingState -> Bool
== :: BindingState -> BindingState -> Bool
$c== :: BindingState -> BindingState -> Bool
Eq, Eq BindingState
Eq BindingState
-> (BindingState -> BindingState -> Ordering)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> BindingState)
-> (BindingState -> BindingState -> BindingState)
-> Ord BindingState
BindingState -> BindingState -> Bool
BindingState -> BindingState -> Ordering
BindingState -> BindingState -> BindingState
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 :: BindingState -> BindingState -> BindingState
$cmin :: BindingState -> BindingState -> BindingState
max :: BindingState -> BindingState -> BindingState
$cmax :: BindingState -> BindingState -> BindingState
>= :: BindingState -> BindingState -> Bool
$c>= :: BindingState -> BindingState -> Bool
> :: BindingState -> BindingState -> Bool
$c> :: BindingState -> BindingState -> Bool
<= :: BindingState -> BindingState -> Bool
$c<= :: BindingState -> BindingState -> Bool
< :: BindingState -> BindingState -> Bool
$c< :: BindingState -> BindingState -> Bool
compare :: BindingState -> BindingState -> Ordering
$ccompare :: BindingState -> BindingState -> Ordering
$cp1Ord :: Eq BindingState
Ord)

type KeyConfig = M.Map KeyEvent BindingState

parseBinding :: Text -> Either String Binding
parseBinding :: Text -> Either String Binding
parseBinding Text
kb = [Text] -> [Modifier] -> Either String Binding
go (Text -> Text -> [Text]
T.splitOn Text
"-" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
kb) []
  where go :: [Text] -> [Modifier] -> Either String Binding
go [Text
k] [Modifier]
mods = do
          Key
key <- Text -> Either String Key
pKey Text
k
          Binding -> Either String Binding
forall (m :: * -> *) a. Monad m => a -> m a
return Binding :: [Modifier] -> Key -> Binding
Binding { kbMods :: [Modifier]
kbMods = [Modifier]
mods, kbKey :: Key
kbKey = Key
key }
        go (Text
k:[Text]
ks) [Modifier]
mods = do
          Modifier
m <- case Text
k of
            Text
"s"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"shift"   -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"m"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"meta"    -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"a"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"alt"     -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"c"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"ctrl"    -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"control" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
_         -> String -> Either String Modifier
forall a b. a -> Either a b
Left (String
"Unknown modifier prefix: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k)
          [Text] -> [Modifier] -> Either String Binding
go [Text]
ks (Modifier
mModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
mods)
        go [] [Modifier]
_ = String -> Either String Binding
forall a b. a -> Either a b
Left String
"Empty keybinding not allowed"
        pKey :: Text -> Either String Key
pKey Text
"esc"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEsc
        pKey Text
"backspace" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBS
        pKey Text
"enter"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnter
        pKey Text
"left"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KLeft
        pKey Text
"right"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KRight
        pKey Text
"up"        = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUp
        pKey Text
"down"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDown
        pKey Text
"upleft"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpLeft
        pKey Text
"upright"   = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpRight
        pKey Text
"downleft"  = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownLeft
        pKey Text
"downright" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownRight
        pKey Text
"center"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KCenter
        pKey Text
"backtab"   = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBackTab
        pKey Text
"printscreen" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPrtScr
        pKey Text
"pause"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPause
        pKey Text
"insert"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KIns
        pKey Text
"home"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KHome
        pKey Text
"pgup"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageUp
        pKey Text
"del"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDel
        pKey Text
"end"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnd
        pKey Text
"pgdown"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageDown
        pKey Text
"begin"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBegin
        pKey Text
"menu"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KMenu
        pKey Text
"space"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
' ')
        pKey Text
"tab"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
'\t')
        pKey Text
t
          | Just (Char
c, Text
"") <- Text -> Maybe (Char, Text)
T.uncons Text
t =
              Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
c)
          | Just Text
n <- Text -> Text -> Maybe Text
T.stripPrefix Text
"f" Text
t =
              case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
n) of
                  Maybe Int
Nothing -> String -> Either String Key
forall a b. a -> Either a b
Left (String
"Unknown keybinding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
                  Just Int
i -> Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Key
Vty.KFun Int
i)
          | Bool
otherwise = String -> Either String Key
forall a b. a -> Either a b
Left (String
"Unknown keybinding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)

ppBinding :: Binding -> Text
ppBinding :: Binding -> Text
ppBinding (Binding [Modifier]
mods Key
k) =
    Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Modifier -> Text
ppMod (Modifier -> Text) -> [Modifier] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Modifier]
mods) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
ppKey Key
k]

ppKey :: Vty.Key -> Text
ppKey :: Key -> Text
ppKey (Vty.KChar Char
c)   = Char -> Text
ppChar Char
c
ppKey (Vty.KFun Int
n)    = Text
"F" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
ppKey Key
Vty.KBackTab    = Text
"BackTab"
ppKey Key
Vty.KEsc        = Text
"Esc"
ppKey Key
Vty.KBS         = Text
"Backspace"
ppKey Key
Vty.KEnter      = Text
"Enter"
ppKey Key
Vty.KUp         = Text
"Up"
ppKey Key
Vty.KDown       = Text
"Down"
ppKey Key
Vty.KLeft       = Text
"Left"
ppKey Key
Vty.KRight      = Text
"Right"
ppKey Key
Vty.KHome       = Text
"Home"
ppKey Key
Vty.KEnd        = Text
"End"
ppKey Key
Vty.KPageUp     = Text
"PgUp"
ppKey Key
Vty.KPageDown   = Text
"PgDown"
ppKey Key
Vty.KDel        = Text
"Del"
ppKey Key
Vty.KUpLeft     = Text
"UpLeft"
ppKey Key
Vty.KUpRight    = Text
"UpRight"
ppKey Key
Vty.KDownLeft   = Text
"DownLeft"
ppKey Key
Vty.KDownRight  = Text
"DownRight"
ppKey Key
Vty.KCenter     = Text
"Center"
ppKey Key
Vty.KPrtScr     = Text
"PrintScreen"
ppKey Key
Vty.KPause      = Text
"Pause"
ppKey Key
Vty.KIns        = Text
"Insert"
ppKey Key
Vty.KBegin      = Text
"Begin"
ppKey Key
Vty.KMenu       = Text
"Menu"

nonCharKeys :: [Text]
nonCharKeys :: [Text]
nonCharKeys = (Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Text
ppKey
  [ Key
Vty.KBackTab, Key
Vty.KEsc, Key
Vty.KBS, Key
Vty.KEnter, Key
Vty.KUp, Key
Vty.KDown
  , Key
Vty.KLeft, Key
Vty.KRight, Key
Vty.KHome, Key
Vty.KEnd, Key
Vty.KPageDown
  , Key
Vty.KPageUp, Key
Vty.KDel, Key
Vty.KUpLeft, Key
Vty.KUpRight, Key
Vty.KDownLeft
  , Key
Vty.KDownRight, Key
Vty.KCenter, Key
Vty.KPrtScr, Key
Vty.KPause, Key
Vty.KIns
  , Key
Vty.KBegin, Key
Vty.KMenu
  ]

ppChar :: Char -> Text
ppChar :: Char -> Text
ppChar Char
'\t' = Text
"Tab"
ppChar Char
' '  = Text
"Space"
ppChar Char
c    = Char -> Text
T.singleton Char
c

ppMod :: Vty.Modifier -> Text
ppMod :: Modifier -> Text
ppMod Modifier
Vty.MMeta  = Text
"M"
ppMod Modifier
Vty.MAlt   = Text
"A"
ppMod Modifier
Vty.MCtrl  = Text
"C"
ppMod Modifier
Vty.MShift = Text
"S"

parseBindingList :: Text -> Either String BindingState
parseBindingList :: Text -> Either String BindingState
parseBindingList Text
t =
    if Text -> Text
T.toLower Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"unbound"
    then BindingState -> Either String BindingState
forall (m :: * -> *) a. Monad m => a -> m a
return BindingState
Unbound
    else [Binding] -> BindingState
BindingList ([Binding] -> BindingState)
-> Either String [Binding] -> Either String BindingState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Either String Binding)
-> [Text] -> Either String [Binding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Either String Binding
parseBinding (Text -> Either String Binding)
-> (Text -> Text) -> Text -> Either String Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) (Text -> Text -> [Text]
T.splitOn Text
"," Text
t)

keyEventFromName :: Text -> Either String KeyEvent
keyEventFromName :: Text -> Either String KeyEvent
keyEventFromName Text
t =
    let mapping :: Map Text KeyEvent
mapping = [(Text, KeyEvent)] -> Map Text KeyEvent
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (KeyEvent -> Text
keyEventName KeyEvent
e, KeyEvent
e) | KeyEvent
e <- [KeyEvent]
allEvents ]
    in case Text -> Map Text KeyEvent -> Maybe KeyEvent
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t Map Text KeyEvent
mapping of
        Just KeyEvent
e -> KeyEvent -> Either String KeyEvent
forall (m :: * -> *) a. Monad m => a -> m a
return KeyEvent
e
        Maybe KeyEvent
Nothing -> String -> Either String KeyEvent
forall a b. a -> Either a b
Left (String
"Unknown event: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)

keyEventName :: KeyEvent -> Text
keyEventName :: KeyEvent -> Text
keyEventName KeyEvent
ev = case KeyEvent
ev of
  KeyEvent
QuitEvent                 -> Text
"quit"
  KeyEvent
VtyRefreshEvent           -> Text
"vty-refresh"
  KeyEvent
ClearUnreadEvent          -> Text
"clear-unread"
  KeyEvent
CancelEvent               -> Text
"cancel"

  KeyEvent
ToggleMessagePreviewEvent -> Text
"toggle-message-preview"
  KeyEvent
InvokeEditorEvent         -> Text
"invoke-editor"
  KeyEvent
ToggleMultiLineEvent      -> Text
"toggle-multiline"
  KeyEvent
ReplyRecentEvent          -> Text
"reply-recent"

  KeyEvent
EnterFastSelectModeEvent  -> Text
"enter-fast-select"
  KeyEvent
NextChannelEvent          -> Text
"focus-next-channel"
  KeyEvent
PrevChannelEvent          -> Text
"focus-prev-channel"
  KeyEvent
NextChannelEventAlternate -> Text
"focus-next-channel-alternate"
  KeyEvent
PrevChannelEventAlternate -> Text
"focus-prev-channel-alternate"
  KeyEvent
NextUnreadChannelEvent    -> Text
"focus-next-unread"
  KeyEvent
NextUnreadUserOrChannelEvent  -> Text
"focus-next-unread-user-or-channel"
  KeyEvent
LastChannelEvent          -> Text
"focus-last-channel"

  KeyEvent
SelectNextTabEvent        -> Text
"select-next-tab"
  KeyEvent
SelectPreviousTabEvent    -> Text
"select-previous-tab"

  KeyEvent
SaveAttachmentEvent       -> Text
"save-attachment"

  KeyEvent
ShowAttachmentListEvent   -> Text
"show-attachment-list"

  KeyEvent
ChangeMessageEditorFocus  -> Text
"change-message-editor-focus"

  KeyEvent
EditorKillToBolEvent        -> Text
"editor-kill-to-beginning-of-line"
  KeyEvent
EditorKillToEolEvent        -> Text
"editor-kill-to-end-of-line"
  KeyEvent
EditorBolEvent              -> Text
"editor-beginning-of-line"
  KeyEvent
EditorEolEvent              -> Text
"editor-end-of-line"
  KeyEvent
EditorTransposeCharsEvent   -> Text
"editor-transpose-chars"
  KeyEvent
EditorDeleteCharacter       -> Text
"editor-delete-char"
  KeyEvent
EditorPrevCharEvent         -> Text
"editor-prev-char"
  KeyEvent
EditorNextCharEvent         -> Text
"editor-next-char"
  KeyEvent
EditorPrevWordEvent         -> Text
"editor-prev-word"
  KeyEvent
EditorNextWordEvent         -> Text
"editor-next-word"
  KeyEvent
EditorDeleteNextWordEvent   -> Text
"editor-delete-next-word"
  KeyEvent
EditorDeletePrevWordEvent   -> Text
"editor-delete-prev-word"
  KeyEvent
EditorHomeEvent             -> Text
"editor-home"
  KeyEvent
EditorEndEvent              -> Text
"editor-end"
  KeyEvent
EditorYankEvent             -> Text
"editor-yank"

  KeyEvent
CycleChannelListSorting     -> Text
"cycle-channel-list-sorting"

  KeyEvent
NextTeamEvent               -> Text
"next-team"
  KeyEvent
PrevTeamEvent               -> Text
"prev-team"
  KeyEvent
MoveCurrentTeamLeftEvent    -> Text
"move-current-team-left"
  KeyEvent
MoveCurrentTeamRightEvent   -> Text
"move-current-team-right"

  KeyEvent
EnterFlaggedPostsEvent    -> Text
"show-flagged-posts"
  KeyEvent
ToggleChannelListVisibleEvent -> Text
"toggle-channel-list-visibility"
  KeyEvent
ToggleExpandedChannelTopicsEvent -> Text
"toggle-expanded-channel-topics"
  KeyEvent
ShowHelpEvent             -> Text
"show-help"
  KeyEvent
EnterSelectModeEvent      -> Text
"select-mode"
  KeyEvent
EnterOpenURLModeEvent     -> Text
"enter-url-open"

  KeyEvent
LoadMoreEvent             -> Text
"load-more"
  KeyEvent
OpenMessageURLEvent       -> Text
"open-message-url"

  KeyEvent
ScrollUpEvent     -> Text
"scroll-up"
  KeyEvent
ScrollDownEvent   -> Text
"scroll-down"
  KeyEvent
ScrollLeftEvent   -> Text
"scroll-left"
  KeyEvent
ScrollRightEvent  -> Text
"scroll-right"

  KeyEvent
ChannelListScrollUpEvent     -> Text
"channel-list-scroll-up"
  KeyEvent
ChannelListScrollDownEvent   -> Text
"channel-list-scroll-down"

  KeyEvent
PageUpEvent       -> Text
"page-up"
  KeyEvent
PageDownEvent     -> Text
"page-down"
  KeyEvent
PageLeftEvent     -> Text
"page-left"
  KeyEvent
PageRightEvent    -> Text
"page-right"
  KeyEvent
ScrollTopEvent    -> Text
"scroll-top"
  KeyEvent
ScrollBottomEvent -> Text
"scroll-bottom"
  KeyEvent
SelectOldestMessageEvent -> Text
"select-oldest-message"

  KeyEvent
SelectUpEvent   -> Text
"select-up"
  KeyEvent
SelectDownEvent -> Text
"select-down"

  KeyEvent
SearchSelectUpEvent   -> Text
"search-select-up"
  KeyEvent
SearchSelectDownEvent -> Text
"search-select-down"

  KeyEvent
ActivateListItemEvent -> Text
"activate-list-item"

  KeyEvent
OpenThreadEvent    -> Text
"open-thread"
  KeyEvent
FlagMessageEvent   -> Text
"flag-message"
  KeyEvent
PinMessageEvent   -> Text
"pin-message"
  KeyEvent
ViewMessageEvent   -> Text
"view-message"
  KeyEvent
FillGapEvent       -> Text
"fetch-for-gap"
  KeyEvent
CopyPostLinkEvent  -> Text
"copy-post-link"
  KeyEvent
YankMessageEvent   -> Text
"yank-message"
  KeyEvent
YankWholeMessageEvent   -> Text
"yank-whole-message"
  KeyEvent
DeleteMessageEvent -> Text
"delete-message"
  KeyEvent
EditMessageEvent   -> Text
"edit-message"
  KeyEvent
ReplyMessageEvent  -> Text
"reply-message"
  KeyEvent
ReactToMessageEvent -> Text
"react-to-message"

  KeyEvent
AttachmentListAddEvent    -> Text
"add-to-attachment-list"
  KeyEvent
AttachmentListDeleteEvent -> Text
"delete-from-attachment-list"
  KeyEvent
AttachmentOpenEvent       -> Text
"open-attachment"

  KeyEvent
FileBrowserBeginSearchEvent      -> Text
"filebrowser-begin-search"
  KeyEvent
FileBrowserSelectEnterEvent      -> Text
"filebrowser-select-file-or-enter-directory"
  KeyEvent
FileBrowserSelectCurrentEvent    -> Text
"filebrowser-select-current"
  KeyEvent
FileBrowserListPageUpEvent       -> Text
"filebrowser-list-page-up"
  KeyEvent
FileBrowserListPageDownEvent     -> Text
"filebrowser-list-page-down"
  KeyEvent
FileBrowserListHalfPageUpEvent   -> Text
"filebrowser-list-half-page-up"
  KeyEvent
FileBrowserListHalfPageDownEvent -> Text
"filebrowser-list-half-page-down"
  KeyEvent
FileBrowserListTopEvent          -> Text
"filebrowser-list-top"
  KeyEvent
FileBrowserListBottomEvent       -> Text
"filebrowser-list-bottom"
  KeyEvent
FileBrowserListNextEvent         -> Text
"filebrowser-list-next"
  KeyEvent
FileBrowserListPrevEvent         -> Text
"filebrowser-list-previous"

  KeyEvent
FormSubmitEvent -> Text
"submit-form"