{-# LANGUAGE TransformListComp, OverloadedStrings #-}

{-|
Module      : Client.Commands.Help
Description : Implementation of the /help command
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

Implements the /help command, which is responsible for managing the help buffer.
Unfortunately, this makes this command somewhat unique in that it's responsible for rendering.
-}

module Client.Commands.Help ( cmdHelp ) where

import           Client.Commands.Arguments.Renderer
import           Client.Commands.Arguments.Spec
import           Client.Commands.Interpolation
import           Client.Commands.Recognizer
import           Client.Commands.Types
import           Client.Configuration (configMacros)
import           Client.Image.MircFormatting
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.Image.Message
import           Client.State
import           Client.State.Focus (focusNetwork, Subfocus(FocusHelp))
import           Client.State.Help
import           Client.State.Network (sendMsg)
import           Control.Lens
import           Data.Foldable (toList)
import           Data.List (delete, intercalate, sortOn)
import           Data.List.NonEmpty (NonEmpty((:|)))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Graphics.Vty.Attributes
import           Irc.Commands (ircHelp)

displayHelp :: ClientState -> HelpState -> IO CommandResult
displayHelp :: ClientState -> HelpState -> IO CommandResult
displayHelp ClientState
st HelpState
help = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> IO CommandResult)
-> (ClientState -> ClientState) -> ClientState -> IO CommandResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusHelp (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState HelpState HelpState
-> HelpState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState HelpState HelpState
Lens' ClientState HelpState
clientHelp HelpState
help ClientState
st

-- | Implementation of @/help@ command.
cmdHelp :: [CommandSection] -> Recognizer Command -> WindowCommand (Maybe String)
cmdHelp :: [CommandSection]
-> Recognizer Command -> WindowCommand (Maybe String)
cmdHelp [CommandSection]
commandsList Recognizer Command
commands Focus
focus ClientState
st (Just (Char
':':String
queryStr)) =
  case Focus -> Maybe Text
focusNetwork Focus
focus of
    Maybe Text
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty network prefix requires focused network" ClientState
st
    Just Text
net -> [CommandSection]
-> Recognizer Command -> WindowCommand (Maybe String)
cmdHelp [CommandSection]
commandsList Recognizer Command
commands Focus
focus ClientState
st (String -> Maybe String
forall a. a -> Maybe a
Just (Text -> String
Text.unpack Text
net String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String
queryStr))
                -- Network name better not start with a colon! ;)
cmdHelp [CommandSection]
_ Recognizer Command
commands Focus
_ ClientState
st (Just String
queryStr)
  | Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryText Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
savedQueryText = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusHelp ClientState
st)
  | Bool
otherwise = Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelp Recognizer Command
commands Text
queryText ClientState
st
  where
    savedQueryText :: Maybe Text
savedQueryText = LensLike' (Const (Maybe Text)) ClientState HelpQuery
-> (HelpQuery -> Maybe Text) -> ClientState -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((HelpState -> Const (Maybe Text) HelpState)
-> ClientState -> Const (Maybe Text) ClientState
Lens' ClientState HelpState
clientHelp ((HelpState -> Const (Maybe Text) HelpState)
 -> ClientState -> Const (Maybe Text) ClientState)
-> ((HelpQuery -> Const (Maybe Text) HelpQuery)
    -> HelpState -> Const (Maybe Text) HelpState)
-> LensLike' (Const (Maybe Text)) ClientState HelpQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HelpQuery -> Const (Maybe Text) HelpQuery)
-> HelpState -> Const (Maybe Text) HelpState
Lens' HelpState HelpQuery
hsQuery) HelpQuery -> Maybe Text
helpQueryToText ClientState
st
    queryText :: Text
queryText = String -> Text
Text.pack String
queryStr
cmdHelp [CommandSection]
commandsList Recognizer Command
_ Focus
_ ClientState
st Maybe String
Nothing = [CommandSection] -> ClientState -> IO CommandResult
loadHelpList [CommandSection]
commandsList ClientState
st

