module Matterhorn.Draw.ShowHelp
  ( drawShowHelp
  , keybindingMarkdownTable
  , keybindingTextTable
  , commandTextTable
  , commandMarkdownTable
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Themes ( themeDescriptions )
import           Brick.Widgets.Center ( hCenter )
import           Brick.Widgets.List ( listSelectedFocusedAttr )
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( singular, _Just, _2 )

import           Network.Mattermost.Version ( mmApiVersion )

import           Matterhorn.Command
import           Matterhorn.Events
import           Matterhorn.Events.ChannelSelect
import           Matterhorn.Events.Keybindings
import           Matterhorn.Events.Main
import           Matterhorn.Events.MessageSelect
import           Matterhorn.Events.ThemeListOverlay
import           Matterhorn.Events.PostListOverlay
import           Matterhorn.Events.ShowHelp
import           Matterhorn.Events.UrlSelect
import           Matterhorn.Events.UserListOverlay
import           Matterhorn.Events.ChannelListOverlay
import           Matterhorn.Events.ReactionEmojiListOverlay
import           Matterhorn.Events.ManageAttachments
import           Matterhorn.Events.TabbedWindow
import           Matterhorn.Windows.ViewMessage
import           Matterhorn.HelpTopics ( helpTopics )
import           Matterhorn.Draw.RichText ( renderText )
import           Matterhorn.Options ( mhVersion )
import           Matterhorn.State.Editing ( editingKeyHandlers )
import           Matterhorn.Themes
import           Matterhorn.Types
import           Matterhorn.Types.KeyEvents ( BindingState(..), Binding(..)
                                 , ppBinding, nonCharKeys, eventToBinding )


drawShowHelp :: HelpTopic -> ChatState -> [Widget Name]
drawShowHelp :: HelpTopic -> ChatState -> [Widget Name]
drawShowHelp HelpTopic
topic ChatState
st =
    [Name -> Widget Name -> Widget Name
helpBox (HelpTopic -> Name
helpTopicViewportName HelpTopic
topic) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ HelpTopic -> ChatState -> Widget Name
helpTopicDraw HelpTopic
topic ChatState
st]

helpTopicDraw :: HelpTopic -> ChatState -> Widget Name
helpTopicDraw :: HelpTopic -> ChatState -> Widget Name
helpTopicDraw HelpTopic
topic ChatState
st =
    AttrName -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
codeAttr AttrName
helpEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
helpContentWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    case HelpTopic -> HelpScreen
helpTopicScreen HelpTopic
topic of
        HelpScreen
MainHelp -> KeyConfig -> Widget Name
mainHelp (Config -> KeyConfig
configUserKeys (ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration))
        HelpScreen
ScriptHelp -> Widget Name
scriptHelp
        HelpScreen
ThemeHelp -> Widget Name
forall a. Widget a
themeHelp
        HelpScreen
SyntaxHighlightHelp -> [FilePath] -> Widget Name
forall a. [FilePath] -> Widget a
syntaxHighlightHelp (Config -> [FilePath]
configSyntaxDirs (Config -> [FilePath]) -> Config -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration)
        HelpScreen
KeybindingHelp -> KeyConfig -> Widget Name
keybindingHelp (Config -> KeyConfig
configUserKeys (ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration))

mainHelp :: KeyConfig -> Widget Name
mainHelp :: KeyConfig -> Widget Name
mainHelp KeyConfig
kc = Widget Name
summary
  where
    summary :: Widget Name
summary = [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [Widget Name]
entries
    entries :: [Widget Name]
entries = [ Text -> Widget Name
forall a. Text -> Widget a
heading (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
mhVersion
              , Text -> Widget Name
forall a. Text -> Widget a
headingNoPad (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
mmApiVersion
              , Text -> Widget Name
forall a. Text -> Widget a
heading Text
"Help Topics"
              , Widget Name
drawHelpTopics
              , Text -> Widget Name
forall a. Text -> Widget a
heading Text
"Commands"
              , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) Widget Name
mkCommandHelpText
              , Text -> Widget Name
forall a. Text -> Widget a
heading Text
"Keybindings"
              ] [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<>
              (KeyConfig -> (Text, [KeyEventHandler]) -> Widget Name
mkKeybindingHelp KeyConfig
kc ((Text, [KeyEventHandler]) -> Widget Name)
-> [(Text, [KeyEventHandler])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEventHandler])]
keybindSections)

    mkCommandHelpText :: Widget Name
    mkCommandHelpText :: Widget Name
mkCommandHelpText =
      let commandNameWidth :: Int
commandNameWidth = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Int) -> [(Text, Text)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
commandHelpInfo)
      in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ (Widget Name -> Widget Name
forall n. Widget n -> Widget n
emph (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall a. Text -> Widget a
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo Int
commandNameWidth Text
info) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall a. Text -> Widget a
renderText Text
desc
              | (Text
info, Text
desc) <- [(Text, Text)]
commandHelpInfo
              ]

commandHelpInfo :: [(T.Text, T.Text)]
commandHelpInfo :: [(Text, Text)]
commandHelpInfo = [(Text, Text)]
pairs
    where
        pairs :: [(Text, Text)]
pairs = [ (Text
info, Text
desc)
                | Cmd Text
cmd Text
desc CmdArgs a
args CmdExec a
_ <- [Cmd]
cs
                , let argSpec :: Text
argSpec = CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
args
                      spc :: Text
spc = if Text -> Bool
T.null Text
argSpec then Text
"" else Text
" "
                      info :: Text
info = Char -> Text -> Text
T.cons Char
'/' Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argSpec
                ]
        cs :: [Cmd]
cs = (Cmd -> Text) -> [Cmd] -> [Cmd]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Cmd -> Text
commandName [Cmd]
commandList

commandTextTable :: T.Text
commandTextTable :: Text
commandTextTable =
    let commandNameWidth :: Int
commandNameWidth = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Int) -> [(Text, Text)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
commandHelpInfo)
    in Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
       [ Int -> Text -> Text
padTo Int
commandNameWidth Text
info Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc
       | (Text
info, Text
desc) <- [(Text, Text)]
commandHelpInfo
       ]

