-- | Something that can parse user input
module Calamity.Commands.Parser
    ( Parser(..)
    , Named
    , KleeneStarConcat
    , KleenePlusConcat
    , runCommandParser ) where

import           Calamity.Cache.Eff
import           Calamity.Commands.Context
import           Calamity.Types.Model.Channel  ( Channel, GuildChannel )
import           Calamity.Types.Model.Guild    ( Emoji, RawEmoji(..), Partial(PartialEmoji), Guild, Member, Role )
import           Calamity.Types.Model.User     ( User )
import           Calamity.Types.Snowflake
import           Calamity.Types.Partial

import           Control.Lens                  hiding ( Context )
import           Control.Monad
import           Control.Monad.Trans           ( lift )

import           Data.Char                     ( isSpace )
import           Data.Kind
import           Data.List.NonEmpty            ( NonEmpty(..) )
import           Data.Semigroup
import qualified Data.Text                     as S
import qualified Data.Text.Lazy                as L
import           Data.Typeable

import           GHC.Generics                  ( Generic )
import           GHC.TypeLits                  ( KnownSymbol, Symbol, symbolVal )

import qualified Polysemy                      as P
import qualified Polysemy.Error                as P
import qualified Polysemy.Reader               as P
import qualified Polysemy.State                as P

import           Text.Megaparsec               hiding ( parse )
import           Text.Megaparsec.Char
import           Text.Megaparsec.Error.Builder ( errFancy, fancy )
import Text.Megaparsec.Char.Lexer (float, decimal, signed)
import Numeric.Natural (Natural)

data SpannedError = SpannedError L.Text !Int !Int
  deriving ( Int -> SpannedError -> ShowS
[SpannedError] -> ShowS
SpannedError -> String
(Int -> SpannedError -> ShowS)
-> (SpannedError -> String)
-> ([SpannedError] -> ShowS)
-> Show SpannedError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpannedError] -> ShowS
$cshowList :: [SpannedError] -> ShowS
show :: SpannedError -> String
$cshow :: SpannedError -> String
showsPrec :: Int -> SpannedError -> ShowS
$cshowsPrec :: Int -> SpannedError -> ShowS
Show, SpannedError -> SpannedError -> Bool
(SpannedError -> SpannedError -> Bool)
-> (SpannedError -> SpannedError -> Bool) -> Eq SpannedError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpannedError -> SpannedError -> Bool
$c/= :: SpannedError -> SpannedError -> Bool
== :: SpannedError -> SpannedError -> Bool
$c== :: SpannedError -> SpannedError -> Bool
Eq, Eq SpannedError
Eq SpannedError =>
(SpannedError -> SpannedError -> Ordering)
-> (SpannedError -> SpannedError -> Bool)
-> (SpannedError -> SpannedError -> Bool)
-> (SpannedError -> SpannedError -> Bool)
-> (SpannedError -> SpannedError -> Bool)
-> (SpannedError -> SpannedError -> SpannedError)
-> (SpannedError -> SpannedError -> SpannedError)
-> Ord SpannedError
SpannedError -> SpannedError -> Bool
SpannedError -> SpannedError -> Ordering
SpannedError -> SpannedError -> SpannedError
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 :: SpannedError -> SpannedError -> SpannedError
$cmin :: SpannedError -> SpannedError -> SpannedError
max :: SpannedError -> SpannedError -> SpannedError
$cmax :: SpannedError -> SpannedError -> SpannedError
>= :: SpannedError -> SpannedError -> Bool
$c>= :: SpannedError -> SpannedError -> Bool
> :: SpannedError -> SpannedError -> Bool
$c> :: SpannedError -> SpannedError -> Bool
<= :: SpannedError -> SpannedError -> Bool
$c<= :: SpannedError -> SpannedError -> Bool
< :: SpannedError -> SpannedError -> Bool
$c< :: SpannedError -> SpannedError -> Bool
compare :: SpannedError -> SpannedError -> Ordering
$ccompare :: SpannedError -> SpannedError -> Ordering
$cp1Ord :: Eq SpannedError
Ord )

showTypeOf :: forall a. Typeable a => String
showTypeOf :: String
showTypeOf = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy a -> TypeRep) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> String) -> Proxy a -> String
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a

data ParserState = ParserState
  { ParserState -> Int
off :: Int
  , ParserState -> Text
msg :: L.Text
  }
  deriving ( Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> String
(Int -> ParserState -> ShowS)
-> (ParserState -> String)
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserState] -> ShowS
$cshowList :: [ParserState] -> ShowS
show :: ParserState -> String
$cshow :: ParserState -> String
showsPrec :: Int -> ParserState -> ShowS
$cshowsPrec :: Int -> ParserState -> ShowS
Show, (forall x. ParserState -> Rep ParserState x)
-> (forall x. Rep ParserState x -> ParserState)
-> Generic ParserState
forall x. Rep ParserState x -> ParserState
forall x. ParserState -> Rep ParserState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParserState x -> ParserState
$cfrom :: forall x. ParserState -> Rep ParserState x
Generic )

type ParserEffs r = P.State ParserState ': P.Error (S.Text, L.Text) ': P.Reader Context ': r
type ParserCtxE r = P.Reader Context ': r

