-- | A default help command implementation
module CalamityCommands.Help (
  helpCommand',
  helpCommand,
) where

import CalamityCommands.AliasType
import CalamityCommands.Check
import CalamityCommands.Command
import CalamityCommands.CommandUtils
import CalamityCommands.Context
import CalamityCommands.Dsl
import CalamityCommands.Group
import CalamityCommands.Handler
import CalamityCommands.ParameterInfo
import CalamityCommands.Internal.LocalWriter

import Control.Applicative
import Control.Lens hiding (Context (..))

import qualified Data.HashMap.Lazy as LH
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe)
import qualified Data.Text as S
import qualified Data.Text.Lazy as L

import qualified Polysemy as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Reader as P

data CommandOrGroup m c a
  = Command' (Command m c a)
  | Group' (Group m c a) [S.Text]

parameterTypeHelp :: [ParameterInfo] -> L.Text
parameterTypeHelp pinfo =
  let dedup = LH.toList . LH.fromList $ map (\(ParameterInfo _ t d) -> (t, d)) pinfo
      typeDescs = L.unlines ["- " <> L.pack (show t) <> ": " <> L.fromStrict d | (t, d) <- dedup]
  in "Types:\n" <> typeDescs <> "\n"

helpCommandHelp :: c -> L.Text
helpCommandHelp _ = "Show help for a command or group."

helpForCommand :: CommandContext m c a => c -> Command m c a -> L.Text
helpForCommand ctx cmd@Command{names, checks, help, params} =
  "Usage: " <> prefix' <> path' <> " " <> params' <> "\n"
    <> aliasesFmt
    <> checksFmt
    <> parameterTypeHelp params
    <> help ctx
 where
  prefix' = ctxPrefix ctx
  path' = L.unwords . map L.fromStrict $ commandPath cmd
  params' = commandParams cmd
  aliases = map L.fromStrict $ NE.tail names
  checks' = map (L.fromStrict . (^. #name)) checks
  aliasesFmt =
    if null aliases
      then ""
      else "Aliases: " <> L.unwords aliases <> "\n"
  checksFmt =
    if null checks'
      then ""
      else "Checks: " <> L.unwords checks' <> "\n\n"

fmtCommandWithParams :: Command m c a -> L.Text
fmtCommandWithParams cmd@Command{names} = formatWithAliases names <> " " <> commandParams cmd

formatWithAliases :: NonEmpty S.Text -> L.Text
formatWithAliases (name :| aliases) = L.fromStrict name <> aliasesFmt
 where
  aliasesFmt = case aliases of
    [] -> ""
    aliases' -> "[" <> L.intercalate "|" (map L.fromStrict aliases') <> "]"

onlyOriginals :: [(a, AliasType)] -> [a]
onlyOriginals = mapMaybe inner
 where
  inner (_, Alias) = Nothing
  inner (a, Original) = Just a

onlyVisibleC :: [Command m c a] -> [Command m c a]
onlyVisibleC = mapMaybe notHiddenC

onlyVisibleG :: [Group m c a] -> [Group m c a]
onlyVisibleG = mapMaybe notHiddenG