commandMarkdownTable :: T.Text
commandMarkdownTable :: Text
commandMarkdownTable =
    Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"# Commands"
    , Text
""
    , Text
"| Command | Description |"
    , Text
"| ------- | ----------- |"
    ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    [ Text
"| `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
info Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
    | (Text
info, Text
desc) <- [(Text, Text)]
commandHelpInfo
    ]

drawHelpTopics :: Widget Name
drawHelpTopics :: Widget Name
drawHelpTopics =
    let allHelpTopics :: [Widget n]
allHelpTopics = HelpTopic -> Widget n
forall n. HelpTopic -> Widget n
drawTopic (HelpTopic -> Widget n) -> [HelpTopic] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HelpTopic]
helpTopics
        topicNameWidth :: Int
topicNameWidth = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> (HelpTopic -> Text) -> HelpTopic -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HelpTopic -> Text
helpTopicName (HelpTopic -> Int) -> [HelpTopic] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HelpTopic]
helpTopics)
        drawTopic :: HelpTopic -> Widget n
drawTopic HelpTopic
t = (Widget n -> Widget n
forall n. Widget n -> Widget n
emph (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
txt (Int -> Text -> Text
padTo Int
topicNameWidth (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HelpTopic -> Text
helpTopicName HelpTopic
t)) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                      Text -> Widget n
forall a. Text -> Widget a
txt (HelpTopic -> Text
helpTopicDescription HelpTopic
t)
    in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
               Text -> Widget Name
forall a. Text -> Widget a
para Text
"Learn more about these topics with `/help <topic>`:")
            Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
forall n. [Widget n]
allHelpTopics

helpContentWidth :: Int
helpContentWidth :: Int
helpContentWidth = Int
72

scriptHelp :: Widget Name
scriptHelp :: Widget Name
scriptHelp = Text -> Widget Name
forall a. Text -> Widget a
heading Text
"Using Scripts" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [Widget Name]
forall n. [Widget n]
scriptHelpText
  where scriptHelpText :: [Widget a]
scriptHelpText = ([Text] -> Widget a) -> [[Text]] -> [Widget a]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Widget a
forall a. [Text] -> Widget a
paraL
          [ [ Text
"Matterhorn has a special feature that allows you to use "
             , Text
"prewritten shell scripts to preprocess messages. "
             , Text
"For example, this can allow you to run various filters over "
             , Text
"your written text, do certain kinds of automated formatting, "
             , Text
"or just automatically cowsay-ify a message." ]
           , [ Text
"These scripts can be any kind of executable file, "
             , Text
"as long as the file lives in "
             , Text
"*~/.config/matterhorn/scripts* (unless you've explicitly "
             , Text
"moved your XDG configuration directory elsewhere). "
             , Text
"Those executables are given no arguments "
             , Text
"on the command line and are passed your typed message on "
             , Text
"*stdin*; whatever they produce on *stdout* is sent "
             , Text
"as a message. If the script exits successfully, then everything "
             , Text
"that appeared on *stderr* is discarded; if it instead exits with "
             , Text
"a failing exit code, your message is *not* sent, and you are "
             , Text
"presented with whatever was printed on stderr as a "
             , Text
"local error message." ]
           , [ Text
"To run a script, simply type" ]
           , [ Text
"> *> /sh [script-name] [my-message]*" ]
           , [ Text
"And the script named *[script-name]* will be invoked with "
             , Text
"the text of *[my-message]*. If the script does not exist, "
             , Text
"or if it exists but is not marked as executable, you'll be "
             , Text
"presented with an appropriate error message." ]
           , [ Text
"For example, if you want to use a basic script to "
             , Text
"automatically ROT13 your message, you can write a shell "
             , Text
"script using the standard Unix *tr* utility, like this:" ]
           , [ Text
"> *#!/bin/bash -e*"
             , Text
"> *tr '[A-Za-z]' '[N-ZA-Mn-za-m]'*" ]
           , [ Text
"Move this script to *~/.config/matterhorn/scripts/rot13* "
             , Text
"and be sure it's executable with" ]
           , [ Text
"> *$ chmod u+x ~/.config/matterhorn/scripts/rot13*" ]
           , [ Text
"after which you can send ROT13 messages with the "
             , Text
"Matterhorn command " ]
           , [ Text
"> *> /sh rot13 Hello, world!*" ]
           ]

keybindingMarkdownTable :: KeyConfig -> Text
keybindingMarkdownTable :: KeyConfig -> Text
keybindingMarkdownTable KeyConfig
kc = Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
keybindSectionStrings
    where title :: Text
title = Text
"# Keybindings\n"
          keybindSectionStrings :: Text
keybindSectionStrings = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text, [KeyEventHandler]) -> Text
sectionText ((Text, [KeyEventHandler]) -> Text)
-> [(Text, [KeyEventHandler])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEventHandler])]
keybindSections
          sectionText :: (Text, [KeyEventHandler]) -> Text
