-- |Special command parameters governing the aggregation of the entire (rest of the) argument list into one value.
module Ribosome.Host.Data.Args where

import Options.Applicative (Parser)

-- |When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the
-- command will be consumed and stored in this type.
--
-- The command will be declared with the @-nargs=*@ or @-nargs=+@ option.
--
-- See 'Ribosome.CommandHandler'.
newtype Args =
  Args { Args -> Text
unArgs :: Text }
  deriving stock (Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c== :: Args -> Args -> Bool
Eq, Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show)
  deriving newtype (String -> Args
(String -> Args) -> IsString Args
forall a. (String -> a) -> IsString a
fromString :: String -> Args
$cfromString :: String -> Args
IsString, Eq Args
Eq Args
-> (Args -> Args -> Ordering)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Args)
-> (Args -> Args -> Args)
-> Ord Args
Args -> Args -> Bool
Args -> Args -> Ordering
Args -> Args -> Args
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Args -> Args -> Args
$cmin :: Args -> Args -> Args
max :: Args -> Args -> Args
$cmax :: Args -> Args -> Args
>= :: Args -> Args -> Bool
$c>= :: Args -> Args -> Bool
> :: Args -> Args -> Bool
$c> :: Args -> Args -> Bool
<= :: Args -> Args -> Bool
$c<= :: Args -> Args -> Bool
< :: Args -> Args -> Bool
$c< :: Args -> Args -> Bool
compare :: Args -> Args -> Ordering
$ccompare :: Args -> Args -> Ordering
Ord)

-- |When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the
-- command will be consumed and stored in this type, as a list of whitespace separated tokens.
--
-- The command will be declared with the @-nargs=*@ or @-nargs=+@ option.
--
-- See 'Ribosome.CommandHandler'.
newtype ArgList =
  ArgList { ArgList -> [Text]
unArgList :: [Text] }
  deriving stock (ArgList -> ArgList -> Bool
(ArgList -> ArgList -> Bool)
-> (ArgList -> ArgList -> Bool) -> Eq ArgList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgList -> ArgList -> Bool
$c/= :: ArgList -> ArgList -> Bool
== :: ArgList -> ArgList -> Bool
$c== :: ArgList -> ArgList -> Bool
Eq, Int -> ArgList -> ShowS
[ArgList] -> ShowS
ArgList -> String
(Int -> ArgList -> ShowS)
-> (ArgList -> String) -> ([ArgList] -> ShowS) -> Show ArgList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgList] -> ShowS
$cshowList :: [ArgList] -> ShowS
show :: ArgList -> String
$cshow :: ArgList -> String
showsPrec :: Int -> ArgList -> ShowS
$cshowsPrec :: Int -> ArgList -> ShowS
Show)

-- |When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the
-- command will be consumed, decoded as JSON and stored in this type.
--
-- The command will be declared with the @-nargs=*@ or @-nargs=+@ option.
--
-- See 'Ribosome.CommandHandler'.
newtype JsonArgs a =
  JsonArgs { forall a. JsonArgs a -> a
unJsonArgs :: a }
  deriving stock (JsonArgs a -> JsonArgs a -> Bool
(JsonArgs a -> JsonArgs a -> Bool)
-> (JsonArgs a -> JsonArgs a -> Bool) -> Eq (JsonArgs a)
forall a. Eq a => JsonArgs a -> JsonArgs a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonArgs a -> JsonArgs a -> Bool
$c/= :: forall a. Eq a => JsonArgs a -> JsonArgs a -> Bool
== :: JsonArgs a -> JsonArgs a -> Bool
$c== :: forall a. Eq a => JsonArgs a -> JsonArgs a -> Bool
Eq, Int -> JsonArgs a -> ShowS
[JsonArgs a] -> ShowS
JsonArgs a -> String
(Int -> JsonArgs a -> ShowS)
-> (JsonArgs a -> String)
-> ([JsonArgs a] -> ShowS)
-> Show (JsonArgs a)
forall a. Show a => Int -> JsonArgs a -> ShowS
forall a. Show a => [JsonArgs a] -> ShowS
forall a. Show a => JsonArgs a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonArgs a] -> ShowS
$cshowList :: forall a. Show a => [JsonArgs a] -> ShowS
show :: JsonArgs a -> String
$cshow :: forall a. Show a => JsonArgs a -> String
showsPrec :: Int -> JsonArgs a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JsonArgs a -> ShowS
Show)

-- |When this type is used as the (last) parameter of a command handler function, all remaining tokens passed to the
-- command will be consumed, parsed via [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative)
-- and stored in this type.
--
-- The parser associated with @a@ must be defined as an instance of @'OptionParser' a@.
--
-- The command will be declared with the @-nargs=*@ or @-nargs=+@ option.
--
-- See 'Ribosome.CommandHandler'.
newtype Options a =
  Options a
  deriving stock (Options a -> Options a -> Bool
(Options a -> Options a -> Bool)
-> (Options a -> Options a -> Bool) -> Eq (Options a)
forall a. Eq a => Options a -> Options a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options a -> Options a -> Bool
$c/= :: forall a. Eq a => Options a -> Options a -> Bool
== :: Options a -> Options a -> Bool
$c== :: forall a. Eq a => Options a -> Options a -> Bool
Eq, Int -> Options a -> ShowS
[Options a] -> ShowS
Options a -> String
(Int -> Options a -> ShowS)
-> (Options a -> String)
-> ([Options a] -> ShowS)
-> Show (Options a)
forall a. Show a => Int -> Options a -> ShowS
forall a. Show a => [Options a] -> ShowS
forall a. Show a => Options a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options a] -> ShowS
$cshowList :: forall a. Show a => [Options a] -> ShowS
show :: Options a -> String
$cshow :: forall a. Show a => Options a -> String
showsPrec :: Int -> Options a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Options a -> ShowS
Show)

-- |The parser used when declaring command handlers with the special parameter @'Options' a@.
class OptionParser a where
  optionParser :: Parser a