runCommandParser :: Context -> L.Text -> P.Sem (ParserEffs r) a -> P.Sem r (Either (S.Text, L.Text) a)
runCommandParser :: Context
-> Text -> Sem (ParserEffs r) a -> Sem r (Either (Text, Text) a)
runCommandParser ctx :: Context
ctx t :: Text
t = Context
-> Sem (Reader Context : r) (Either (Text, Text) a)
-> Sem r (Either (Text, Text) a)
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Context
ctx (Sem (Reader Context : r) (Either (Text, Text) a)
 -> Sem r (Either (Text, Text) a))
-> (Sem (ParserEffs r) a
    -> Sem (Reader Context : r) (Either (Text, Text) a))
-> Sem (ParserEffs r) a
-> Sem r (Either (Text, Text) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Error (Text, Text) : Reader Context : r) a
-> Sem (Reader Context : r) (Either (Text, Text) a)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error (Text, Text) : Reader Context : r) a
 -> Sem (Reader Context : r) (Either (Text, Text) a))
-> (Sem (ParserEffs r) a
    -> Sem (Error (Text, Text) : Reader Context : r) a)
-> Sem (ParserEffs r) a
-> Sem (Reader Context : r) (Either (Text, Text) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState
-> Sem (ParserEffs r) a
-> Sem (Error (Text, Text) : Reader Context : r) a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
P.evalState (Int -> Text -> ParserState
ParserState 0 Text
t)

class Typeable a => Parser (a :: Type) r where
  type ParserResult a

  type ParserResult a = a

  parserName :: S.Text
  default parserName :: S.Text
  parserName = ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
S.pack (Typeable a => String
forall k (a :: k). Typeable a => String
showTypeOf @a)

  parse :: P.Sem (ParserEffs r) (ParserResult a)

-- | A named parameter, used to attach the name @s@ to a type in the command's
-- help output
data Named (s :: Symbol) (a :: Type)

instance (KnownSymbol s, Parser a r) => Parser (Named s a) r where
  type ParserResult (Named s a) = ParserResult a

  parserName :: Text
parserName = (String -> Text
S.pack (String -> Text) -> (Proxy s -> String) -> Proxy s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> Text) -> Proxy s -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Parser a r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @a @r

  parse :: Sem (ParserEffs r) (ParserResult (Named s a))
parse = ((Text, Text) -> (Text, Text))
-> Sem (ParserEffs r) (ParserResult a)
-> Sem (ParserEffs r) (ParserResult a)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
(e -> e) -> Sem r a -> Sem r a
mapE ((Text -> Identity Text) -> (Text, Text) -> Identity (Text, Text)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Text -> Identity Text) -> (Text, Text) -> Identity (Text, Text))
-> Text -> (Text, Text) -> (Text, Text)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Parser (Named s a) r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Named s a) @r) (Sem (ParserEffs r) (ParserResult a)
 -> Sem (ParserEffs r) (ParserResult (Named s a)))