sectionText = KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> Text)
-> ([Text] -> Text)
-> (Text -> Text)
-> (Text, [KeyEventHandler])
-> Text
forall a.
KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> a)
-> ([a] -> a)
-> (Text -> a)
-> (Text, [KeyEventHandler])
-> a
mkKeybindEventSectionHelp KeyConfig
kc (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpMarkdown [Text] -> Text
T.unlines Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
mkHeading
          mkHeading :: a -> a
mkHeading a
n =
              a
"\n# " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
              a
"\n| Keybinding | Event Name | Description |" a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
              a
"\n| ---------- | ---------- | ----------- |"

keybindingTextTable :: KeyConfig -> Text
keybindingTextTable :: KeyConfig -> Text
keybindingTextTable KeyConfig
kc = Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
keybindSectionStrings
    where title :: Text
title = Text
"Keybindings\n===========\n"
          keybindSectionStrings :: Text
keybindSectionStrings = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text, [KeyEventHandler]) -> Text
sectionText ((Text, [KeyEventHandler]) -> Text)
-> [(Text, [KeyEventHandler])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEventHandler])]
keybindSections
          sectionText :: (Text, [KeyEventHandler]) -> Text
sectionText = KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> Text)
-> ([Text] -> Text)
-> (Text -> Text)
-> (Text, [KeyEventHandler])
-> Text
forall a.
KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> a)
-> ([a] -> a)
-> (Text -> a)
-> (Text, [KeyEventHandler])
-> a
mkKeybindEventSectionHelp KeyConfig
kc (Int -> Int -> (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpText Int
keybindingWidth Int
eventNameWidth) [Text] -> Text
T.unlines Text -> Text
mkHeading
          keybindingWidth :: Int
keybindingWidth = Int
15
          eventNameWidth :: Int
eventNameWidth = Int
30
          mkHeading :: Text -> Text
mkHeading Text
n =
              Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text -> Text
T.replicate (Text -> Int
T.length Text
n) Text
"=")

