-- | A command handler
module CalamityCommands.Handler (CommandHandler (..)) where

import CalamityCommands.AliasType
import CalamityCommands.Command
import CalamityCommands.Group

import qualified Data.HashMap.Lazy as LH
import qualified Data.Text as S

import GHC.Generics

import TextShow
import qualified TextShow.Generic as TSG

data CommandHandler m c a = CommandHandler
    { -- | Top level groups
      CommandHandler m c a -> HashMap Text (Group m c a, AliasType)
groups :: LH.HashMap S.Text (Group m c a, AliasType)
    , -- | Top level commands
      CommandHandler m c a -> HashMap Text (Command m c a, AliasType)
commands :: LH.HashMap S.Text (Command m c a, AliasType)
    }
    deriving ((forall x. CommandHandler m c a -> Rep (CommandHandler m c a) x)
-> (forall x. Rep (CommandHandler m c a) x -> CommandHandler m c a)
-> Generic (CommandHandler m c a)
forall x. Rep (CommandHandler m c a) x -> CommandHandler m c a
forall x. CommandHandler m c a -> Rep (CommandHandler m c a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) c a x.
Rep (CommandHandler m c a) x -> CommandHandler m c a
forall (m :: * -> *) c a x.
CommandHandler m c a -> Rep (CommandHandler m c a) x
$cto :: forall (m :: * -> *) c a x.
Rep (CommandHandler m c a) x -> CommandHandler m c a
$cfrom :: forall (m :: * -> *) c a x.
CommandHandler m c a -> Rep (CommandHandler m c a) x
Generic)