-> Sem (ParserEffs r) (ParserResult a)
-> Sem (ParserEffs r) (ParserResult (Named s a))
forall a b. (a -> b) -> a -> b
$ Parser a r => Sem (ParserEffs r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @a @r

mapE :: P.Member (P.Error e) r => (e -> e) -> P.Sem r a -> P.Sem r a
mapE :: (e -> e) -> Sem r a -> Sem r a
mapE f :: e -> e
f m :: Sem r a
m = Sem r a -> (e -> Sem r a) -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
P.catch Sem r a
m (e -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (e -> Sem r a) -> (e -> e) -> e -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
f)

parseMP :: S.Text -> ParsecT SpannedError L.Text (P.Sem (ParserCtxE r)) a -> P.Sem (ParserEffs r) a
parseMP :: Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP n :: Text
n m :: ParsecT SpannedError Text (Sem (ParserCtxE r)) a
m = do
  ParserState
s <- Sem (ParserEffs r) ParserState
forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
Sem r s
P.get
  Either (ParseErrorBundle Text SpannedError) (a, Int)
res <- Sem
  (Error (Text, Text) : ParserCtxE r)
  (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise (Sem
   (Error (Text, Text) : ParserCtxE r)
   (Either (ParseErrorBundle Text SpannedError) (a, Int))
 -> Sem
      (ParserEffs r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> (Sem
      (ParserCtxE r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int))
    -> Sem
         (Error (Text, Text) : ParserCtxE r)
         (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
     (ParserCtxE r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (ParserCtxE r)
  (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (Error (Text, Text) : ParserCtxE r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise (Sem
   (ParserCtxE r)
   (Either (ParseErrorBundle Text SpannedError) (a, Int))
 -> Sem
      (ParserEffs r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
     (ParserCtxE r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (ParserCtxE r)) (a, Int)
-> String
-> Text
-> Sem
     (ParserCtxE r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (Int -> ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall s e (m :: * -> *).
(Stream s, Ord e) =>
Int -> ParsecT e s m ()
skipN (ParserState
s ParserState -> Getting Int ParserState Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "off" (Getting Int ParserState Int)
Getting Int ParserState Int
#off) ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (a, Int)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (a, Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (a, Int)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m (a, Int)
trackOffsets (ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
m)) "" (ParserState
s ParserState -> Getting Text ParserState Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "msg" (Getting Text ParserState Text)
Getting Text ParserState Text
#msg)
  case Either (ParseErrorBundle Text SpannedError) (a, Int)
res of
    Right (a :: a
a, offset :: Int
offset) -> do
      (ParserState -> ParserState) -> Sem (ParserEffs r) ()
forall s (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify (IsLabel "off" (ASetter ParserState ParserState Int Int)
ASetter ParserState ParserState Int Int
#off ASetter ParserState ParserState Int Int
-> Int -> ParserState -> ParserState
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
offset)
      a -> Sem (ParserEffs r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left s :: ParseErrorBundle Text SpannedError
s  -> (Text, Text) -> Sem (ParserEffs r) a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (Text
n, String -> Text
L.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text SpannedError -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text SpannedError
s)

instance Parser L.Text r where
  parse :: Sem (ParserEffs r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Text r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @L.Text) ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item

instance Parser S.Text r where
  parse :: Sem (ParserEffs r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Text r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @S.Text) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item)

instance Parser Integer r where
  parse :: Sem (ParserEffs r) (ParserResult Integer)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Integer
-> Sem (ParserEffs r) Integer
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Integer r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Integer) (ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Integer
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (ParserCtxE r)) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)

instance Parser Natural r where
  parse :: Sem (ParserEffs r) (ParserResult Natural)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Natural
-> Sem (ParserEffs r) Natural
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Natural r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Natural) ParsecT SpannedError Text (Sem (ParserCtxE r)) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal

instance Parser Int r where
  parse :: Sem (ParserEffs r) (ParserResult Int)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Int
-> Sem (ParserEffs r) Int
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Int r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Int) (ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Int
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (ParserCtxE r)) Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)

instance Parser Word r where
  parse :: Sem (ParserEffs r) (ParserResult Word)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Word
-> Sem (ParserEffs r) Word
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Word r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Word) ParsecT SpannedError Text (Sem (ParserCtxE r)) Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal

instance Parser Float r where
  parse :: Sem (ParserEffs r) (ParserResult Float)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Float
-> Sem (ParserEffs r) Float
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Float r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Float) (ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Float
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (ParserCtxE r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float)

instance Parser a r => Parser (Maybe a) r where
  type ParserResult (Maybe a) = Maybe (ParserResult a)

  parse :: Sem (ParserEffs r) (ParserResult (Maybe a))
parse = Sem (ParserEffs r) (Maybe (ParserResult a))
-> ((Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a)))
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
P.catch (ParserResult a -> Maybe (ParserResult a)
forall a. a -> Maybe a
Just (ParserResult a -> Maybe (ParserResult a))
-> Sem (ParserEffs r) (ParserResult a)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @a) (Sem (ParserEffs r) (Maybe (ParserResult a))
-> (Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a))
forall a b. a -> b -> a
const (Sem (ParserEffs r) (Maybe (ParserResult a))
 -> (Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a)))
-> Sem (ParserEffs r) (Maybe (ParserResult a))
-> (Text, Text)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall a b. (a -> b) -> a -> b
$ Maybe (ParserResult a)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParserResult a)
forall a. Maybe a
Nothing)


instance (Parser a r, Parser b r) => Parser (Either a b) r where
  type ParserResult (Either a b) = Either (ParserResult a) (ParserResult b)

  parse :: Sem (ParserEffs r) (ParserResult (Either a b))
parse = do
    Maybe (ParserResult a)
l <- Parser (Maybe a) r => Sem (ParserEffs r) (ParserResult (Maybe a))
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @(Maybe a) @r
    case Maybe (ParserResult a)
l of
      Just l' :: ParserResult a
l' -> Either (ParserResult a) (ParserResult b)
-> Sem (ParserEffs r) (Either (ParserResult a) (ParserResult b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserResult a -> Either (ParserResult a) (ParserResult b)
forall a b. a -> Either a b
Left ParserResult a
l')
      Nothing ->
        ParserResult b -> Either (ParserResult a) (ParserResult b)
forall a b. b -> Either a b
Right (ParserResult b -> Either (ParserResult a) (ParserResult b))
-> Sem (ParserEffs r) (ParserResult b)
-> Sem (ParserEffs r) (Either (ParserResult a) (ParserResult b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b r => Sem (ParserEffs r) (ParserResult b)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @b @r

instance Parser a r => Parser [a] r where
  type ParserResult [a] = [ParserResult a]

  parse :: Sem (ParserEffs r) (ParserResult [a])
parse = [ParserResult a] -> Sem (ParserEffs r) [ParserResult a]
go []
    where go :: [ParserResult a] -> P.Sem (ParserEffs r) [ParserResult a]
          go :: [ParserResult a] -> Sem (ParserEffs r) [ParserResult a]
go l :: [ParserResult a]
l = Sem (ParserEffs r) (Maybe (ParserResult a))
-> ((Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a)))
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
P.catch (ParserResult a -> Maybe (ParserResult a)
forall a. a -> Maybe a
Just (ParserResult a -> Maybe (ParserResult a))
-> Sem (ParserEffs r) (ParserResult a)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @a) (Sem (ParserEffs r) (Maybe (ParserResult a))
-> (Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a))
forall a b. a -> b -> a
const (Sem (ParserEffs r) (Maybe (ParserResult a))
 -> (Text, Text) -> Sem (ParserEffs r) (Maybe (ParserResult a)))
-> Sem (ParserEffs r) (Maybe (ParserResult a))
-> (Text, Text)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall a b. (a -> b) -> a -> b
$ Maybe (ParserResult a)
-> Sem (ParserEffs r) (Maybe (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParserResult a)
forall a. Maybe a
Nothing) Sem (ParserEffs r) (Maybe (ParserResult a))
-> (Maybe (ParserResult a) -> Sem (ParserEffs r) [ParserResult a])
-> Sem (ParserEffs r) [ParserResult a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just a :: ParserResult a
a -> [ParserResult a] -> Sem (ParserEffs r) [ParserResult a]
go ([ParserResult a] -> Sem (ParserEffs r) [ParserResult a])
-> [ParserResult a] -> Sem (ParserEffs r) [ParserResult a]
forall a b. (a -> b) -> a -> b
$ [ParserResult a]
l [ParserResult a] -> [ParserResult a] -> [ParserResult a]
forall a. [a] -> [a] -> [a]
++ [ParserResult a
a]
            Nothing -> [ParserResult a] -> Sem (ParserEffs r) [ParserResult a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ParserResult a]
l

instance (Parser a r, Typeable a) => Parser (NonEmpty a) r where
  type ParserResult (NonEmpty a) = NonEmpty (ParserResult a)

  parse :: Sem (ParserEffs r) (ParserResult (NonEmpty a))
parse = do
    ParserResult a
a <- forall (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @a
    [ParserResult a]
as <- forall (r :: [(* -> *) -> * -> *]).
Parser [a] r =>
Sem (ParserEffs r) (ParserResult [a])
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @[a]
    NonEmpty (ParserResult a)
-> Sem (ParserEffs r) (NonEmpty (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (ParserResult a)
 -> Sem (ParserEffs r) (NonEmpty (ParserResult a)))
-> NonEmpty (ParserResult a)
-> Sem (ParserEffs r) (NonEmpty (ParserResult a))
forall a b. (a -> b) -> a -> b
$ ParserResult a
a ParserResult a -> [ParserResult a] -> NonEmpty (ParserResult a)
forall a. a -> [a] -> NonEmpty a
:| [ParserResult a]
as

-- | A parser that consumes zero or more of @a@ then concatenates them together.
--
-- @'KleeneStarConcat' 'L.Text'@ Is therefore consumes all remaining input.
data KleeneStarConcat (a :: Type)

instance (Monoid (ParserResult a), Parser a r) => Parser (KleeneStarConcat a) r where
  type ParserResult (KleeneStarConcat a) = ParserResult a

  parse :: Sem (ParserEffs r) (ParserResult (KleeneStarConcat a))
parse = [ParserResult a] -> ParserResult a
forall a. Monoid a => [a] -> a
mconcat ([ParserResult a] -> ParserResult a)
-> Sem (ParserEffs r) [ParserResult a]
-> Sem (ParserEffs r) (ParserResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: [(* -> *) -> * -> *]).
Parser [a] r =>
Sem (ParserEffs r) (ParserResult [a])
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @[a]

instance {-# OVERLAPS #-}Parser (KleeneStarConcat L.Text) r where
  type ParserResult (KleeneStarConcat L.Text) = ParserResult L.Text

  -- consume rest on text just takes everything remaining
  parse :: Sem (ParserEffs r) (ParserResult (KleeneStarConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (KleeneStarConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(KleeneStarConcat L.Text)) ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
manySingle

instance {-# OVERLAPS #-}Parser (KleeneStarConcat S.Text) r where
  type ParserResult (KleeneStarConcat S.Text) = ParserResult S.Text

  -- consume rest on text just takes everything remaining
  parse :: Sem (ParserEffs r) (ParserResult (KleeneStarConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (KleeneStarConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(KleeneStarConcat S.Text)) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
manySingle)

-- | A parser that consumes one or more of @a@ then concatenates them together.
--
-- @'KleenePlusConcat' 'L.Text'@ Is therefore consumes all remaining input.
data KleenePlusConcat (a :: Type)

instance (Monoid (ParserResult a), Parser a r) => Parser (KleenePlusConcat a) r where
  type ParserResult (KleenePlusConcat a) = ParserResult a

  parse :: Sem (ParserEffs r) (ParserResult (KleenePlusConcat a))
parse = NonEmpty (ParserResult a) -> ParserResult a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (ParserResult a) -> ParserResult a)
-> Sem (ParserEffs r) (NonEmpty (ParserResult a))
-> Sem (ParserEffs r) (ParserResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: [(* -> *) -> * -> *]).
Parser (NonEmpty a) r =>
Sem (ParserEffs r) (ParserResult (NonEmpty a))
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @(NonEmpty a)

instance {-# OVERLAPS #-}Parser (KleenePlusConcat L.Text) r where
  type ParserResult (KleenePlusConcat L.Text) = ParserResult L.Text

  -- consume rest on text just takes everything remaining
  parse :: Sem (ParserEffs r) (ParserResult (KleenePlusConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (KleenePlusConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(KleenePlusConcat L.Text)) ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
someSingle

instance {-# OVERLAPS #-}Parser (KleenePlusConcat S.Text) r where
  type ParserResult (KleenePlusConcat S.Text) = ParserResult S.Text

  -- consume rest on text just takes everything remaining
  parse :: Sem (ParserEffs r) (ParserResult (KleenePlusConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> Sem (ParserEffs r) Text
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (KleenePlusConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(KleenePlusConcat S.Text)) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
someSingle)

instance Typeable (Snowflake a) => Parser (Snowflake a) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake a))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake a)
-> Sem (ParserEffs r) (Snowflake a)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser (Snowflake a) r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake a)) ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake a)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake

instance {-# OVERLAPS #-}Parser (Snowflake User) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake User))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> Sem (ParserEffs r) (Snowflake User)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (Snowflake User) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake User)) (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)

instance {-# OVERLAPS #-}Parser (Snowflake Member) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake Member))
parse = Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> Sem (ParserEffs r) (Snowflake Member)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (Snowflake Member) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake Member)) (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)

instance {-# OVERLAPS #-}Parser (Snowflake Channel) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake Channel))
parse = Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
-> Sem (ParserEffs r) (Snowflake Channel)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (Snowflake Channel) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake Channel)) (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "#") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Channel)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)

instance {-# OVERLAPS #-}Parser (Snowflake Role) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake Role))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
-> Sem (ParserEffs r) (Snowflake Role)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (Snowflake Role) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake Role)) (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@&") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Role)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)

instance {-# OVERLAPS #-}Parser (Snowflake Emoji) r where
  parse :: Sem (ParserEffs r) (ParserResult (Snowflake Emoji))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> Sem (ParserEffs r) (Snowflake Emoji)
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
Parser (Snowflake Emoji) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @(Snowflake Emoji)) (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
emoji ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)

-- mapParserMaybe :: Stream s => ParsecT SpannedError s m a -> Text -> (a -> Maybe b) -> ParsecT SpannedError s m b
-- mapParserMaybe m e f = do
--   offs <- getOffset
--   r <- f <$> m
--   offe <- getOffset
--   case r of
--     Just r' -> pure r'
--     _       -> parseError . errFancy offs . fancy . ErrorCustom $ SpannedError e offs offe

mapParserMaybeM :: (Monad m, Stream s) => ParsecT SpannedError s m a -> L.Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM :: ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM m :: ParsecT SpannedError s m a
m e :: Text
e f :: a -> m (Maybe b)
f = do
  Int
offs <- ParsecT SpannedError s m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Maybe b
r <- ParsecT SpannedError s m a
m ParsecT SpannedError s m a
-> (a -> ParsecT SpannedError s m (Maybe b))
-> ParsecT SpannedError s m (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe b) -> ParsecT SpannedError s m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe b) -> ParsecT SpannedError s m (Maybe b))
-> (a -> m (Maybe b)) -> a -> ParsecT SpannedError s m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe b)
f
  Int
offe <- ParsecT SpannedError s m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  case Maybe b
r of
    Just r' :: b
r' -> b -> ParsecT SpannedError s m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r'
    _       -> ParseError s SpannedError -> ParsecT SpannedError s m b
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError s SpannedError -> ParsecT SpannedError s m b)
-> (SpannedError -> ParseError s SpannedError)
-> SpannedError
-> ParsecT SpannedError s m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> EF SpannedError -> ParseError s SpannedError
forall e s. Int -> EF e -> ParseError s e
errFancy Int
offs (EF SpannedError -> ParseError s SpannedError)
-> (SpannedError -> EF SpannedError)
-> SpannedError
-> ParseError s SpannedError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy SpannedError -> EF SpannedError
forall e. ErrorFancy e -> EF e
fancy (ErrorFancy SpannedError -> EF SpannedError)
-> (SpannedError -> ErrorFancy SpannedError)
-> SpannedError
-> EF SpannedError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpannedError -> ErrorFancy SpannedError
forall e. e -> ErrorFancy e
ErrorCustom (SpannedError -> ParsecT SpannedError s m b)
-> SpannedError -> ParsecT SpannedError s m b
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> SpannedError
SpannedError Text
e Int
offs Int
offe

-- | Parser for members in the guild the command was invoked in, this only looks
-- in the cache. Use @'Snowflake' 'Member'@ and use
-- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.
instance Parser Member r where
  parse :: Sem (ParserEffs r) (ParserResult Member)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Member
-> Sem (ParserEffs r) Member
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser Member r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Member) (ParsecT SpannedError Text (Sem (ParserCtxE r)) Member
 -> Sem (ParserEffs r) (ParserResult Member))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Member
-> Sem (ParserEffs r) (ParserResult Member)
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> Text
-> (Snowflake Member -> Sem (ParserCtxE r) (Maybe Member))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Member
forall (m :: * -> *) s a b.
(Monad m, Stream s) =>
ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Member)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)
          "Couldn't find a Member with this id"
          (\mid :: Snowflake Member
mid -> do
              Context
ctx <- Sem (ParserCtxE r) Context
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask
              Maybe Member -> Sem (ParserCtxE r) (Maybe Member)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Member -> Sem (ParserCtxE r) (Maybe Member))
-> Maybe Member -> Sem (ParserCtxE r) (Maybe Member)
forall a b. (a -> b) -> a -> b
$ Context
ctx Context -> Getting (First Member) Context Member -> Maybe Member
forall s a. s -> Getting (First a) s a -> Maybe a
^? IsLabel
  "guild"
  ((Maybe Guild -> Const (First Member) (Maybe Guild))
   -> Context -> Const (First Member) Context)
(Maybe Guild -> Const (First Member) (Maybe Guild))
-> Context -> Const (First Member) Context
#guild ((Maybe Guild -> Const (First Member) (Maybe Guild))
 -> Context -> Const (First Member) Context)
-> ((Member -> Const (First Member) Member)
    -> Maybe Guild -> Const (First Member) (Maybe Guild))
-> Getting (First Member) Context Member
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Guild -> Const (First Member) Guild)
-> Maybe Guild -> Const (First Member) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First Member) Guild)
 -> Maybe Guild -> Const (First Member) (Maybe Guild))