loadHelpList :: [CommandSection] -> ClientState -> IO CommandResult
loadHelpList :: [CommandSection] -> ClientState -> IO CommandResult
loadHelpList [CommandSection]
commandList ClientState
st = ClientState -> HelpState -> IO CommandResult
displayHelp ClientState
st (HelpState -> IO CommandResult) -> HelpState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Image'] -> HelpState
makeHelp Maybe Text
forall a. Maybe a
Nothing ([Image'] -> HelpState) -> [Image'] -> HelpState
forall a b. (a -> b) -> a -> b
$ [CommandSection] -> ClientState -> [Image']
listAllCommands [CommandSection]
commandList ClientState
st

loadHelp :: Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelp :: Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelp Recognizer Command
commands Text
query ClientState
st =
  case (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
query of
    (Text
cmdName, Text
"") -> Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelpCmd Recognizer Command
commands Text
cmdName ClientState
st
    (Text
net, Text
topic) -> Text -> Text -> ClientState -> IO CommandResult
sendHelpQuery Text
net (HasCallStack => Text -> Text
Text -> Text
Text.tail Text
topic) ClientState
st

sendHelpQuery :: Text -> Text -> ClientState -> IO CommandResult
sendHelpQuery :: Text -> Text -> ClientState -> IO CommandResult
sendHelpQuery Text
net Text
topic ClientState
st =
  case Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st of
    Just NetworkState
cs -> do
      NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircHelp Text
topic)
      ClientState -> HelpState -> IO CommandResult
displayHelp ClientState
st (Text -> Text -> HelpState
awaitHelp Text
net Text
topic)
    Maybe NetworkState
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg (Text
"not connected to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
net) ClientState
st

loadHelpCmd :: Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelpCmd :: Recognizer Command -> Text -> ClientState -> IO CommandResult
loadHelpCmd Recognizer Command
commands Text
cmdName ClientState
st =
  case LensLike'
  (Const (Recognition Macro)) ClientState (Recognizer Macro)
-> (Recognizer Macro -> Recognition Macro)
-> ClientState
-> Recognition Macro
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const (Recognition Macro) Configuration)
-> ClientState -> Const (Recognition Macro) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognition Macro) Configuration)
 -> ClientState -> Const (Recognition Macro) ClientState)
-> ((Recognizer Macro
     -> Const (Recognition Macro) (Recognizer Macro))
    -> Configuration -> Const (Recognition Macro) Configuration)
-> LensLike'
     (Const (Recognition Macro)) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro -> Const (Recognition Macro) (Recognizer Macro))
-> Configuration -> Const (Recognition Macro) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) (Text -> Recognizer Macro -> Recognition Macro
forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdName) ClientState
st of
    Exact Macro