data CommandHandlerS m c a = CommandHandlerS
    { CommandHandlerS m c a -> [(Text, (Group m c a, AliasType))]
groups :: [(S.Text, (Group m c a, AliasType))]
    , CommandHandlerS m c a -> [(Text, (Command m c a, AliasType))]
commands :: [(S.Text, (Command m c a, AliasType))]
    }
    deriving (Int -> CommandHandlerS m c a -> ShowS
[CommandHandlerS m c a] -> ShowS
CommandHandlerS m c a -> String
(Int -> CommandHandlerS m c a -> ShowS)
-> (CommandHandlerS m c a -> String)
-> ([CommandHandlerS m c a] -> ShowS)
-> Show (CommandHandlerS m c a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> ShowS
forall (m :: * -> *) c a. [CommandHandlerS m c a] -> ShowS
forall (m :: * -> *) c a. CommandHandlerS m c a -> String
showList :: [CommandHandlerS m c a] -> ShowS
$cshowList :: forall (m :: * -> *) c a. [CommandHandlerS m c a] -> ShowS
show :: CommandHandlerS m c a -> String
$cshow :: forall (m :: * -> *) c a. CommandHandlerS m c a -> String
showsPrec :: Int -> CommandHandlerS m c a -> ShowS
$cshowsPrec :: forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> ShowS
Show, (forall x. CommandHandlerS m c a -> Rep (CommandHandlerS m c a) x)
-> (forall x.
    Rep (CommandHandlerS m c a) x -> CommandHandlerS m c a)
-> Generic (CommandHandlerS m c a)
forall x. Rep (CommandHandlerS m c a) x -> CommandHandlerS m c a
forall x. CommandHandlerS m c a -> Rep (CommandHandlerS m c a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) c a x.
Rep (CommandHandlerS m c a) x -> CommandHandlerS m c a
forall (m :: * -> *) c a x.
CommandHandlerS m c a -> Rep (CommandHandlerS m c a) x
$cto :: forall (m :: * -> *) c a x.
Rep (CommandHandlerS m c a) x -> CommandHandlerS m c a
$cfrom :: forall (m :: * -> *) c a x.
CommandHandlerS m c a -> Rep (CommandHandlerS m c a) x
Generic)
    deriving (Int -> CommandHandlerS m c a -> Builder
Int -> CommandHandlerS m c a -> Text
Int -> CommandHandlerS m c a -> Text
[CommandHandlerS m c a] -> Builder
[CommandHandlerS m c a] -> Text
[CommandHandlerS m c a] -> Text
CommandHandlerS m c a -> Builder
CommandHandlerS m c a -> Text
CommandHandlerS m c a -> Text
(Int -> CommandHandlerS m c a -> Builder)
-> (CommandHandlerS m c a -> Builder)
-> ([CommandHandlerS m c a] -> Builder)
-> (Int -> CommandHandlerS m c a -> Text)
-> (CommandHandlerS m c a -> Text)
-> ([CommandHandlerS m c a] -> Text)
-> (Int -> CommandHandlerS m c a -> Text)
-> (CommandHandlerS m c a -> Text)
-> ([CommandHandlerS m c a] -> Text)
-> TextShow (CommandHandlerS m c a)
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Builder
forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Text
forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Text
forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Builder
forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Text
forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Text
forall (m :: * -> *) c a. CommandHandlerS m c a -> Builder
forall (m :: * -> *) c a. CommandHandlerS m c a -> Text
forall (m :: * -> *) c a. CommandHandlerS m c a -> Text
showtlList :: [CommandHandlerS m c a] -> Text
$cshowtlList :: forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Text
showtl :: CommandHandlerS m c a -> Text
$cshowtl :: forall (m :: * -> *) c a. CommandHandlerS m c a -> Text
showtlPrec :: Int -> CommandHandlerS m c a -> Text
$cshowtlPrec :: forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Text
showtList :: [CommandHandlerS m c a] -> Text
$cshowtList :: forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Text
showt :: CommandHandlerS m c a -> Text
$cshowt :: forall (m :: * -> *) c a. CommandHandlerS m c a -> Text
showtPrec :: Int -> CommandHandlerS m c a -> Text
$cshowtPrec :: forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Text
showbList :: [CommandHandlerS m c a] -> Builder
$cshowbList :: forall (m :: * -> *) c a. [CommandHandlerS m c a] -> Builder
showb :: CommandHandlerS m c a -> Builder
$cshowb :: forall (m :: * -> *) c a. CommandHandlerS m c a -> Builder
showbPrec :: Int -> CommandHandlerS m c a -> Builder
$cshowbPrec :: forall (m :: * -> *) c a. Int -> CommandHandlerS m c a -> Builder
TextShow) via TSG.FromGeneric (CommandHandlerS m c a)

instance Show (CommandHandler m c a) where
    showsPrec :: Int -> CommandHandler m c a -> ShowS
showsPrec Int
d CommandHandler{HashMap Text (Group m c a, AliasType)
groups :: HashMap Text (Group m c a, AliasType)
$sel:groups:CommandHandler :: forall (m :: * -> *) c a.
CommandHandler m c a -> HashMap Text (Group m c a, AliasType)
groups, HashMap Text (Command m c a, AliasType)
commands :: HashMap Text (Command m c a, AliasType)
$sel:commands:CommandHandler :: forall (m :: * -> *) c a.
CommandHandler m c a -> HashMap Text (Command m c a, AliasType)
commands} = Int -> CommandHandlerS m c a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (CommandHandlerS m c a -> ShowS) -> CommandHandlerS m c a -> ShowS
forall a b. (a -> b) -> a -> b
$ [(Text, (Group m c a, AliasType))]
-> [(Text, (Command m c a, AliasType))] -> CommandHandlerS m c a
forall (m :: * -> *) c a.
[(Text, (Group m c a, AliasType))]
-> [(Text, (Command m c a, AliasType))] -> CommandHandlerS m c a
CommandHandlerS (HashMap Text (Group m c a, AliasType)
-> [(Text, (Group m c a, AliasType))]
forall k v. HashMap k v -> [(k, v)]
LH.toList HashMap Text (Group m c a, AliasType)
groups) (HashMap Text (Command m c a, AliasType)
-> [(Text, (Command m c a, AliasType))]
forall k v. HashMap k v -> [(k, v)]
LH.toList HashMap Text (Command m c a, AliasType)
commands)

instance TextShow (CommandHandler m c a) where
    showbPrec :: Int -> CommandHandler m c a -> Builder
showbPrec Int
d CommandHandler{HashMap Text (Group m c a, AliasType)
groups :: HashMap Text (Group m c a, AliasType)
$sel:groups:CommandHandler :: forall (m :: * -> *) c a.
CommandHandler m c a -> HashMap Text (Group m c a, AliasType)
groups, HashMap Text (Command m c a, AliasType)
commands :: HashMap Text (Command m c a, AliasType)
$sel:commands:CommandHandler :: forall (m :: * -> *) c a.
CommandHandler m c a -> HashMap Text (Command m c a, AliasType)
commands} = Int -> CommandHandlerS m c a -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec Int
d (CommandHandlerS m c a -> Builder)
-> CommandHandlerS m c a -> Builder
forall a b. (a -> b) -> a -> b
$ [(Text, (Group m c a, AliasType))]
-> [(Text, (Command m c a, AliasType))] -> CommandHandlerS m c a
forall (m :: * -> *) c a.
[(Text, (Group m c a, AliasType))]
-> [(Text, (Command m c a, AliasType))] -> CommandHandlerS m c a
CommandHandlerS (HashMap Text (Group m c a, AliasType)
-> [(Text, (Group m c a, AliasType))]
forall k v. HashMap k v -> [(k, v)]
LH.toList HashMap Text (Group m c a, AliasType)
groups) (HashMap Text (Command m c a, AliasType)
-> [(Text, (Command m c a, AliasType))]
forall k v. HashMap k v -> [(k, v)]
LH.toList HashMap Text (Command m c a, AliasType)
commands)