-> ((Member -> Const (First Member) Member)
    -> Guild -> Const (First Member) Guild)
-> (Member -> Const (First Member) Member)
-> Maybe Guild
-> Const (First Member) (Maybe Guild)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "members"
  ((SnowflakeMap Member
    -> Const (First Member) (SnowflakeMap Member))
   -> Guild -> Const (First Member) Guild)
(SnowflakeMap Member -> Const (First Member) (SnowflakeMap Member))
-> Guild -> Const (First Member) Guild
#members ((SnowflakeMap Member
  -> Const (First Member) (SnowflakeMap Member))
 -> Guild -> Const (First Member) Guild)
-> ((Member -> Const (First Member) Member)
    -> SnowflakeMap Member
    -> Const (First Member) (SnowflakeMap Member))
-> (Member -> Const (First Member) Member)
-> Guild
-> Const (First Member) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Member)
-> Traversal' (SnowflakeMap Member) (IxValue (SnowflakeMap Member))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (SnowflakeMap Member)
Snowflake Member
mid)

-- | Parser for users, this only looks in the cache. Use @'Snowflake'
-- 'User'@ and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow
-- fetching from http.
instance P.Member CacheEff r => Parser User r where
  parse :: Sem (ParserEffs r) (ParserResult User)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) User
