{-# LANGUAGE TemplateHaskell #-}

-- | Commands and stuff
module CalamityCommands.Command (Command (..)) where

import CalamityCommands.Check
import CalamityCommands.Error
import CalamityCommands.Group
import CalamityCommands.ParameterInfo
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Text as T
import Optics
import TextShow qualified
import TextShow.TH (deriveTextShow)

-- | A command, paremeterised over its context
data Command (m :: Type -> Type) (c :: Type) (a :: Type) = forall p.
  Command
  { forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names :: NonEmpty T.Text
  , forall (m :: * -> *) c a. Command m c a -> Maybe (Group m c a)
parent :: Maybe (Group m c a)
  , forall (m :: * -> *) c a. Command m c a -> Bool
hidden :: Bool
  -- ^ If this command is hidden
  , forall (m :: * -> *) c a. Command m c a -> [Check m c]
checks :: [Check m c]
  -- ^ A list of checks that must pass for this command to be invoked
  , forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params :: [ParameterInfo]
  -- ^ A list of parameter metadata
  , forall (m :: * -> *) c a. Command m c a -> c -> Text
help :: c -> T.Text
  -- ^ A function producing the \'help\' for the command.
  , ()
parser :: c -> m (Either CommandError p)
  -- ^ A function that parses the context for the command, producing the input
  -- @a@ for the command.
  , ()
callback :: (c, p) -> m (Either T.Text a)
  -- ^ A function that given the context and the input (@p@) of the command,
  -- performs the action of the command.
  }

$(makeFieldLabelsNoPrefix ''Command)

data CommandS = CommandS
  { CommandS -> NonEmpty Text
names :: NonEmpty T.Text
  , CommandS -> [ParameterInfo]
params :: [ParameterInfo]
  , CommandS -> Maybe Text
parent :: Maybe T.Text
  , CommandS -> [Text]
checks :: [T.Text]
  , CommandS -> Bool
hidden :: Bool
  }
  deriving (Int -> CommandS -> ShowS
[CommandS] -> ShowS
CommandS -> String
(Int -> CommandS -> ShowS)
-> (CommandS -> String) -> ([CommandS] -> ShowS) -> Show CommandS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandS -> ShowS
showsPrec :: Int -> CommandS -> ShowS
$cshow :: CommandS -> String
show :: CommandS -> String
$cshowList :: [CommandS] -> ShowS
showList :: [CommandS] -> ShowS
Show)

instance Show (Command m c a) where
  showsPrec :: Int -> Command m c a -> ShowS
showsPrec Int
d Command {NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names :: NonEmpty Text
names, [ParameterInfo]
$sel:params:Command :: forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params :: [ParameterInfo]
params, Maybe (Group m c a)
$sel:parent:Command :: forall (m :: * -> *) c a. Command m c a -> Maybe (Group m c a)
parent :: Maybe (Group m c a)
parent, [Check m c]
$sel:checks:Command :: forall (m :: * -> *) c a. Command m c a -> [Check m c]
checks :: [Check m c]
checks, Bool
$sel:hidden:Command :: forall (m :: * -> *) c a. Command m c a -> Bool
hidden :: Bool
hidden} =
    Int -> CommandS -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (CommandS -> ShowS) -> CommandS -> ShowS
forall a b. (a -> b) -> a -> b
$
      NonEmpty Text
-> [ParameterInfo] -> Maybe Text -> [Text] -> Bool -> CommandS
CommandS
        NonEmpty Text
names
        [ParameterInfo]
params
        (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head (NonEmpty Text -> Text) -> Maybe (NonEmpty Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Group m c a)
parent Maybe (Group m c a)
-> Optic'
     An_AffineTraversal NoIx (Maybe (Group m c a)) (NonEmpty Text)
-> Maybe (NonEmpty Text)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Prism
  (Maybe (Group m c a))
  (Maybe (Group m c a))
  (Group m c a)
  (Group m c a)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Prism
  (Maybe (Group m c a))
  (Maybe (Group m c a))
  (Group m c a)
  (Group m c a)
-> Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text)
-> Optic'
     An_AffineTraversal NoIx (Maybe (Group m c a)) (NonEmpty Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Group m c a)
  (Group m c a)
  (NonEmpty Text)
  (NonEmpty Text)
#names)
        ([Check m c]
checks [Check m c] -> Optic' A_Traversal NoIx [Check m c] Text -> [Text]
forall k s (is :: IxList) a.
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Check m c] [Check m c] (Check m c) (Check m c)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Check m c] [Check m c] (Check m c) (Check m c)
-> Optic A_Lens NoIx (Check m c) (Check m c) Text Text
-> Optic' A_Traversal NoIx [Check m c] Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (Check m c) (Check m c) Text Text
#name)
        Bool
hidden

$(deriveTextShow ''CommandS)

instance TextShow.TextShow (Command m c a) where
  showbPrec :: Int -> Command m c a -> Builder
showbPrec Int
d Command {NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names :: NonEmpty Text
names, [ParameterInfo]
$sel:params:Command :: forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params :: [ParameterInfo]
params, Maybe (Group m c a)
$sel:parent:Command :: forall (m :: * -> *) c a. Command m c a -> Maybe (Group m c a)
parent :: Maybe (Group m c a)
parent, [Check m c]
$sel:checks:Command :: forall (m :: * -> *) c a. Command m c a -> [Check m c]
checks :: [Check m c]
checks, Bool
$sel:hidden:Command :: forall (m :: * -> *) c a. Command m c a -> Bool
hidden :: Bool
hidden} =
    Int -> CommandS -> Builder
forall a. TextShow a => Int -> a -> Builder
TextShow.showbPrec Int
d (CommandS -> Builder) -> CommandS -> Builder
forall a b. (a -> b) -> a -> b
$
      NonEmpty Text
-> [ParameterInfo] -> Maybe Text -> [Text] -> Bool -> CommandS
CommandS
        NonEmpty Text
names
        [ParameterInfo]
params
        (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head (NonEmpty Text -> Text) -> Maybe (NonEmpty Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Group m c a)
parent Maybe (Group m c a)
-> Optic'
     An_AffineTraversal NoIx (Maybe (Group m c a)) (NonEmpty Text)
-> Maybe (NonEmpty Text)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Prism
  (Maybe (Group m c a))
  (Maybe (Group m c a))
  (Group m c a)
  (Group m c a)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Prism
  (Maybe (Group m c a))
  (Maybe (Group m c a))
  (Group m c a)
  (Group m c a)
-> Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text)
-> Optic'
     An_AffineTraversal NoIx (Maybe (Group m c a)) (NonEmpty Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Group m c a)
  (Group m c a)
  (NonEmpty Text)
  (NonEmpty Text)
#names)
        ([Check m c]
checks [Check m c] -> Optic' A_Traversal NoIx [Check m c] Text -> [Text]
forall k s (is :: IxList) a.
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Check m c] [Check m c] (Check m c) (Check m c)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Check m c] [Check m c] (Check m c) (Check m c)
-> Optic A_Lens NoIx (Check m c) (Check m c) Text Text
-> Optic' A_Traversal NoIx [Check m c] Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (Check m c) (Check m c) Text Text
#name)
        Bool
hidden