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

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Keybindings
import           Brick.Themes ( themeDescriptions )
import           Brick.Widgets.Center ( hCenter )
import           Brick.Widgets.Edit ( Editor )
import           Brick.Widgets.List ( listSelectedFocusedAttr )

import qualified Data.Map as M
import           Data.Maybe ( fromJust )
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( Lens' )

import           Network.Mattermost.Types ( TeamId )
import           Network.Mattermost.Version ( mmApiVersion )

import           Matterhorn.Command
import           Matterhorn.Events.ChannelSelect
import           Matterhorn.Events.Global
import           Matterhorn.Events.Main
import           Matterhorn.Events.MessageSelect
import           Matterhorn.Events.MessageInterface
import           Matterhorn.Events.ThemeListWindow
import           Matterhorn.Events.PostListWindow
import           Matterhorn.Events.ShowHelp
import           Matterhorn.Events.UrlSelect
import           Matterhorn.Events.UserListWindow
import           Matterhorn.Events.ChannelListWindow
import           Matterhorn.Events.ReactionEmojiListWindow
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


drawShowHelp :: HelpTopic -> ChatState -> [Widget Name]
drawShowHelp :: HelpTopic -> ChatState -> [Widget Name]
drawShowHelp HelpTopic
topic ChatState
st =
    [HelpScreen -> Widget Name -> Widget Name
helpBox (HelpTopic -> HelpScreen
helpTopicScreen HelpTopic
topic) 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 =
    forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
codeAttr AttrName
helpEmphAttr forall a b. (a -> b) -> a -> b
$
    forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
    forall n. Int -> Widget n -> Widget n
hLimit Int
helpContentWidth forall a b. (a -> b) -> a -> b
$
    case HelpTopic -> HelpScreen
helpTopicScreen HelpTopic
topic of
        HelpScreen
MainHelp -> KeyConfig KeyEvent -> Widget Name
mainHelp (Config -> KeyConfig KeyEvent
configUserKeys (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration))
        HelpScreen
ScriptHelp -> Widget Name
scriptHelp
        HelpScreen
ThemeHelp -> Widget Name
themeHelp
        HelpScreen
SyntaxHighlightHelp -> forall a. SemEq a => [FilePath] -> Widget a
syntaxHighlightHelp (Config -> [FilePath]
configSyntaxDirs forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
        HelpScreen
KeybindingHelp -> KeyConfig KeyEvent -> Widget Name
keybindingHelp (Config -> KeyConfig KeyEvent
configUserKeys (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration))

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

    mkCommandHelpText :: Widget Name
    mkCommandHelpText :: Widget Name
mkCommandHelpText =
      let commandNameWidth :: Int
commandNameWidth = Int
2 forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
commandHelpInfo)
      in forall n. [Widget n] -> Widget n
vBox [ (forall n. Widget n -> Widget n
emph forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo Int
commandNameWidth Text
info) forall n. Widget n -> Widget n -> Widget n
<=>
                (forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) forall a b. (a -> b) -> a -> b
$ forall a. SemEq 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 = 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 forall a. Semigroup a => a -> a -> a
<> Text
spc forall a. Semigroup a => a -> a -> a
<> Text
argSpec
                ]
        cs :: [Cmd]
cs = 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 forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
commandHelpInfo)
    in Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$
       [ Int -> Text -> Text
padTo Int
commandNameWidth Text
info 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" forall a b. (a -> b) -> a -> b
$
    [ Text
"# Commands"
    , Text
""
    , Text
"| Command | Description |"
    , Text
"| ------- | ----------- |"
    ] forall a. Semigroup a => a -> a -> a
<>
    [ Text
"| `" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapePipes Text
info forall a. Semigroup a => a -> a -> a
<> Text
"` | " forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapePipes Text
desc forall a. Semigroup a => a -> a -> a
<> Text
" |"
    | (Text
info, Text
desc) <- [(Text, Text)]
commandHelpInfo
    ]

escapePipes :: Text -> Text
escapePipes :: Text -> Text
escapePipes = Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|"

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

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

scriptHelp :: Widget Name
scriptHelp :: Widget Name
scriptHelp = forall a. SemEq a => Text -> Widget a
heading Text
"Using Scripts" forall n. Widget n -> Widget n -> Widget n
<=> forall n. [Widget n] -> Widget n
vBox [Widget Name]
scriptHelpText
  where scriptHelpText :: [Widget Name]
scriptHelpText = forall a b. (a -> b) -> [a] -> [b]
map forall a. SemEq 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!*" ]
           ]

keybindingHelp :: KeyConfig KeyEvent -> Widget Name
keybindingHelp :: KeyConfig KeyEvent -> Widget Name
keybindingHelp KeyConfig KeyEvent
kc = forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
  [ forall a. SemEq a => Text -> Widget a
heading Text
"Configurable Keybindings"
  , forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox [Widget Name]
keybindingHelpText
  ] forall a. [a] -> [a] -> [a]
++ [Widget Name]
keybindSectionWidgets
    forall a. [a] -> [a] -> [a]
++
  [ forall a. SemEq a => Text -> Widget a
headingNoPad Text
"Keybinding Syntax"
  , forall n. [Widget n] -> Widget n
vBox [Widget Name]
validKeys
  ]
  where addHeading :: Text -> Widget n -> Widget n
addHeading Text
n Widget n
w = forall n. [Widget n] -> Widget n
vBox [ forall a. SemEq a => Text -> Widget a
headingNoPad Text
n, Widget n
w ]
        keybindSectionWidgets :: [Widget Name]
keybindSectionWidgets = (\(Text
name, [MHKeyEventHandler]
hs) -> forall {n}. SemEq n => Text -> Widget n -> Widget n
addHeading Text
name forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) n.
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> Widget n
keybindingHelpWidget KeyConfig KeyEvent
kc [MHKeyEventHandler]
hs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [MHKeyEventHandler])]
keybindSections
        keybindingHelpText :: [Widget Name]