-> Sem (ParserEffs r) User
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (Parser User r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @User @r) (ParsecT SpannedError Text (Sem (ParserCtxE r)) User
 -> Sem (ParserEffs r) (ParserResult User))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) User
-> Sem (ParserEffs r) (ParserResult User)
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> Text
-> (Snowflake User -> Sem (ParserCtxE r) (Maybe User))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) User
forall (m :: * -> *) s a b.
(Monad m, Stream s) =>
ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake User)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)
          "Couldn't find a User with this id"
          Snowflake User -> Sem (ParserCtxE r) (Maybe User)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser

-- | Parser for channels in the guild the command was invoked in, this only
-- looks in the cache. Use @'Snowflake' 'Channel'@ and use
-- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.
instance Parser GuildChannel r where
  parse :: Sem (ParserEffs r) (ParserResult GuildChannel)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) GuildChannel
-> Sem (ParserEffs r) GuildChannel
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (Parser GuildChannel r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @GuildChannel @r) (ParsecT SpannedError Text (Sem (ParserCtxE r)) GuildChannel
 -> Sem (ParserEffs r) (ParserResult GuildChannel))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) GuildChannel
-> Sem (ParserEffs r) (ParserResult GuildChannel)
forall a b. (a -> b) -> a -> b
$ ParsecT
  SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
