packages feed

calamity-commands-0.4.1.0: CalamityCommands/Command.hs

{-# 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
  { names :: NonEmpty T.Text
  , parent :: Maybe (Group m c a)
  , hidden :: Bool
  -- ^ If this command is hidden
  , checks :: [Check m c]
  -- ^ A list of checks that must pass for this command to be invoked
  , params :: [ParameterInfo]
  -- ^ A list of parameter metadata
  , 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
  { names :: NonEmpty T.Text
  , params :: [ParameterInfo]
  , parent :: Maybe T.Text
  , checks :: [T.Text]
  , hidden :: Bool
  }
  deriving (Show)

instance Show (Command m c a) where
  showsPrec d Command {names, params, parent, checks, hidden} =
    showsPrec d $
      CommandS
        names
        params
        (NE.head <$> parent ^? _Just % #names)
        (checks ^.. traversed % #name)
        hidden

$(deriveTextShow ''CommandS)

instance TextShow.TextShow (Command m c a) where
  showbPrec d Command {names, params, parent, checks, hidden} =
    TextShow.showbPrec d $
      CommandS
        names
        params
        (NE.head <$> parent ^? _Just % #names)
        (checks ^.. traversed % #name)
        hidden