{-# Language BangPatterns, OverloadedStrings #-}
module Client.View.Help
( helpImageLines
) where
import Client.Commands
import Client.Commands.Arguments
import Client.Image.Arguments
import Client.Image.MircFormatting
import Client.Image.Palette
import Client.Commands.Recognizer
import Control.Lens
import Data.Foldable (toList)
import Data.List (delete, intercalate)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import Graphics.Vty.Attributes
import Graphics.Vty.Image
helpImageLines ::
Maybe Text ->
Palette ->
[Image]
helpImageLines mbCmd pal =
case mbCmd of
Nothing -> listAllCommands pal
Just cmd -> commandHelpLines cmd pal
commandHelpLines ::
Text ->
Palette ->
[Image]
commandHelpLines 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 $ commandSummary pal (pure cmdName) spec
: emptyLine
: aliasLines
++ explainContext impl
: emptyLine
: map parseIrcText (Text.lines doc)
where
aliasLines =
case delete cmdName (toList names) of
[] -> []
ns -> [ text' defAttr (Text.unwords ("Aliases:":ns))
, emptyLine ]
explainContext ::
CommandImpl a ->
Image
explainContext impl =
case impl of
ClientCommand {} -> go "client command" "works everywhere"
NetworkCommand{} -> go "network command" "works when focused on active network"
ChannelCommand{} -> go "channel command" "works when focused on active channel"
ChatCommand {} -> go "chat command" "works when focused on an active channel or private message"
where
go x y = string (withStyle defAttr bold) x <|>
string defAttr (": " ++ y)
listAllCommands ::
Palette ->
[Image]
listAllCommands pal
= intercalate [emptyLine]
$ map reverse
$ listCommandSection pal <$> commandsList
listCommandSection ::
Palette ->
CommandSection ->
[Image]
listCommandSection pal sec
= text' (withStyle defAttr bold) (cmdSectionName sec)
: [ commandSummary pal names spec
|
Command { cmdNames = names
, cmdArgumentSpec = spec
} <- cmdSectionCmds sec
]
commandSummary ::
Palette ->
NonEmpty Text ->
ArgumentSpec a ->
Image
commandSummary pal (cmd :| _) args =
char defAttr '/' <|>
text' (view palCommand pal) cmd <|>
argumentsImage pal' args ""
where
pal' = set palCommandPlaceholder defAttr pal
emptyLine :: Image
emptyLine = text' defAttr " "