-> Text
-> (Snowflake GuildChannel
    -> Sem (ParserCtxE r) (Maybe GuildChannel))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) GuildChannel
forall (m :: * -> *) s a b.
(Monad m, Stream s) =>
ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM (ParsecT
  SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "#") ParsecT
  SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
-> ParsecT
     SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  SpannedError Text (Sem (ParserCtxE r)) (Snowflake GuildChannel)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)
          "Couldn't find a GuildChannel with this id"
          (\cid :: Snowflake GuildChannel
cid -> do
              Context
ctx <- Sem (ParserCtxE r) Context
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask
              Maybe GuildChannel -> Sem (ParserCtxE r) (Maybe GuildChannel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GuildChannel -> Sem (ParserCtxE r) (Maybe GuildChannel))
-> Maybe GuildChannel -> Sem (ParserCtxE r) (Maybe GuildChannel)
forall a b. (a -> b) -> a -> b
$ Context
ctx Context
-> Getting (First GuildChannel) Context GuildChannel
-> Maybe GuildChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^? IsLabel
  "guild"
  ((Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
   -> Context -> Const (First GuildChannel) Context)
(Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
-> Context -> Const (First GuildChannel) Context
#guild ((Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
 -> Context -> Const (First GuildChannel) Context)
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
    -> Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
-> Getting (First GuildChannel) Context GuildChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Guild -> Const (First GuildChannel) Guild)
-> Maybe Guild -> Const (First GuildChannel) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First GuildChannel) Guild)
 -> Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
    -> Guild -> Const (First GuildChannel) Guild)
-> (GuildChannel -> Const (First GuildChannel) GuildChannel)
-> Maybe Guild
-> Const (First GuildChannel) (Maybe Guild)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "channels"
  ((SnowflakeMap GuildChannel
    -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
   -> Guild -> Const (First GuildChannel) Guild)
(SnowflakeMap GuildChannel
 -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> Guild -> Const (First GuildChannel) Guild
#channels ((SnowflakeMap GuildChannel
  -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
 -> Guild -> Const (First GuildChannel) Guild)
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
    -> SnowflakeMap GuildChannel
    -> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> (GuildChannel -> Const (First GuildChannel) GuildChannel)
-> Guild
-> Const (First GuildChannel) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap GuildChannel)
-> Traversal'
     (SnowflakeMap GuildChannel) (IxValue (SnowflakeMap GuildChannel))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (SnowflakeMap GuildChannel)
Snowflake GuildChannel
cid)

-- | Parser for guilds, this only looks in the cache. Use @'Snowflake' 'Guild'@
-- and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching
-- from http.
instance P.Member CacheEff r => Parser Guild r where
  parse :: Sem (ParserEffs r) (ParserResult Guild)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Guild
-> Sem (ParserEffs r) Guild
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (Parser Guild r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Guild @r) (ParsecT SpannedError Text (Sem (ParserCtxE r)) Guild
 -> Sem (ParserEffs r) (ParserResult Guild))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Guild