keybindingHelp :: KeyConfig -> Widget Name
keybindingHelp :: KeyConfig -> Widget Name
keybindingHelp KeyConfig
kc = [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
  [ Text -> Widget Name
forall a. Text -> Widget a
heading Text
"Configurable Keybindings"
  , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [Widget Name]
forall n. [Widget n]
keybindingHelpText
  ] [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
keybindSectionWidgets
    [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++
  [ Text -> Widget Name
forall a. Text -> Widget a
headingNoPad Text
"Keybinding Syntax"
  , [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [Widget Name]
forall n. [Widget n]
validKeys
  ]
  where keybindSectionWidgets :: [Widget Name]
keybindSectionWidgets = (Text, [KeyEventHandler]) -> Widget Name
sectionWidget ((Text, [KeyEventHandler]) -> Widget Name)
-> [(Text, [KeyEventHandler])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEventHandler])]
keybindSections
        sectionWidget :: (Text, [KeyEventHandler]) -> Widget Name
sectionWidget = KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> Widget Name)
-> ([Widget Name] -> Widget Name)
-> (Text -> Widget Name)
-> (Text, [KeyEventHandler])
-> Widget Name
forall a.
KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> a)
-> ([a] -> a)
-> (Text -> a)
-> (Text, [KeyEventHandler])
-> a
mkKeybindEventSectionHelp KeyConfig
kc (TextHunk, Text, [TextHunk]) -> Widget Name
keybindEventHelpWidget [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox Text -> Widget Name
forall a. Text -> Widget a
headingNoPad

        keybindingHelpText :: [Widget a]
keybindingHelpText = ([Text] -> Widget a) -> [[Text]] -> [Widget a]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Widget a
forall a. [Text] -> Widget a
paraL
          [ [ Text
"Many of the keybindings used in Matterhorn can be "
            , Text
"modified from within Matterhorn's **config.ini** file. "
            , Text
"To do this, include a section called **[KEYBINDINGS]** "
            , Text
"in your config file and use the event names listed below as "
            , Text
"keys and the desired key sequence as values. "
            , Text
"See the end of this page for documentation on the valid "
            , Text
"syntax for key sequences."
            ]
          , [ Text
"For example, by default, the keybinding to move to the next "
            , Text
"channel in the public channel list is **"
            , Text
nextChanBinding
            , Text
"**, and the corresponding "
            , Text
"previous channel binding is **"
            , Text
prevChanBinding
            , Text
"**. You might want to remap these "
            , Text
"to other keys: say, **C-j** and **C-k**. We can do this with the following "
            , Text
"configuration snippet:"
            ]
          , [ Text
"```ini\n"
            , Text
"[KEYBINDINGS]\n"
            , Text
"focus-next-channel = C-j\n"
            , Text
"focus-prev-channel = C-k\n"
            , Text
"```"
            ]
          , [ Text
"You can remap a command to more than one key sequence, in which "
            , Text
"case any one of the key sequences provided can be used to invoke "
            , Text
"the relevant command. To do this, provide the desired bindings as "
            , Text
"a comma-separated list. Additionally, some key combinations are "
            , Text
"used in multiple modes (such as URL select or help viewing) and "
            , Text
"therefore share the same name, such as **cancel** or **scroll-up**."
            ]
          , [ Text
"Additionally, some keys simply cannot be remapped, mostly in the "
            , Text
"case of editing keybindings. If you feel that a particular key "
            , Text
"event should be rebindable and isn't, then please feel free to "
            , Text
"let us know by posting an issue in the Matterhorn issue tracker."
            ]
          , [ Text
"It is also possible to entirely unbind a key event by setting its "
            , Text
"key to **unbound**, thus avoiding conflicts between default bindings "
            , Text
"and new ones:"
            ]
          , [ Text
"```ini\n"
            , Text
"[KEYBINDINGS]\n"
            , Text
"focus-next-channel = unbound\n"
            , Text
"```"
            ]
          , [ Text
"The rebindable key events, along with their **current** "
            , Text
"values, are as follows:"
            ]
           ]
        nextChanBinding :: Text
nextChanBinding = Binding -> Text
ppBinding (KeyEvent -> Binding
getFirstDefaultBinding KeyEvent
NextChannelEvent)
        prevChanBinding :: Text
prevChanBinding = Binding -> Text
ppBinding (KeyEvent -> Binding
getFirstDefaultBinding KeyEvent
PrevChannelEvent)
        validKeys :: [Widget a]
validKeys = ([Text] -> Widget a) -> [[Text]] -> [Widget a]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Widget a
forall a. [Text] -> Widget a
paraL
          [ [ Text
"The syntax used for key sequences consists of zero or more "
            , Text
"single-character modifier characters followed by a keystroke, "
            , Text
"all separated by dashes. The available modifier keys are "
            , Text
"**S** for Shift, **C** for Ctrl, **A** for Alt, and **M** for "
            , Text
"Meta. So, for example, **"
            , Binding -> Text
ppBinding ([Modifier] -> Key -> Binding
Binding [] (Int -> Key
Vty.KFun Int
2))
            , Text
"** is the F2 key pressed with no "
            , Text
"modifier keys; **"
            , Binding -> Text
ppBinding ([Modifier] -> Key -> Binding
Binding [Modifier
Vty.MCtrl] (Char -> Key
Vty.KChar Char
'x'))
            , Text
"** is Ctrl and X pressed together, "
            , Text
"and **"
            , Binding -> Text
ppBinding ([Modifier] -> Key -> Binding
Binding [Modifier
Vty.MShift, Modifier
Vty.MCtrl] (Char -> Key
Vty.KChar Char
'x'))
            , Text
"** is Shift, Ctrl, and X all pressed together. "
            , Text
"Although Matterhorn will pretty-print all key combinations "
            , Text
"with specific capitalization, the parser is **not** case-sensitive "
            , Text
"and will ignore any capitalization."
            ]
          , [ Text
"Your terminal emulator might not recognize some particular "
            , Text
"keypress combinations, or it might reserve certain combinations of "
            , Text
"keys for some terminal-specific operation. Matterhorn does not have a "
            , Text
"reliable way of testing this, so it is up to you to avoid setting "
            , Text
"keybindings that your terminal emulator does not deliver to applications."
            ]
          , [ Text
"Letter keys, number keys, and function keys are specified with "
            , Text
"their obvious name, such as **x** for the X key, **8** for the 8 "
            , Text
"key, and **f5** for the F5 key. Other valid keys include: "
            , Text -> [Text] -> Text
T.intercalate Text
", " [ Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**" | Text
key <- [Text]
nonCharKeys ]
            , Text
"."
            ]
          ]

emph :: Widget a -> Widget a
emph :: Widget a -> Widget a
emph = AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
helpEmphAttr

para :: Text -> Widget a
para :: Text -> Widget a
para Text
t = Padding -> Widget a -> Widget a
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall a. Text -> Widget a
renderText Text
t

paraL :: [Text] -> Widget a
paraL :: [Text] -> Widget a
paraL = Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> ([Text] -> Text) -> [Text] -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat

heading :: Text -> Widget a
heading :: Text -> Widget a
heading = Padding -> Widget a -> Widget a
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget a -> Widget a) -> (Text -> Widget a) -> Text -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget a
forall a. Text -> Widget a
headingNoPad