macro -> ClientState -> HelpState -> IO CommandResult
displayHelp ClientState
st (HelpState -> IO CommandResult) -> HelpState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Image'] -> HelpState
makeHelp (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cmdName) ([Image'] -> HelpState) -> [Image'] -> HelpState
forall a b. (a -> b) -> a -> b
$ ClientState -> Text -> Macro -> [Image']
macroHelpLines ClientState
st Text
cmdName Macro
macro
    Recognition Macro
Invalid -> [Text] -> IO CommandResult
commandCase []
    Prefix [Text]
sfxs -> [Text] -> IO CommandResult
commandCase [Text]
sfxs
  where
    commandCase :: [Text] -> IO CommandResult
commandCase [Text]
macroSfxs =
      case Text -> Recognizer Command -> Recognition Command
forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdName Recognizer Command
commands of
        Recognition Command
Invalid -> [Text] -> IO CommandResult
failureCase [Text]
macroSfxs
        Prefix [Text]
sfxs -> [Text] -> IO CommandResult
failureCase ([Text]
macroSfxs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
sfxs)
        Exact Command
cmd -> ClientState -> HelpState -> IO CommandResult
displayHelp ClientState
st (HelpState -> IO CommandResult) -> HelpState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Image'] -> HelpState
makeHelp (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cmdName) ([Image'] -> HelpState) -> [Image'] -> HelpState
forall a b. (a -> b) -> a -> b
$ ClientState -> Text -> Command -> [Image']
commandHelpLines ClientState
st Text
cmdName Command
cmd

    failureCase :: [Text] -> IO CommandResult
failureCase [Text]
sfxs
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sfxs = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown command, try /help with no argument" ClientState
st
      | Bool
otherwise = Text -> ClientState -> IO CommandResult
commandFailureMsg (Text
"unknown command, did you mean: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suggestions) ClientState
st
        where suggestions :: Text
suggestions = Text -> [Text] -> Text
Text.intercalate Text
" " ((Text
cmdName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
sfxs)

-- | Generate detailed help for macro expansions
macroHelpLines ::
  ClientState {- ^ client state -} ->
  Text        {- ^ name         -} ->
  Macro       {- ^ macro        -} ->
  [Image']    {- ^ lines        -}
macroHelpLines :: ClientState -> Text -> Macro -> [Image']
macroHelpLines
  ClientState
st
  Text
name
  Macro{ macroSpec :: Macro -> MacroSpec
macroSpec = MacroSpec forall r. Args r [String]
spec, macroCommands :: Macro -> [[ExpansionChunk]]
macroCommands = [[ExpansionChunk]]
commands }
  = [Image'] -> [Image']
forall a. [a] -> [a]
reverse
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Text -> Image'
heading Text
"Syntax: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> ArgsContext
-> Palette -> NonEmpty Text -> Args ArgsContext [String] -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary (ClientState -> ArgsContext
makeArgsContext ClientState
st) Palette
pal (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) Args ArgsContext [String]
forall r. Args r [String]
spec
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image'
emptyLine
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Text -> Image'
heading Text
"Macro Expansion:"
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: ([ExpansionChunk] -> Image') -> [[ExpansionChunk]] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (\[ExpansionChunk]
x -> Image'
"    " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> (ExpansionChunk -> Image') -> [ExpansionChunk] -> Image'
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ExpansionChunk -> Image'
explainExpansion [ExpansionChunk]
x) [[ExpansionChunk]]
commands
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
cyan
    explainExpansion :: ExpansionChunk -> Image'
explainExpansion ExpansionChunk
chunk =
      case ExpansionChunk
chunk of
        LiteralChunk Text
txt -> Attr -> Text -> Image'
text' Attr
defAttr (Text -> Text
cleanText Text
txt)
        VariableChunk Text
var -> Attr -> Text -> Image'
text' Attr
attr (Text
"${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")
        IntegerChunk Integer
i -> Attr -> String -> Image'
string Attr
attr (String
"${" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}")
        DefaultChunk ExpansionChunk
c Text
txt ->
          Attr -> Text -> Image'
text' Attr
attr Text
"${" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          ExpansionChunk -> Image'
explainExpansion ExpansionChunk
c Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Text -> Image'
text' Attr
attr Text
"|" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Text -> Image'
text' Attr
defAttr (Text -> Text
cleanText Text
txt) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Text -> Image'
text' Attr
attr Text
"}"

-- | Generate detailed help lines for the command with the given name.
commandHelpLines ::
  ClientState {- ^ client state -} ->
  Text        {- ^ command name -} ->
  Command     {- ^ command      -} ->
  [Image']    {- ^ lines        -}
commandHelpLines :: ClientState -> Text -> Command -> [Image']
commandHelpLines
  ClientState
st
  Text
cmdName
  Command{cmdNames :: Command -> NonEmpty Text
cmdNames = NonEmpty Text
names, cmdImplementation :: ()
cmdImplementation = CommandImpl a
impl, cmdArgumentSpec :: ()
cmdArgumentSpec = Args ArgsContext a
spec, cmdDocumentation :: Command -> Text
cmdDocumentation = Text
doc}
  = [Image'] -> [Image']
forall a. [a] -> [a]
reverse ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Text -> Image'
heading Text
"Syntax: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> ArgsContext
-> Palette -> NonEmpty Text -> Args ArgsContext a -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary (ClientState -> ArgsContext
makeArgsContext ClientState
st) Palette
pal (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
cmdName) Args ArgsContext a
spec
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image'
emptyLine
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [Image']
aliasLines
     [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ CommandImpl a -> Image'
forall a. CommandImpl a -> Image'
explainContext CommandImpl a
impl
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image'
emptyLine
      Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: (Text -> Image') -> [Text] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Palette -> Text -> Image'
parseIrcText Palette
pal) (Text -> [Text]
Text.lines Text
doc)
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    aliasLines :: [Image']
aliasLines =
      case Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
delete Text
cmdName (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
names) of
        [] -> []
        [Text]
ns -> [ Text -> Image'
heading Text
"Aliases: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr (Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
ns), Image'
emptyLine ]

heading :: Text -> Image'
heading :: Text -> Image'
heading = Attr -> Text -> Image'
text' (Attr -> Style -> Attr
withStyle Attr
defAttr Style
bold)

-- | Generate an explanation of the context where the given command
-- implementation will be valid.
explainContext ::
  CommandImpl a {- ^ command implementation -} ->
  Image'        {- ^ help line              -}
explainContext :: forall a. CommandImpl a -> Image'
explainContext CommandImpl a
impl =
  Text -> Image'
heading Text
"Context: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
  case CommandImpl a
impl of
    ClientCommand {}   -> Image'
"client (works everywhere)"
    WindowCommand {}   -> Image'
"window (works on the current window)"
    NetworkCommand{}   -> Image'
"network (works when focused on active network)"
    MaybeChatCommand{} -> Image'
"network (works when focused on active network)" -- Intentional duplicate.
    ChatCommand{}      -> Image'
"chat (works when focused on an active channel or private message)"
    ChannelCommand{}   -> Image'
"channel (works when focused on active channel)"

-- | Generate the lines for the help window showing all commands.
listAllCommands ::
  [CommandSection] {- ^  commands  -} ->
  ClientState {- ^ client state    -} ->
  [Image']    {- ^ help lines      -}
listAllCommands :: [CommandSection] -> ClientState -> [Image']
listAllCommands [CommandSection]
commandsList ClientState
st
  = [Image'] -> [[Image']] -> [Image']
forall a. [a] -> [[a]] -> [a]
intercalate [Image'
emptyLine]
  ([[Image']] -> [Image']) -> [[Image']] -> [Image']
forall a b. (a -> b) -> a -> b
$ ([Image'] -> [Image']) -> [[Image']] -> [[Image']]
forall a b. (a -> b) -> [a] -> [b]
map [Image'] -> [Image']
forall a. [a] -> [a]
reverse
  ([[Image']] -> [[Image']]) -> [[Image']] -> [[Image']]
forall a b. (a -> b) -> a -> b
$ (ClientState -> Palette -> CommandSection -> [Image']
listCommandSection ClientState
st Palette
pal (CommandSection -> [Image']) -> [CommandSection] -> [[Image']]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommandSection]
commandsList)
 [[Image']] -> [[Image']] -> [[Image']]
forall a. [a] -> [a] -> [a]
++ [ClientState -> Palette -> [Image']
macroCommandSection ClientState
st Palette
pal]
 where pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

macroCommandSection ::
  ClientState    {- ^ client state    -} ->
  Palette        {- ^ palette         -} ->
  [Image']       {- ^ help lines      -}
macroCommandSection :: ClientState -> Palette -> [Image']
macroCommandSection ClientState
st Palette
pal
  | [Macro] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Macro]
macros = []
  | Bool
otherwise =
      Attr -> Text -> Image'
text' (Attr -> Style -> Attr
withStyle Attr
defAttr Style
bold) Text
"Macros" Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
:
      [ ClientState
-> Palette -> NonEmpty Text -> Args ClientState [String] -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary ClientState
st Palette
pal (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) Args ClientState [String]
forall r. Args r [String]
spec
      | Macro Text
name (MacroSpec forall r. Args r [String]
spec) [[ExpansionChunk]]
_ <- [Macro]
macros
      , then (a -> Text) -> [a] -> [a]
((Text, forall r. Args r [String]) -> Text)
-> [(Text, forall r. Args r [String])]
-> [(Text, forall r. Args r [String])]
forall {a}. (a -> Text) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn by Text
name
      ]
  where
    macros :: [Macro]
macros = Getting (Endo [Macro]) ClientState Macro -> ClientState -> [Macro]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Configuration -> Const (Endo [Macro]) Configuration)
-> ClientState -> Const (Endo [Macro]) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Endo [Macro]) Configuration)
 -> ClientState -> Const (Endo [Macro]) ClientState)
-> ((Macro -> Const (Endo [Macro]) Macro)
    -> Configuration -> Const (Endo [Macro]) Configuration)
-> Getting (Endo [Macro]) ClientState Macro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro -> Const (Endo [Macro]) (Recognizer Macro))
-> Configuration -> Const (Endo [Macro]) Configuration
Lens' Configuration (Recognizer Macro)
configMacros ((Recognizer Macro -> Const (Endo [Macro]) (Recognizer Macro))
 -> Configuration -> Const (Endo [Macro]) Configuration)
-> ((Macro -> Const (Endo [Macro]) Macro)
    -> Recognizer Macro -> Const (Endo [Macro]) (Recognizer Macro))
-> (Macro -> Const (Endo [Macro]) Macro)
-> Configuration
-> Const (Endo [Macro]) Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Macro -> Const (Endo [Macro]) Macro)
-> Recognizer Macro -> Const (Endo [Macro]) (Recognizer Macro)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Recognizer Macro) Macro
folded) ClientState
st

listCommandSection ::
  ClientState    {- ^ client state    -} ->
  Palette        {- ^ palette         -} ->
  CommandSection {- ^ command section -} ->
  [Image']       {- ^ help lines      -}
listCommandSection :: ClientState -> Palette -> CommandSection -> [Image']
listCommandSection ClientState
st Palette
pal CommandSection
sec
  = Attr -> Text -> Image'
text' (Attr -> Style -> Attr
withStyle Attr
defAttr Style
bold) (CommandSection -> Text
cmdSectionName CommandSection
sec)
  Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [ ArgsContext
-> Palette -> NonEmpty Text -> Args ArgsContext a -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary (ClientState -> ArgsContext
makeArgsContext ClientState
st) Palette
pal NonEmpty Text
names Args ArgsContext a
spec
    | -- pattern needed due to existential quantification
      Command { cmdNames :: Command -> NonEmpty Text
cmdNames        = NonEmpty Text
names
              , cmdArgumentSpec :: ()
cmdArgumentSpec = Args ArgsContext a
spec
              } <- CommandSection -> [Command]
cmdSectionCmds CommandSection
sec
    ]

-- | Generate the help line for the given command and its
-- specification for use in the list of commands.
commandSummary ::
  r                {- ^ client state             -} ->
  Palette          {- ^ palette                  -} ->
  NonEmpty Text    {- ^ command name and aliases -} ->
  Args r a         {- ^ argument specification   -} ->
  Image'           {- ^ summary help line        -}
commandSummary :: forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary r
st Palette
pal (Text
cmd :| [Text]
_) Args r a
args  =
  Attr -> Char -> Image'
char Attr
defAttr Char
'/' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
  Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palCommandReady Palette
pal) Text
cmd Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
  Palette -> r -> Bool -> Args r a -> String -> Image'
forall r a. Palette -> r -> Bool -> Args r a -> String -> Image'
render Palette
pal' r
st Bool
True Args r a
args String
""

  where
    pal' :: Palette
pal' = ASetter Palette Palette Attr Attr -> Attr -> Palette -> Palette
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Palette Palette Attr Attr
Lens' Palette Attr
palCommandPlaceholder Attr
defAttr Palette
pal

-- Empty line used as a separator
emptyLine :: Image'
emptyLine :: Image'
emptyLine = Attr -> Char -> Image'
char Attr
defAttr Char
' '