-> Sem (ParserEffs r) (ParserResult Guild)
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
-> Text
-> (Snowflake Guild -> Sem (ParserCtxE r) (Maybe Guild))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Guild
forall (m :: * -> *) s a b.
(Monad m, Stream s) =>
ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "#") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Guild)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)
          "Couldn't find a Guild with this id"
          Snowflake Guild -> Sem (ParserCtxE r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild

-- | Parser for emojis in the guild the command was invoked in, this only
-- looks in the cache. Use @'Snowflake' 'Emoji'@ and use
-- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.
instance Parser Emoji r where
  parse :: Sem (ParserEffs r) (ParserResult Emoji)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Emoji
-> Sem (ParserEffs r) Emoji
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (Parser Emoji r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @Emoji @r) (ParsecT SpannedError Text (Sem (ParserCtxE r)) Emoji
 -> Sem (ParserEffs r) (ParserResult Emoji))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Emoji
-> Sem (ParserEffs r) (ParserResult Emoji)
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> Text
-> (Snowflake Emoji -> Sem (ParserCtxE r) (Maybe Emoji))
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Emoji
forall (m :: * -> *) s a b.
(Monad m, Stream s) =>
ParsecT SpannedError s m a
-> Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b
mapParserMaybeM (ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "#") ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Snowflake Emoji)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake)
          "Couldn't find an Emoji with this id"
          (\eid :: Snowflake Emoji
eid -> do
              Context
ctx <- Sem (ParserCtxE r) Context
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask
              Maybe Emoji -> Sem (ParserCtxE r) (Maybe Emoji)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Emoji -> Sem (ParserCtxE r) (Maybe Emoji))
-> Maybe Emoji -> Sem (ParserCtxE r) (Maybe Emoji)
forall a b. (a -> b) -> a -> b
$ Context
ctx Context -> Getting (First Emoji) Context Emoji -> Maybe Emoji
forall s a. s -> Getting (First a) s a -> Maybe a
^? IsLabel
  "guild"
  ((Maybe Guild -> Const (First Emoji) (Maybe Guild))
   -> Context -> Const (First Emoji) Context)
(Maybe Guild -> Const (First Emoji) (Maybe Guild))
-> Context -> Const (First Emoji) Context
#guild ((Maybe Guild -> Const (First Emoji) (Maybe Guild))
 -> Context -> Const (First Emoji) Context)
-> ((Emoji -> Const (First Emoji) Emoji)
    -> Maybe Guild -> Const (First Emoji) (Maybe Guild))
-> Getting (First Emoji) Context Emoji
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Guild -> Const (First Emoji) Guild)
-> Maybe Guild -> Const (First Emoji) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First Emoji) Guild)
 -> Maybe Guild -> Const (First Emoji) (Maybe Guild))
-> ((Emoji -> Const (First Emoji) Emoji)
    -> Guild -> Const (First Emoji) Guild)
-> (Emoji -> Const (First Emoji) Emoji)
-> Maybe Guild
-> Const (First Emoji) (Maybe Guild)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "emojis"
  ((SnowflakeMap Emoji -> Const (First Emoji) (SnowflakeMap Emoji))
   -> Guild -> Const (First Emoji) Guild)
(SnowflakeMap Emoji -> Const (First Emoji) (SnowflakeMap Emoji))
-> Guild -> Const (First Emoji) Guild
#emojis ((SnowflakeMap Emoji -> Const (First Emoji) (SnowflakeMap Emoji))
 -> Guild -> Const (First Emoji) Guild)
-> ((Emoji -> Const (First Emoji) Emoji)
    -> SnowflakeMap Emoji -> Const (First Emoji) (SnowflakeMap Emoji))
-> (Emoji -> Const (First Emoji) Emoji)
-> Guild
-> Const (First Emoji) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Emoji)
-> Traversal' (SnowflakeMap Emoji) (IxValue (SnowflakeMap Emoji))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (SnowflakeMap Emoji)
Snowflake Emoji
eid)

instance Parser RawEmoji r where
  parse :: Sem (ParserEffs r) (ParserResult RawEmoji)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
-> Sem (ParserEffs r) RawEmoji
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser RawEmoji r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @RawEmoji) (ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
forall (f :: * -> *) e. MonadParsec e Text f => f RawEmoji
parseCustomEmoji ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> RawEmoji
UnicodeEmoji (Text -> RawEmoji)
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) RawEmoji
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Int
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
takeP (String -> Maybe String
forall a. a -> Maybe a
Just "A unicode emoji") 1))
    where parseCustomEmoji :: f RawEmoji
parseCustomEmoji = Partial Emoji -> RawEmoji
CustomEmoji (Partial Emoji -> RawEmoji) -> f (Partial Emoji) -> f RawEmoji
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Partial Emoji)
forall e (m :: * -> *). MonadParsec e Text m => m (Partial Emoji)
partialEmoji

instance (Parser a r, Parser b r) => Parser (a, b) r where
  type ParserResult (a, b) = (ParserResult a, ParserResult b)

  parse :: Sem (ParserEffs r) (ParserResult (a, b))
parse = do
    ParserResult a