headingNoPad :: Text -> Widget a
headingNoPad :: Text -> Widget a
headingNoPad Text
t = Widget a -> Widget a
forall n. Widget n -> Widget n
hCenter (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Widget a -> Widget a
forall n. Widget n -> Widget n
emph (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> Widget a
forall a. Text -> Widget a
renderText Text
t

syntaxHighlightHelp :: [FilePath] -> Widget a
syntaxHighlightHelp :: [FilePath] -> Widget a
syntaxHighlightHelp [FilePath]
dirs = [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
vBox
  [ Text -> Widget a
forall a. Text -> Widget a
heading Text
"Syntax Highlighting"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"Matterhorn supports syntax highlighting in Markdown code blocks when the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"name of the code block language follows the block opening sytnax:"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"```<language>"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"The possible values of `language` are determined by the available syntax " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"definitions. The available definitions are loaded from the following " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"directories according to the configuration setting `syntaxDirectories`. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"If the setting is omitted, it defaults to the following sequence of directories:"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (\FilePath
d -> FilePath
"`" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
d FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"`") (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
dirs
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"Syntax definitions are in the Kate XML format. Files with an " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"`xml` extension are loaded from each directory, with directories earlier " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"in the list taking precedence over later directories when more than one " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"directory provides a definition file for the same syntax."
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"To place custom definitions in a directory, place a Kate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"XML syntax definition in the directory and ensure that a copy of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"`language.dtd` is also present. The file `language.dtd` can be found in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
"the `syntax/` directory of your Matterhorn distribution."
  ]

themeHelp :: Widget a
themeHelp :: Widget a
themeHelp = [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
vBox
  [ Text -> Widget a
forall a. Text -> Widget a
heading Text
"Using Themes"
  , Text -> Widget a
forall a. Text -> Widget a
para Text
"Matterhorn provides these built-in color themes:"
  , Padding -> Widget a -> Widget a
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$ [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
vBox ([Widget a] -> Widget a) -> [Widget a] -> Widget a
forall a b. (a -> b) -> a -> b
$ Widget a -> Widget a
forall n. Widget n -> Widget n
hCenter (Widget a -> Widget a)
-> (Widget a -> Widget a) -> Widget a -> Widget a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Widget a -> Widget a
forall n. Widget n -> Widget n
emph (Widget a -> Widget a) -> (Text -> Widget a) -> Text -> Widget a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            Text -> Widget a
forall a. Text -> Widget a
txt (Text -> Widget a)
-> (InternalTheme -> Text) -> InternalTheme -> Widget a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalTheme -> Text
internalThemeName (InternalTheme -> Widget a) -> [InternalTheme] -> [Widget a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InternalTheme]
internalThemes
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"These themes can be selected with the */theme* command. To automatically " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"select a theme at startup, set the *theme* configuration file option to one " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"of the themes listed above."

  , Text -> Widget a
forall a. Text -> Widget a
heading Text
"Customizing the Theme"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"Theme customization is also supported. To customize the selected theme, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"create a theme customization file and set the `themeCustomizationFile` " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"configuration option to the path to the customization file. If the path " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"to the file is relative, Matterhorn will look for it in the same directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"as the Matterhorn configuration file."

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"Theme customization files are INI-style files that can customize any " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"foreground color, background color, or style of any aspect of the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Matterhorn user interface. Here is an example:"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"[default]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"default.fg = blue\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"default.bg = black\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"[other]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        AttrName -> Text
attrNameToConfig AttrName
codeAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".fg = magenta\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        AttrName -> Text
attrNameToConfig AttrName
codeAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".style = bold\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        AttrName -> Text
attrNameToConfig AttrName
clientEmphAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".fg = cyan\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        AttrName -> Text
attrNameToConfig AttrName
clientEmphAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".style = [bold, underline]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        AttrName -> Text
attrNameToConfig AttrName
listSelectedFocusedAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".fg = brightGreen\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"```"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"In the example above, the theme's default foreground and background colors " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"are both customized to *blue* and *black*, respectively. The *default* section " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"contains only customizations for the *default* attribute. All other customizations " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"go in the *other* section. We can also set the style for attributes; we can either " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"set just one style (as with the bold setting above) or multiple styles at once " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"(as in the bold/underline example).\n"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"Available colors are:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * black\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * red\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * green\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * yellow\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * blue\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * magenta\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * cyan\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * white\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightBlack\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightRed\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightGreen\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightYellow\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightBlue\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightMagenta\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightCyan\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * brightWhite"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"Available styles are:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * standout\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * underline\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * italic\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * strikethrough\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * reverseVideo\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * blink\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * dim\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * bold\n"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"It is also possible to specify RGB values using HTML syntax: `#RRGGBB`. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Bear in mind that such colors are clamped to the nearest 256-color palette " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"entry, so it is not possible to get the exact color specified.\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"In addition, a special value of *default* is possible for either color " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"setting of an attribute. This value indicates that the attribute should " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"use the terminal emulator's default foreground or background color of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"choice rather than a specific ANSI color."

  , Text -> Widget a
forall a. Text -> Widget a
heading Text
"Username Highlighting"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"Username colors are chosen by hashing each username and then using the hash " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"to choose a color from a list of predefined username colors. If you would like " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"to change the color in a given entry of this list, we provide the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"\"username.N\" attributes, where N is the index in the username color list."

  , Text -> Widget a
forall a. Text -> Widget a
heading Text
"Theme Attributes"
  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
"This section lists all possible theme attributes for use in customization " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"files along with a description of how each one is used in Matterhorn. Each " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"option listed can be set in the *other* section of the customization file. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Each provides three customization settings:"

  , Text -> Widget a
forall a. Text -> Widget a
para (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
        Text
" * *<option>.fg = <color>*\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * *<option>.bg = <color>*\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
" * *<option>.style = <style>* or *<option>.style = [<style>, ...]*\n"

  , let names :: [(AttrName, Text, Text)]
names = [(AttrName, Text, Text)] -> [(AttrName, Text, Text)]
forall a. Ord a => [a] -> [a]
sort ([(AttrName, Text, Text)] -> [(AttrName, Text, Text)])
-> [(AttrName, Text, Text)] -> [(AttrName, Text, Text)]
forall a b. (a -> b) -> a -> b
$
                 (\(AttrName
n, Text
msg) -> (AttrName
n, AttrName -> Text
attrNameToConfig AttrName
n, Text
msg)) ((AttrName, Text) -> (AttrName, Text, Text))
-> [(AttrName, Text)] -> [(AttrName, Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Map AttrName Text -> [(AttrName, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map AttrName Text -> [(AttrName, Text)])
-> Map AttrName Text -> [(AttrName, Text)]
forall a b. (a -> b) -> a -> b
$ ThemeDocumentation -> Map AttrName Text
themeDescriptions ThemeDocumentation
themeDocs)
        mkEntry :: (AttrName, Text, Text) -> Widget n
mkEntry (AttrName
n, Text
opt, Text
msg) =
            Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
            [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
txt Text
opt
                        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
txt Text
"(demo)"
                        ]
                 , Text -> Widget n
forall a. Text -> Widget a
txt Text
msg
                 ]
    in [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
vBox ([Widget a] -> Widget a) -> [Widget a] -> Widget a
forall a b. (a -> b) -> a -> b
$ (AttrName, Text, Text) -> Widget a
forall n. (AttrName, Text, Text) -> Widget n
mkEntry ((AttrName, Text, Text) -> Widget a)
-> [(AttrName, Text, Text)] -> [Widget a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AttrName, Text, Text)]
names
  ]

keybindSections :: [(Text, [KeyEventHandler])]
keybindSections :: [(Text, [KeyEventHandler])]
keybindSections =
    [ (Text
"Global Keybindings", [KeyEventHandler]
globalKeyHandlers)
    , (Text
"Help Page", [KeyEventHandler]
helpKeyHandlers)
    , (Text
"Main Interface", [KeyEventHandler]
mainKeyHandlers)
    , (Text
"Text Editing", Lens' ChatState (Editor Text Name) -> [KeyEventHandler]
editingKeyHandlers ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> TeamState -> f TeamState)
-> (Editor Text Name -> f (Editor Text Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> f ChatEditState) -> TeamState -> f TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> f ChatEditState) -> TeamState -> f TeamState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> ChatEditState -> f ChatEditState)
-> (Editor Text Name -> f (Editor Text Name))
-> TeamState
-> f TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> f (Editor Text Name))
-> ChatEditState -> f ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor))
    , (Text
"Channel Select Mode", [KeyEventHandler]
channelSelectKeyHandlers)
    , (Text
"Message Select Mode", [KeyEventHandler]
messageSelectKeyHandlers)
    , (Text
"User Listings", [KeyEventHandler]
userListOverlayKeyHandlers)
    , (Text
"URL Select Mode", [KeyEventHandler]
urlSelectKeyHandlers)
    , (Text
"Theme List Window", [KeyEventHandler]
themeListOverlayKeyHandlers)
    , (Text
"Channel Search Window", [KeyEventHandler]
channelListOverlayKeyHandlers)
    , (Text
"Message Viewer: Common", Lens' ChatState (TabbedWindow ViewMessageWindowTab)
-> [KeyEventHandler]
forall a.
(Show a, Eq a) =>
Lens' ChatState (TabbedWindow a) -> [KeyEventHandler]
tabbedWindowKeyHandlers ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> TeamState -> f TeamState)
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> TeamState -> f TeamState
Lens'
  TeamState (Maybe (Message, TabbedWindow ViewMessageWindowTab))
tsViewedMessage((Maybe (Message, TabbedWindow ViewMessageWindowTab)
  -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
 -> TeamState -> f TeamState)
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> Maybe (Message, TabbedWindow ViewMessageWindowTab)
    -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> TeamState
-> f TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Message, TabbedWindow ViewMessageWindowTab)
  (Message, TabbedWindow ViewMessageWindowTab)
-> Lens
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     (Message, TabbedWindow ViewMessageWindowTab)
     (Message, TabbedWindow ViewMessageWindowTab)
forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
Traversal
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Message, TabbedWindow ViewMessageWindowTab)
  (Message, TabbedWindow ViewMessageWindowTab)
_Just(((Message, TabbedWindow ViewMessageWindowTab)
  -> f (Message, TabbedWindow ViewMessageWindowTab))
 -> Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> (Message, TabbedWindow ViewMessageWindowTab)
    -> f (Message, TabbedWindow ViewMessageWindowTab))
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> Maybe (Message, TabbedWindow ViewMessageWindowTab)
-> f (Maybe (Message, TabbedWindow ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TabbedWindow ViewMessageWindowTab
 -> f (TabbedWindow ViewMessageWindowTab))
-> (Message, TabbedWindow ViewMessageWindowTab)
-> f (Message, TabbedWindow ViewMessageWindowTab)
forall s t a b. Field2 s t a b => Lens s t a b
_2))
    , (Text
"Message Viewer: Message tab", [KeyEventHandler]
viewMessageKeyHandlers)
    , (Text
"Message Viewer: Reactions tab", [KeyEventHandler]
viewMessageReactionsKeyHandlers)
    , (Text
"Attachment List", [KeyEventHandler]
attachmentListKeyHandlers)
    , (Text
"Attachment File Browser", [KeyEventHandler]
attachmentBrowseKeyHandlers)
    , (Text
"Flagged Messages", [KeyEventHandler]
postListOverlayKeyHandlers)
    , (Text
"Reaction Emoji Search Window", [KeyEventHandler]
reactionEmojiListOverlayKeyHandlers)
    ]

helpBox :: Name -> Widget Name -> Widget Name
helpBox :: Name -> Widget Name -> Widget Name
helpBox Name
n Widget Name
helpText =
    AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
helpAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
HelpViewport ViewportType
Vertical (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached Name
n Widget Name
helpText

kbColumnWidth :: Int
kbColumnWidth :: Int
kbColumnWidth = Int
14

kbDescColumnWidth :: Int
kbDescColumnWidth :: Int
kbDescColumnWidth = Int
60

mkKeybindingHelp :: KeyConfig -> (Text, [KeyEventHandler]) -> Widget Name
mkKeybindingHelp :: KeyConfig -> (Text, [KeyEventHandler]) -> Widget Name
mkKeybindingHelp KeyConfig
kc (Text
sectionName, [KeyEventHandler]
kbs) =
    (Text -> Widget Name
forall a. Text -> Widget a
heading Text
sectionName) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
    (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Text, Widget Name) -> Widget Name
forall a b. (a, b) -> b
snd ((Text, Widget Name) -> Widget Name)
-> [(Text, Widget Name)] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Widget Name) -> Text)
-> [(Text, Widget Name)] -> [(Text, Widget Name)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Text, Widget Name) -> Text
forall a b. (a, b) -> a
fst [(Text, Widget Name)]
results)
    where
        results :: [(Text, Widget Name)]