keybindingHelpText = forall a b. (a -> b) -> [a] -> [b]
map forall a. SemEq 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 = Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
NextChannelEvent)
        prevChanBinding :: Text
prevChanBinding = Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
PrevChannelEvent)
        validKeys :: [Widget Name]
validKeys = forall a b. (a -> b) -> [a] -> [b]
map forall a. SemEq 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 (Int -> Binding
fn Int
2)
            , Text
"** is the F2 key pressed with no "
            , Text
"modifier keys; **"
            , Binding -> Text
ppBinding (forall a. ToBinding a => a -> Binding
ctrl Char
'x')
            , Text
"** is Ctrl and X pressed together, "
            , Text
"and **"
            , Binding -> Text
ppBinding (forall a. ToBinding a => a -> Binding
shift forall a b. (a -> b) -> a -> b
$ forall a. ToBinding a => a -> Binding
ctrl 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
"**" forall a. Semigroup a => a -> a -> a
<> Text
k forall a. Semigroup a => a -> a -> a
<> Text
"**" | Text
k <- [Text]
nonCharKeys ]
            , Text
"."
            ]
          ]

nonCharKeys :: [Text]
nonCharKeys :: [Text]
nonCharKeys = 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
  ]

event :: (Ord e) => KeyConfig e -> e -> Widget a
event :: forall e a. Ord e => KeyConfig e -> e -> Widget a
event KeyConfig e
kc = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
helpKeyEventAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. Ord k => KeyEvents k -> k -> Maybe Text
keyEventName (forall k. KeyConfig k -> KeyEvents k
keyConfigEvents KeyConfig e
kc)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

keybindSections :: [(Text, [MHKeyEventHandler])]
keybindSections :: [(Text, [MHKeyEventHandler])]
keybindSections =
    [ (Text
"Global Keybindings", [MHKeyEventHandler]
globalKeyHandlers)
    , (Text
"Help Page", TeamId -> [MHKeyEventHandler]
helpKeyHandlers TeamId
teamIdThunk)
    , (Text
"Main Interface", TeamId -> [MHKeyEventHandler]
mainKeyHandlers TeamId
teamIdThunk forall a. Semigroup a => a -> a -> a
<>
                         forall n i.
Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler]
messageInterfaceKeyHandlers forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"Message Editing", forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
extraEditorKeyHandlers forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"Text Editing", Lens' ChatState (Editor Text Name) -> [MHKeyEventHandler]
editingKeyHandlers Lens' ChatState (Editor Text Name)
editorThunk)
    , (Text
"Channel Select Mode", TeamId -> [MHKeyEventHandler]
channelSelectKeyHandlers TeamId
teamIdThunk)
    , (Text
"Message Select Mode", forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler]
messageSelectKeyHandlers TeamId
teamIdThunk forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"User Listings", TeamId -> [MHKeyEventHandler]
userListWindowKeyHandlers TeamId
teamIdThunk)
    , (Text
"URL Select Mode", forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
urlSelectKeyHandlers forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"Theme List Window", TeamId -> [MHKeyEventHandler]
themeListWindowKeyHandlers TeamId
teamIdThunk)
    , (Text
"Channel Search Window", TeamId -> [MHKeyEventHandler]
channelListWindowKeyHandlers TeamId
teamIdThunk)
    , (Text
"Message Viewer: Common", forall a.
(Show a, Eq a) =>
TeamId
-> Lens' ChatState (TabbedWindow ChatState MH Name a)
-> [MHKeyEventHandler]
tabbedWindowKeyHandlers TeamId
teamIdThunk Lens' ChatState (TabbedWindow ChatState MH Name Int)
tabbedWinThunk)
    , (Text
"Message Viewer: Message tab", TeamId -> [MHKeyEventHandler]
viewMessageKeyHandlers TeamId
teamIdThunk)
    , (Text
"Message Viewer: Reactions tab", TeamId -> [MHKeyEventHandler]
viewMessageReactionsKeyHandlers TeamId
teamIdThunk)
    , (Text
"Attachment List", forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
attachmentListKeyHandlers forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"Attachment File Browser", forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
attachmentBrowseKeyHandlers forall n i. Lens' ChatState (MessageInterface n i)
whichThunk)
    , (Text
"Flagged Messages", TeamId -> [MHKeyEventHandler]
postListWindowKeyHandlers TeamId
teamIdThunk)
    , (Text
"Reaction Emoji Search Window", TeamId -> [MHKeyEventHandler]
reactionEmojiListWindowKeyHandlers TeamId
teamIdThunk)
    ]