a <- forall (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @a
    ParserResult b
b <- forall (r :: [(* -> *) -> * -> *]).
Parser b r =>
Sem (ParserEffs r) (ParserResult b)
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @b
    (ParserResult a, ParserResult b)
-> Sem (ParserEffs r) (ParserResult a, ParserResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserResult a
a, ParserResult b
b)

instance Parser () r where
  parse :: Sem (ParserEffs r) (ParserResult ())
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
-> Sem (ParserEffs r) ()
forall (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE r)) a
-> Sem (ParserEffs r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). Parser () r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @()) ParsecT SpannedError Text (Sem (ParserCtxE r)) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

instance ShowErrorComponent SpannedError where
  showErrorComponent :: SpannedError -> String
showErrorComponent (SpannedError t :: Text
t _ _) = Text -> String
L.unpack Text
t
  errorComponentLen :: SpannedError -> Int
errorComponentLen (SpannedError _ s :: Int
s e :: Int
e) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s

skipN :: (Stream s, Ord e) => Int -> ParsecT e s m ()
skipN :: Int -> ParsecT e s m ()
skipN n :: Int
n = ParsecT e s m (Tokens s) -> ParsecT e s m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT e s m (Tokens s) -> ParsecT e s m ())
-> ParsecT e s m (Tokens s) -> ParsecT e s m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> Int -> ParsecT e s m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
takeP Maybe String
forall a. Maybe a
Nothing Int
n

ping :: MonadParsec e L.Text m => L.Text -> m (Snowflake a)
ping :: Text -> m (Snowflake a)
ping c :: Text
c = Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ("<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c) m Text -> m (Maybe Text) -> m (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "!") m (Maybe Text) -> m (Snowflake a) -> m (Snowflake a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Snowflake a)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake m (Snowflake a) -> m Text -> m (Snowflake a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ">"

ping' :: MonadParsec e L.Text m => m () -> m (Snowflake a)
ping' :: m () -> m (Snowflake a)
ping' m :: m ()
m = Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "<" m Text -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
m m () -> m (Snowflake a) -> m (Snowflake a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Snowflake a)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake m (Snowflake a) -> m Text -> m (Snowflake a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ">"

snowflake :: MonadParsec e L.Text m => m (Snowflake a)
snowflake :: m (Snowflake a)
snowflake = (Word64 -> Snowflake a
forall t. Word64 -> Snowflake t
Snowflake (Word64 -> Snowflake a)
-> (String -> Word64) -> String -> Snowflake a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word64
forall a. Read a => String -> a
read) (String -> Snowflake a) -> m String -> m (Snowflake a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

partialEmoji :: MonadParsec e L.Text m => m (Partial Emoji)
partialEmoji :: m (Partial Emoji)
partialEmoji = do
  m (Maybe Text) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "<" m Text -> m (Maybe Text) -> m (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "a"))
  Text
name <-  m Text -> m Text -> m Text -> m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ":") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ":") (Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just "Emoji name") ((Token Text -> Bool) -> m Text) -> (Token Text -> Bool) -> m Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':'))
  Snowflake Emoji
id <- m (Snowflake Emoji)
forall e (m :: * -> *) a. MonadParsec e Text m => m (Snowflake a)
snowflake
  m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ">"
  Partial Emoji -> m (Partial Emoji)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake Emoji -> Text -> Partial Emoji
PartialEmoji Snowflake Emoji
id Text
name)

emoji :: MonadParsec e L.Text m => m (Snowflake a)
emoji :: m (Snowflake a)
emoji = m () -> m (Snowflake a)
forall e (m :: * -> *) a.
MonadParsec e Text m =>
m () -> m (Snowflake a)
ping' (m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "a") m (Maybe Text) -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Text -> m Text -> m () -> m ()
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ":") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk ":") (m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing ((Token Text -> Bool) -> m Text) -> (Token Text -> Bool) -> m Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':')))

trackOffsets :: MonadParsec e s m => m a -> m (a, Int)
trackOffsets :: m a -> m (a, Int)
trackOffsets m :: m a
m = do
  Int
offs <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  a
a <- m a
m
  Int
offe <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (a, Int) -> m (a, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Int
offe Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offs)

item :: MonadParsec e L.Text m => m L.Text
item :: m Text
item = m Text -> m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
quotedString m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Text
forall s e (m :: * -> *).
(Token s ~ Char, MonadParsec e s m) =>
m (Tokens s)
someNonWS

manySingle :: MonadParsec e s m => m (Tokens s)
manySingle :: m (Tokens s)
manySingle = Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just "Any character") (Bool -> Token s -> Bool
forall a b. a -> b -> a
const Bool
True)

someSingle :: MonadParsec e s m => m (Tokens s)
someSingle :: m (Tokens s)
someSingle = Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just "any character") (Bool -> Token s -> Bool
forall a b. a -> b -> a
const Bool
True)

quotedString :: MonadParsec e L.Text m => m L.Text
quotedString :: m Text
quotedString = m Text -> m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Text -> m Text -> m Text -> m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "'") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "'") (Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just "any character") ((Token Text -> Bool) -> m Text) -> (Token Text -> Bool) -> m Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''))) m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               m Text -> m Text -> m Text -> m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "\"") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk "\"") (Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just "any character") ((Token Text -> Bool) -> m Text) -> (Token Text -> Bool) -> m Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"'))

-- manyNonWS :: (Token s ~ Char, MonadParsec e s m) => m (Tokens s)
-- manyNonWS = takeWhileP (Just "Any Non-Whitespace") (not . isSpace)

someNonWS :: (Token s ~ Char, MonadParsec e s m) => m (Tokens s)
someNonWS :: m (Tokens s)
someNonWS = Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just "any non-whitespace") (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)