results = KeyConfig -> KeyEventHandler -> (Text, Widget Name)
mkKeybindHelp KeyConfig
kc (KeyEventHandler -> (Text, Widget Name))
-> [KeyEventHandler] -> [(Text, Widget Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler]
kbs

mkKeybindHelp :: KeyConfig -> KeyEventHandler -> (Text, Widget Name)
mkKeybindHelp :: KeyConfig -> KeyEventHandler -> (Text, Widget Name)
mkKeybindHelp KeyConfig
kc KeyEventHandler
h =
    let unbound :: [Text]
unbound = [Text
"(unbound)"]
        label :: Text
label = case KeyEventHandler -> KeyEventTrigger
kehEventTrigger KeyEventHandler
h of
            Static Event
k -> Binding -> Text
ppBinding (Binding -> Text) -> Binding -> Text
forall a b. (a -> b) -> a -> b
$ Event -> Binding
eventToBinding Event
k
            ByEvent KeyEvent
ev ->
                let bindings :: [Text]
bindings = case KeyEvent -> KeyConfig -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyEvent
ev KeyConfig
kc of
                        Maybe BindingState
Nothing ->
                            let bs :: [Binding]
bs = KeyEvent -> [Binding]
defaultBindings KeyEvent
ev
                            in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Binding] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binding]
