{-# Language BangPatterns, OverloadedStrings #-}
module Client.View.Help
( helpImageLines
) where
import Client.State (ClientState)
import Client.Commands
import Client.Commands.Arguments.Spec
import Client.Commands.Arguments.Renderer
import Client.Commands.Recognizer
import Client.Image.MircFormatting
import Client.Image.PackedImage
import Client.Image.Palette
import Control.Lens
import Data.Foldable (toList)
import Data.List (delete, intercalate)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Text (Text)
import qualified Data.Text as Text
import Graphics.Vty.Attributes
helpImageLines ::
ClientState ->
Maybe Text ->
Palette ->
[Image']
helpImageLines st mbCmd pal =
case mbCmd of
Nothing -> listAllCommands st pal
Just cmd -> commandHelpLines st cmd pal
commandHelpLines ::
ClientState ->
Text ->
Palette ->
[Image']
commandHelpLines st cmdName pal =
case recognize cmdName commands of
Invalid -> [string (view palError pal) "Unknown command, try /help"]
Prefix sfxs ->
[string (view palError pal) $ "Unknown command, did you mean: " ++ suggestions]
where
suggestions = Text.unpack $ Text.intercalate " " ((cmdName <>) <$> sfxs)
Exact Command{cmdNames = names, cmdImplementation = impl,
cmdArgumentSpec = spec, cmdDocumentation = doc} ->
reverse $ heading "Syntax: " <> commandSummary st pal (pure cmdName) spec
: emptyLine
: aliasLines
++ explainContext impl
: emptyLine
: map parseIrcText (Text.lines doc)
where
aliasLines =
case delete cmdName (toList names) of
[] -> []
ns -> [ heading "Aliases: " <>
text' defAttr (Text.intercalate ", " ns)
, emptyLine ]
heading :: Text -> Image'
heading = text' (withStyle defAttr bold)
explainContext ::
CommandImpl a ->
Image'
explainContext impl =
heading "Context: " <>
case impl of
ClientCommand {} -> "client (works everywhere)"
NetworkCommand{} -> "network (works when focused on active network)"
ChannelCommand{} -> "channel (works when focused on active channel)"
ChatCommand {} -> "chat (works when focused on an active channel or private message)"
listAllCommands ::
ClientState ->
Palette ->
[Image']
listAllCommands st pal
= intercalate [emptyLine]
$ map reverse
$ listCommandSection st pal <$> commandsList
listCommandSection ::
ClientState ->
Palette ->
CommandSection ->
[Image']
listCommandSection st pal sec
= text' (withStyle defAttr bold) (cmdSectionName sec)
: [ commandSummary st pal names spec
|
Command { cmdNames = names
, cmdArgumentSpec = spec
} <- cmdSectionCmds sec
]
commandSummary ::
r ->
Palette ->
NonEmpty Text ->
Args r a ->
Image'
commandSummary st pal (cmd :| _) args =
char defAttr '/' <>
text' (view palCommandReady pal) cmd <>
render pal' st True args ""
where
pal' = set palCommandPlaceholder defAttr pal
emptyLine :: Image'
emptyLine = char defAttr ' '