{-# 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 forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdName Recognizer Command
commands of
    Recognition Command
Invalid -> [Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) [Char]
"Unknown command, try /help"]
    Prefix [Text]
sfxs ->
      [Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown command, did you mean: " forall a. [a] -> [a] -> [a]
++ [Char]
suggestions]
      where
      suggestions :: [Char]
suggestions = Text -> [Char]
Text.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
" " ((Text
cmdName forall a. Semigroup a => a -> a -> a
<>) 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} ->
      forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> Image'
heading Text
"Syntax: " forall a. Semigroup a => a -> a -> a
<> forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary ClientState
st Palette
pal (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
cmdName) Args ClientState a
spec
              forall a. a -> [a] -> [a]
: Image'
emptyLine
              forall a. a -> [a] -> [a]
: [Image']
aliasLines
             forall a. [a] -> [a] -> [a]
++ forall a. CommandImpl a -> Image'
explainContext CommandImpl a
impl
              forall a. a -> [a] -> [a]
: Image'
emptyLine
              forall a. a -> [a] -> [a]
: 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 forall a. Eq a => a -> [a] -> [a]
delete Text
cmdName (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
names) of
            [] -> []
            [Text]
ns -> [ Text -> Image'
heading Text
"Aliases: " 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: " 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
  = forall a. [a] -> [[a]] -> [a]
intercalate [Image'
emptyLine]
  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse
  forall a b. (a -> b) -> a -> b
$ (ClientState -> Palette -> CommandSection -> [Image']
listCommandSection ClientState
st Palette
pal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommandSection]
commandsList)
 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
  | 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" forall a. a -> [a] -> [a]
:
      [ forall r a. r -> Palette -> NonEmpty Text -> Args r a -> Image'
commandSummary ClientState
st Palette
pal (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) forall r. Args r [[Char]]
spec
      | Macro Text
name (MacroSpec forall r. Args r [[Char]]
spec) [[ExpansionChunk]]
_ <- [Macro]
macros
      , then forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn by Text
name
      ]
  where
    macros :: [Macro]
macros = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Recognizer Macro)
configMacros forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
  forall a. a -> [a] -> [a]
: [ 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 :: 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
'/' forall a. Semigroup a => a -> a -> a
<>
  Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palCommandReady Palette
pal) Text
cmd forall a. Semigroup a => a -> a -> a
<>
  forall r a. Palette -> r -> Bool -> Args r a -> [Char] -> Image'
render Palette
pal' r
st Bool
True Args r a
args [Char]
""

  where
    pal' :: Palette
pal' = forall s t a b. ASetter s t a b -> b -> s -> t
set 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
' '