bs
                               then Binding -> Text
ppBinding (Binding -> Text) -> [Binding] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyEvent -> [Binding]
defaultBindings KeyEvent
ev
                               else [Text]
unbound
                        Just BindingState
Unbound -> [Text]
unbound
                        Just (BindingList [Binding]
bs) | Bool -> Bool
not ([Binding] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binding]
bs) -> Binding -> Text
ppBinding (Binding -> Text) -> [Binding] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binding]
bs
                                              | Bool
otherwise -> [Text]
unbound
                in Text -> [Text] -> Text
T.intercalate Text
", " [Text]
bindings

        rendering :: Widget n
rendering = (Widget n -> Widget n
forall n. Widget n -> Widget n
emph (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo Int
kbColumnWidth (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                      Text
label) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall a. Text -> Widget a
txt Text
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                    (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
kbDescColumnWidth (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
renderText (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
                     EventHandler -> Text
ehDescription (EventHandler -> Text) -> EventHandler -> Text
forall a b. (a -> b) -> a -> b
$ KeyEventHandler -> EventHandler
kehHandler KeyEventHandler
h)
    in (Text
label, Widget Name
forall a. Widget a
rendering)

mkKeybindEventSectionHelp :: KeyConfig
                          -> ((TextHunk, Text, [TextHunk]) -> a)
                          -> ([a] -> a)
                          -> (Text -> a)
                          -> (Text, [KeyEventHandler])
                          -> a
mkKeybindEventSectionHelp :: KeyConfig
-> ((TextHunk, Text, [TextHunk]) -> a)
-> ([a] -> a)
-> (Text -> a)
-> (Text, [KeyEventHandler])
-> a
mkKeybindEventSectionHelp KeyConfig
kc (TextHunk, Text, [TextHunk]) -> a
mkKeybindHelpFunc [a] -> a
vertCat Text -> a
mkHeading (Text
sectionName, [KeyEventHandler]
kbs) =
  [a] -> a
vertCat ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Text -> a
mkHeading Text
sectionName) a -> [a] -> [a]
forall a. a -> [a] -> [a]
:
            ((TextHunk, Text, [TextHunk]) -> a
mkKeybindHelpFunc ((TextHunk, Text, [TextHunk]) -> a)
-> [(TextHunk, Text, [TextHunk])] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyConfig -> KeyEventHandler -> (TextHunk, Text, [TextHunk])
mkKeybindEventHelp KeyConfig
kc (KeyEventHandler -> (TextHunk, Text, [TextHunk]))
-> [KeyEventHandler] -> [(TextHunk, Text, [TextHunk])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler]
kbs))

data TextHunk = Verbatim Text
              | Comment Text

keybindEventHelpWidget :: (TextHunk, Text, [TextHunk]) -> Widget Name
keybindEventHelpWidget :: (TextHunk, Text, [TextHunk]) -> Widget Name
keybindEventHelpWidget (TextHunk
evName, Text
desc, [TextHunk]
evs) =
    let evText :: Text
evText = Text -> [Text] -> Text
T.intercalate Text
", " (TextHunk -> Text
getText (TextHunk -> Text) -> [TextHunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextHunk]
evs)
        getText :: TextHunk -> Text
getText (Comment Text
s) = Text
s
        getText (Verbatim Text
s) = Text
s
        label :: Widget n
label = case TextHunk
evName of
            Comment Text
s -> Text -> Widget n
forall a. Text -> Widget a
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
            Verbatim Text
s -> Widget n -> Widget n
forall n. Widget n -> Widget n
emph (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall a. Text -> Widget a
txt Text
s
    in Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Text -> Widget Name
forall a. Text -> Widget a
txtWrap (Text
"; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc)
            , Widget Name
forall a. Widget a
label Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall a. Text -> Widget a
txt (Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
evText)
            ]

keybindEventHelpMarkdown :: (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpMarkdown :: (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpMarkdown (TextHunk
evName, Text
desc, [TextHunk]
evs) =
    let quote :: a -> a
quote a
s = a
"`" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"`"
        format :: TextHunk -> Text
format (Comment Text
s) = Text
s
        format (Verbatim Text
s) = Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
quote Text
s
        name :: Text
name = case TextHunk
evName of
            Comment Text
s -> Text
s
            Verbatim Text
s -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
quote Text
s
    in Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ TextHunk -> Text
format (TextHunk -> Text) -> [TextHunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextHunk]
evs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
" |"

keybindEventHelpText :: Int -> Int -> (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpText :: Int -> Int -> (TextHunk, Text, [TextHunk]) -> Text
keybindEventHelpText Int
width Int
eventNameWidth (TextHunk
evName, Text
desc, [TextHunk]
evs) =
    let getText :: TextHunk -> Text
getText (Comment Text
s) = Text
s
        getText (Verbatim Text
s) = Text
s
    in Int -> Text -> Text
padTo Int
width (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ TextHunk -> Text
getText (TextHunk -> Text) -> [TextHunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextHunk]
evs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Int -> Text -> Text
padTo Int
eventNameWidth (TextHunk -> Text
getText TextHunk
evName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
desc

mkKeybindEventHelp :: KeyConfig -> KeyEventHandler -> (TextHunk, Text, [TextHunk])
mkKeybindEventHelp :: KeyConfig -> KeyEventHandler -> (TextHunk, Text, [TextHunk])
mkKeybindEventHelp KeyConfig
kc KeyEventHandler
h =
  let trig :: KeyEventTrigger
trig = KeyEventHandler -> KeyEventTrigger
kehEventTrigger KeyEventHandler
h
      unbound :: [TextHunk]
unbound = [Text -> TextHunk
Comment Text
"(unbound)"]
      (TextHunk
label, [TextHunk]
evText) = case KeyEventTrigger
trig of
          Static Event
key -> (Text -> TextHunk
Comment Text
"(non-customizable key)", [Text -> TextHunk
Verbatim (Text -> TextHunk) -> Text -> TextHunk
forall a b. (a -> b) -> a -> b
$ Binding -> Text
ppBinding (Binding -> Text) -> Binding -> Text
forall a b. (a -> b) -> a -> b
$ Event -> Binding
eventToBinding Event
key])
          ByEvent KeyEvent
ev -> case KeyEvent -> KeyConfig -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyEvent
ev KeyConfig
kc of
              Maybe BindingState
Nothing ->
                  let name :: Text
name = KeyEvent -> Text
keyEventName KeyEvent
ev
                  in if Bool -> Bool
not ([Binding] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (KeyEvent -> [Binding]
defaultBindings KeyEvent
ev))
                     then (Text -> TextHunk
Verbatim Text
name, Text -> TextHunk
Verbatim (Text -> TextHunk) -> (Binding -> Text) -> Binding -> TextHunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binding -> Text
ppBinding (Binding -> TextHunk) -> [Binding] -> [TextHunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyEvent -> [Binding]
defaultBindings KeyEvent
ev)
                     else (Text -> TextHunk
Verbatim Text
name, [TextHunk]
unbound)
              Just BindingState
Unbound -> (Text -> TextHunk
Verbatim (Text -> TextHunk) -> Text -> TextHunk
forall a b. (a -> b) -> a -> b
$ KeyEvent -> Text
keyEventName KeyEvent
ev, [TextHunk]
unbound)
              Just (BindingList [Binding]
bs) -> (Text -> TextHunk
Verbatim (Text -> TextHunk) -> Text -> TextHunk
forall a b. (a -> b) -> a -> b
$ KeyEvent -> Text
keyEventName KeyEvent
ev,
                                        if Bool -> Bool
not ([Binding] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binding]
bs)
                                        then Text -> TextHunk
Verbatim (Text -> TextHunk) -> (Binding -> Text) -> Binding -> TextHunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binding -> Text
ppBinding (Binding -> TextHunk) -> [Binding] -> [TextHunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binding]
bs
                                        else [TextHunk]
unbound
                                        )
  in (TextHunk
label, EventHandler -> Text
ehDescription (EventHandler -> Text) -> EventHandler -> Text
forall a b. (a -> b) -> a -> b
$ KeyEventHandler -> EventHandler
kehHandler KeyEventHandler
h, [TextHunk]
evText)

padTo :: Int -> Text -> Text
padTo :: Int -> Text -> Text
padTo Int
n Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" "