helpForGroup :: CommandContext m c a => c -> Group m c a -> L.Text
helpForGroup ctx grp =
  "Group: " <> path' <> "\n"
    <> aliasesFmt
    <> checksFmt
    <> (grp ^. #help) ctx
    <> "\n"
    <> groupsMsg
    <> commandsMsg
 where
  path' = L.fromStrict . S.unwords $ groupPath grp
  groups = onlyVisibleG . onlyOriginals . LH.elems $ grp ^. #children
  commands = onlyVisibleC . onlyOriginals . LH.elems $ grp ^. #commands
  groupsFmt = map formatWithAliases (groups ^.. traverse . #names)
  groupsMsg =
    if null groups
      then ""
      else "The following child groups exist:\n" <> (L.unlines . map ("- " <>) $ groupsFmt)
  commandsMsg =
    if null commands
      then ""
      else "\nThe following child commands exist:\n" <> (L.unlines . map (("- " <>) . fmtCommandWithParams) $ commands)
  aliases = map L.fromStrict . NE.tail $ grp ^. #names
  checks' = map (L.fromStrict . (^. #name)) $ grp ^. #checks
  aliasesFmt =
    if null aliases
      then ""
      else "Aliases: " <> L.unwords aliases <> "\n"
  checksFmt =
    if null checks'
      then ""
      else "Checks: " <> L.unwords checks' <> "\n\n"

rootHelp :: CommandHandler m c a -> L.Text
rootHelp handler = groupsMsg <> commandsMsg
 where
  groups = onlyVisibleG . onlyOriginals . LH.elems $ handler ^. #groups
  commands = onlyVisibleC . onlyOriginals . LH.elems $ handler ^. #commands
  groupsFmt = map formatWithAliases (groups ^.. traverse . #names)
  groupsMsg =
    if null groups
      then ""
      else "The following groups exist:\n" <> (L.unlines . map ("- " <>) $ groupsFmt)
  commandsMsg =
    if null commands
      then ""
      else "\nThe following commands exist:\n" <> (L.unlines . map (("- " <>) . fmtCommandWithParams) $ commands)

renderHelp :: CommandContext m c a => CommandHandler m c a -> c -> [S.Text] -> L.Text
renderHelp handler ctx path =
  case findCommandOrGroup handler path of
    Just (Command' cmd@Command{names}) ->
      "Help for command `" <> L.fromStrict (NE.head names) <> "`: \n" <> helpForCommand ctx cmd
    Just (Group' grp@Group{names} remainingPath) ->
      let failedMsg =
            if null remainingPath
              then ""
              else "No command or group with the path: `" <> L.fromStrict (S.unwords remainingPath) <> "` exists for the group: `" <> L.fromStrict (NE.head names) <> "`\n"
       in failedMsg <> "Help for group `" <> L.fromStrict (NE.head names) <> "`: \n" <> helpForGroup ctx grp
    Nothing ->
      let failedMsg =
            if null path
              then ""
              else "No command or group with the path: `" <> L.fromStrict (S.unwords path) <> "` was found.\n"
       in failedMsg <> rootHelp handler

{- | Given a 'CommandHandler', optionally a parent 'Group', and a list of 'Check's,
 construct a help command that will provide help for all the commands and
 groups in the passed 'CommandHandler'.
-}
helpCommand' ::
  (Monad m, P.Member (P.Final m) r, CommandContext m c a) =>
  CommandHandler m c a ->
  Maybe (Group m c a) ->
  [Check m c] ->
  (c -> L.Text -> P.Sem (P.Fail ': r) a) ->
  P.Sem r (Command m c a)
helpCommand' handler parent checks render =
  buildCommand @'[[S.Text]]
    ("help" :| [])
    parent
    False
    checks
    helpCommandHelp
    (\ctx path -> render ctx $ renderHelp handler ctx path)

{- | Create and register the default help command for all the commands registered
 in the commands DSL this is used in. The @render@ parameter is used so you can
 determine how the help should be rendered, for example it could be
 @'putStrLn'@, or a pure function such as @'pure' . 'Left'@

 The registered command will have the name \'help\', called with no parameters
 it will render help for the top-level groups and commands, for example:

 @
 The following groups exist:
 - reanimate
 - prefix[prefixes]
 - alias[aliases]
 - remind[reminder|reminders]

 The following commands exist:
 - help :[Text]
 @

 Both commands and groups are listed in the form: @\<name\>[\<alias 0\>|\<alias 1\>]@,
 commands also have their parameter list shown.

 If a path to a group is passed, the help, aliases, and pre-invokation checks
 will be listed, along with the subgroups and commands, For example:

 @
 Help for group remind:
 Group: remind
 Aliases: reminder reminders
 Commands related to making reminders

 The following child commands exist:
 - list
 - remove reminder_id:Text
 - add :KleenePlusConcat Text
 @

 If a command path is passed, the usage, checks and help for the command are
 shown, for example:

 @
 Help for command add:
 Usage: c!prefix add prefix:Text
 Checks: prefixLimit guildOnly

 Add a new prefix
 @
-}
helpCommand ::
  forall c m a r.
  (Monad m, P.Member (P.Final m) r, CommandContext m c a) =>
  (c -> L.Text -> P.Sem (P.Fail ': r) a) ->
  P.Sem (DSLState m c a r) (Command m c a)
helpCommand render = do
  handler <- P.ask @(CommandHandler m c a)
  parent <- P.ask @(Maybe (Group m c a))
  checks <- P.ask @[Check m c]
  cmd <- raiseDSL $ helpCommand' handler parent checks render
  ltell $ LH.singleton "help" (cmd, Original)
  pure cmd

notHiddenC :: Command m c a -> Maybe (Command m c a)
notHiddenC c@Command{hidden} = if hidden then Nothing else Just c

notHiddenG :: Group m c a -> Maybe (Group m c a)
notHiddenG g@Group{hidden} = if hidden then Nothing else Just g

findCommandOrGroup :: CommandHandler m c a -> [S.Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup handler path = go (handler ^. #commands, handler ^. #groups) path
 where
  go ::
    (LH.HashMap S.Text (Command m c a, AliasType), LH.HashMap S.Text (Group m c a, AliasType)) ->
    [S.Text] ->
    Maybe (CommandOrGroup m c a)
  go (commands, groups) (x : xs) =
    case LH.lookup x commands of
      Just (notHiddenC -> Just cmd, _) -> Just (Command' cmd)
      _ -> case LH.lookup x groups of
        Just (notHiddenG -> Just group, _) -> go (group ^. #commands, group ^. #children) xs <|> Just (Group' group xs)
        _ -> Nothing
  go _ [] = Nothing