{-# Language BangPatterns, OverloadedStrings, TransformListComp #-}

{-|
Module      : Client.View.Help
Description : Renderer for help lines
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the rendering used for the @/help@ command.

-}
module Client.View.Help
  ( helpImageLines
  ) where

import           Client.State (ClientState, clientConfig)
import           Client.Configuration (configMacros)
import           Client.Commands
import           Client.Commands.Interpolation
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, sortOn)
import           Data.List.NonEmpty (NonEmpty((:|)))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Graphics.Vty.Attributes

-- | Generate either the list of all commands and their arguments,
-- or when given a command name generate the detailed help text
-- for that command.
helpImageLines ::
  ClientState {- ^ client state          -} ->
  Maybe Text  {- ^ optional command name -} ->
  Palette     {- ^ palette               -} ->
  [Image']    {- ^ help lines            -}
helpImageLines :: ClientState -> Maybe Text -> Palette -> [Image']
helpImageLines ClientState
st Maybe Text
mbCmd Palette
pal =
  case Maybe Text
mbCmd of
    Maybe Text
Nothing  -> ClientState -> Palette -> [Image']
listAllCommands ClientState
st Palette
pal
    Just Text
cmd -> ClientState -> Text -> Palette -> [Image']
commandHelpLines ClientState
st Text
cmd Palette
pal

-- | Generate detailed help lines for the command with the given name.
commandHelpLines ::
  ClientState {- ^ client state -} ->
  Text        {- ^ command name -} ->
  Palette     {- ^ palette      -} ->
  [Image']    {- ^ lines        -}
commandHelpLines :: ClientState -> Text -> Palette -> [Image']
commandHelpLines ClientState
st Text
cmdName Palette
pal =
  case Text -> Recognizer Command -> Recognition Command
forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdName Recognizer Command
commands of
    Recognition Command
Invalid -> [Attr -> String -> Image'
string (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
palError Palette
pal) String
"Unknown command, try /help"]
    Prefix [Text]
sfxs ->
      [Attr -> String -> Image'
string (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
palError Palette
pal) (String -> Image') -> String -> Image'
forall a b. (a -> b) -> a -> b
$ String
"Unknown command, did you mean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suggestions]
      where
      suggestions :: String
suggestions = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ 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)
    Exact Command{cmdNames :: Command -> NonEmpty Text
cmdNames = NonEmpty Text
names, cmdImplementation :: ()
cmdImplementation = CommandImpl a
impl,
                  cmdArgumentSpec :: ()
cmdArgumentSpec = Args ClientState 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
<> ClientState
-> Palette -> NonEmpty Text -> Args ClientState a -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary ClientState
st Palette
pal (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
cmdName) Args ClientState 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
        aliasLines :: [Image']
aliasLines =
          case Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
delete Text
cmdName (NonEmpty Text -> [Text]
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 :: 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)"
    NetworkCommand{} -> Image'
"network (works when focused on active network)"
    ChannelCommand{} -> Image'
"channel (works when focused on active channel)"
    ChatCommand   {} -> Image'
"chat (works when focused on an active channel or private message)"


-- | Generate the lines for the help window showing all commands.
listAllCommands ::
  ClientState {- ^ client state    -} ->
  Palette     {- ^ palette         -} ->
  [Image']    {- ^ help lines      -}
listAllCommands :: ClientState -> Palette -> [Image']
listAllCommands ClientState
st Palette
pal
  = [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]

macroCommandSection ::
  ClientState    {- ^ client state    -} ->
  Palette        {- ^ palette         -} ->
  [Image']       {- ^ help lines      -}
macroCommandSection :: ClientState -> Palette -> [Image']
macroCommandSection ClientState
st Palette
pal
  | [Macro] -> 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 (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 ((Text, forall r. Args r [String]) -> Text)
-> [(Text, forall r. Args r [String])]
-> [(Text, forall r. Args r [String])]
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
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]
: [ ClientState
-> Palette -> NonEmpty Text -> Args ClientState a -> Image'
forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary ClientState
st Palette
pal NonEmpty Text
names Args ClientState a
spec
    | -- pattern needed due to existential quantification
      Command { cmdNames :: Command -> NonEmpty Text
cmdNames        = NonEmpty Text
names
              , cmdArgumentSpec :: ()
cmdArgumentSpec = Args ClientState 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 :: 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
' '