teamIdThunk :: TeamId
teamIdThunk :: TeamId
teamIdThunk = forall a. HasCallStack => FilePath -> a
error FilePath
"BUG: should not evaluate teamIdThunk"

tabbedWinThunk :: Lens' ChatState (TabbedWindow ChatState MH Name Int)
tabbedWinThunk :: Lens' ChatState (TabbedWindow ChatState MH Name Int)
tabbedWinThunk = forall a. HasCallStack => FilePath -> a
error FilePath
"BUG: should not evaluate tabbedWinThunk"

editorThunk :: Lens' ChatState (Editor Text Name)
editorThunk :: Lens' ChatState (Editor Text Name)
editorThunk = forall a. HasCallStack => FilePath -> a
error FilePath
"BUG: should not evaluate editorThunk"

whichThunk :: Lens' ChatState (MessageInterface n i)
whichThunk :: forall n i. Lens' ChatState (MessageInterface n i)
whichThunk = forall a. HasCallStack => FilePath -> a
error FilePath
"BUG: should not evaluate whichThunk"

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

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

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

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

mkKeybindHelp :: (Ord e)
              => KeyConfig e
              -> KeyEventHandler e m
              -> (Text, Widget Name)
mkKeybindHelp :: forall e (m :: * -> *).
Ord e =>
KeyConfig e -> KeyEventHandler e m -> (Text, Widget Name)
mkKeybindHelp KeyConfig e
kc KeyEventHandler e m
h =
    let unbound :: [Text]
unbound = [Text
"(unbound)"]
        (Text
label, Maybe e
mEv) = case forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger KeyEventHandler e m
h of
            ByKey Binding
b -> (Binding -> Text
ppBinding Binding
b, forall a. Maybe a
Nothing)
            ByEvent e
ev ->
                let bindings :: [Text]
bindings = case forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig e
kc e
ev of
                        Maybe BindingState
Nothing ->
                            let bs :: [Binding]
bs = forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig e
kc e
ev
                            in if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binding]
bs
                               then Binding -> Text
ppBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binding]
bs
                               else [Text]
unbound
                        Just BindingState
Unbound -> [Text]
unbound
                        Just (BindingList [Binding]
bs) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binding]
bs) -> Binding -> Text
ppBinding 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, forall a. a -> Maybe a
Just e
ev)

        renderEvent :: e -> Widget n
renderEvent e
ev = forall n. Text -> Widget n
txt Text
"event: " forall n. Widget n -> Widget n -> Widget n
<+> forall e a. Ord e => KeyConfig e -> e -> Widget a
event KeyConfig e
kc e
ev
        rendering :: Widget Name
rendering = (forall n. Widget n -> Widget n
emph forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo Int
kbColumnWidth forall a b. (a -> b) -> a -> b
$
                      Text
label) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
" " forall n. Widget n -> Widget n -> Widget n
<+>
                    (forall n. Int -> Widget n -> Widget n
hLimit Int
kbDescColumnWidth forall a b. (a -> b) -> a -> b
$
                     forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$
                     forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
                     forall n. [Widget n] -> Widget n
vBox [ forall a. SemEq a => Text -> Widget a
renderText forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Handler m -> Text
handlerDescription forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler KeyEventHandler e m
h
                          , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n. Widget n
emptyWidget forall {n}. e -> Widget n
renderEvent Maybe e
mEv
                          ]
                     )
    in (Text
label, Widget Name
rendering)

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