-- | Something that can parse user input
module Calamity.Commands.Parser
    ( Parser(..)
    , KleeneConcat ) where

import           Calamity.Cache.Eff
import           Calamity.Commands.Context
import           Calamity.Internal.Utils
import           Calamity.Types.Model.Channel ( Channel )
import           Calamity.Types.Model.Guild   ( Emoji, Member, Role )
import           Calamity.Types.Model.User    ( User )
import           Calamity.Types.Snowflake

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

import           Data.Bifunctor
import           Data.Char                    ( isSpace )
import           Data.Kind
import           Data.List.NonEmpty           ( NonEmpty, nonEmpty )
import qualified Data.Text.Lazy               as L
import           Data.Text.Lazy               ( Text )
import           Data.Typeable

import qualified Polysemy                     as P

import           Text.Megaparsec              hiding ( parse )
import           Text.Megaparsec.Char

import           TextShow

class Parser (a :: Type) r where
  type ParserResult a

  type ParserResult a = a

  parse :: (Context, Text) -> P.Sem r (Either Text (ParserResult a, Text))

instance Parser Text r where
  parse :: (Context, Text) -> Sem r (Either Text (ParserResult Text, Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Text, Text)
-> Sem r (Either Text (ParserResult Text, Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Text, Text)
 -> Sem r (Either Text (ParserResult Text, Text)))
-> Either Text (Text, Text)
-> Sem r (Either Text (ParserResult Text, Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text Text -> Text -> Either Text (Text, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError Parsec Text Text Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item Text
msg

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

  parse :: (Context, Text) -> Sem r (Either Text (ParserResult [a], Text))
parse (ctx :: Context
ctx, msg :: Text
msg) = ([ParserResult a], Text) -> Either Text ([ParserResult a], Text)
forall a b. b -> Either a b
Right (([ParserResult a], Text) -> Either Text ([ParserResult a], Text))
-> Sem r ([ParserResult a], Text)
-> Sem r (Either Text ([ParserResult a], Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [ParserResult a] -> Sem r ([ParserResult a], Text)
go Text
msg []
    where
      go :: Text -> [ParserResult a] -> P.Sem r ([ParserResult a], Text)
      go :: Text -> [ParserResult a] -> Sem r ([ParserResult a], Text)
go t :: Text
t l :: [ParserResult a]
l = (Context, Text) -> Sem r (Either Text (ParserResult a, Text))
forall a (r :: EffectRow).
Parser a r =>
(Context, Text) -> Sem r (Either Text (ParserResult a, Text))
parse @a (Context
ctx, Text
t) Sem r (Either Text (ParserResult a, Text))
-> (Either Text (ParserResult a, Text)
    -> Sem r ([ParserResult a], Text))
-> Sem r ([ParserResult a], Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left _        -> ([ParserResult a], Text) -> Sem r ([ParserResult a], Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ParserResult a]
l, Text
t)
        Right (v :: ParserResult a
v, t' :: Text
t') -> Text -> [ParserResult a] -> Sem r ([ParserResult a], Text)
go Text
t' ([ParserResult a]
l [ParserResult a] -> [ParserResult a] -> [ParserResult a]
forall a. Semigroup a => a -> a -> a
<> [ParserResult a
v])

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

  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (NonEmpty a), Text))
parse (ctx :: Context
ctx, msg :: Text
msg) = (Context, Text) -> Sem r (Either Text (ParserResult [a], Text))
forall a (r :: EffectRow).
Parser a r =>
(Context, Text) -> Sem r (Either Text (ParserResult a, Text))
parse @[a] (Context
ctx, Text
msg)
    Sem r (Either Text ([ParserResult a], Text))
-> (Either Text ([ParserResult a], Text)
    -> Either Text (NonEmpty (ParserResult a), Text))
-> Sem r (Either Text (NonEmpty (ParserResult a), Text))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\case
           Right (res :: [ParserResult a]
res, rest :: Text
rest) -> case [ParserResult a] -> Maybe (NonEmpty (ParserResult a))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [ParserResult a]
res of
             Just res' :: NonEmpty (ParserResult a)
res' -> (NonEmpty (ParserResult a), Text)
-> Either Text (NonEmpty (ParserResult a), Text)
forall a b. b -> Either a b
Right (NonEmpty (ParserResult a)
res', Text
rest)
             Nothing   -> Text -> Either Text (NonEmpty (ParserResult a), Text)
forall a b. a -> Either a b
Left ("Couldn't parse at least one of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
L.pack (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a))
           Left e :: Text
e            -> Text -> Either Text (NonEmpty (ParserResult a), Text)
forall a b. a -> Either a b
Left Text
e)

data KleeneConcat a

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

  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (KleeneConcat a), Text))
parse (ctx :: Context
ctx, msg :: Text
msg) = (([ParserResult a] -> ParserResult a)
-> ([ParserResult a], Text) -> (ParserResult a, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [ParserResult a] -> ParserResult a
forall a. Monoid a => [a] -> a
mconcat) (([ParserResult a], Text) -> (ParserResult a, Text))
-> Sem r (Either Text ([ParserResult a], Text))
-> Sem r (Either Text (ParserResult a, Text))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> (Context, Text) -> Sem r (Either Text (ParserResult [a], Text))
forall a (r :: EffectRow).
Parser a r =>
(Context, Text) -> Sem r (Either Text (ParserResult a, Text))
parse @[a] (Context
ctx, Text
msg)

instance {-# OVERLAPS #-}Parser (KleeneConcat Text) r where
  type ParserResult (KleeneConcat Text) = ParserResult Text

  -- consume rest on text just takes everything remaining
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (KleeneConcat Text), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Text, Text)
-> Sem r (Either Text (ParserResult (KleeneConcat Text), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Text, Text)
 -> Sem r (Either Text (ParserResult (KleeneConcat Text), Text)))
-> Either Text (Text, Text)
-> Sem r (Either Text (ParserResult (KleeneConcat Text), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text Text -> Text -> Either Text (Text, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError (Parsec Text Text Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
someSingle) Text
msg

instance Parser (Snowflake a) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake a), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake a, Text)
-> Sem r (Either Text (ParserResult (Snowflake a), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake a, Text)
 -> Sem r (Either Text (ParserResult (Snowflake a), Text)))
-> Either Text (Snowflake a, Text)
-> Sem r (Either Text (ParserResult (Snowflake a), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text (Snowflake a)
-> Text -> Either Text (Snowflake a, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError Parsec Text Text (Snowflake a)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake Text
msg

instance {-# OVERLAPS #-}Parser (Snowflake User) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake User), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake User, Text)
-> Sem r (Either Text (ParserResult (Snowflake User), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake User, Text)
 -> Sem r (Either Text (ParserResult (Snowflake User), Text)))
-> Either Text (Snowflake User, Text)
-> Sem r (Either Text (ParserResult (Snowflake User), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text (Snowflake User)
-> Text -> Either Text (Snowflake User, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError (Parsec Text Text (Snowflake User)
-> Parsec Text Text (Snowflake User)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parsec Text Text (Snowflake User)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") Parsec Text Text (Snowflake User)
-> Parsec Text Text (Snowflake User)
-> Parsec Text Text (Snowflake User)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Text Text (Snowflake User)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake) Text
msg

instance {-# OVERLAPS #-}Parser (Snowflake Member) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake Member), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake Member, Text)
-> Sem r (Either Text (ParserResult (Snowflake Member), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake Member, Text)
 -> Sem r (Either Text (ParserResult (Snowflake Member), Text)))
-> Either Text (Snowflake Member, Text)
-> Sem r (Either Text (ParserResult (Snowflake Member), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text (Snowflake Member)
-> Text -> Either Text (Snowflake Member, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError (Parsec Text Text (Snowflake Member)
-> Parsec Text Text (Snowflake Member)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parsec Text Text (Snowflake Member)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@") Parsec Text Text (Snowflake Member)
-> Parsec Text Text (Snowflake Member)
-> Parsec Text Text (Snowflake Member)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Text Text (Snowflake Member)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake) Text
msg

instance {-# OVERLAPS #-}Parser (Snowflake Channel) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake Channel), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake Channel, Text)
-> Sem r (Either Text (ParserResult (Snowflake Channel), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake Channel, Text)
 -> Sem r (Either Text (ParserResult (Snowflake Channel), Text)))
-> Either Text (Snowflake Channel, Text)
-> Sem r (Either Text (ParserResult (Snowflake Channel), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text (Snowflake Channel)
-> Text -> Either Text (Snowflake Channel, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError (Parsec Text Text (Snowflake Channel)
-> Parsec Text Text (Snowflake Channel)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parsec Text Text (Snowflake Channel)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "#") Parsec Text Text (Snowflake Channel)
-> Parsec Text Text (Snowflake Channel)
-> Parsec Text Text (Snowflake Channel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Text Text (Snowflake Channel)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake) Text
msg

instance {-# OVERLAPS #-}Parser (Snowflake Role) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake Role), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake Role, Text)
-> Sem r (Either Text (ParserResult (Snowflake Role), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake Role, Text)
 -> Sem r (Either Text (ParserResult (Snowflake Role), Text)))
-> Either Text (Snowflake Role, Text)
-> Sem r (Either Text (ParserResult (Snowflake Role), Text))
forall a b. (a -> b) -> a -> b
$ Parsec Text Text (Snowflake Role)
-> Text -> Either Text (Snowflake Role, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError (Parsec Text Text (Snowflake Role)
-> Parsec Text Text (Snowflake Role)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parsec Text Text (Snowflake Role)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
Text -> m (Snowflake a)
ping "@&") Parsec Text Text (Snowflake Role)
-> Parsec Text Text (Snowflake Role)
-> Parsec Text Text (Snowflake Role)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Text Text (Snowflake Role)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake) Text
msg

instance {-# OVERLAPS #-}Parser (Snowflake Emoji) r where
  parse :: (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake Emoji), Text))
parse (_ctx :: Context
_ctx, msg :: Text
msg) = Either Text (Snowflake Emoji, Text)
-> Sem r (Either Text (ParserResult (Snowflake Emoji), Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Snowflake Emoji, Text)
 -> Sem r (Either Text (ParserResult (Snowflake Emoji), Text)))
-> Either Text (Snowflake Emoji, Text)
-> Sem r (Either Text (ParserResult (Snowflake Emoji), Text))
forall a b. (a -> b) -> a -> b
$Parsec Text Text (Snowflake Emoji)
-> Text -> Either Text (Snowflake Emoji, Text)
forall a. Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError
    (Parsec Text Text (Snowflake Emoji)
-> Parsec Text Text (Snowflake Emoji)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Text Text (Snowflake Emoji)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
emoji Parsec Text Text (Snowflake Emoji)
-> Parsec Text Text (Snowflake Emoji)
-> Parsec Text Text (Snowflake Emoji)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Text Text (Snowflake Emoji)
forall k e (m :: * -> *) (a :: k).
MonadParsec e Text m =>
m (Snowflake a)
snowflake) Text
msg


instance Parser Member r where
  parse :: (Context, Text) -> Sem r (Either Text (ParserResult Member, Text))
parse (ctx :: Context
ctx, msg :: Text
msg) = (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake Member), Text))
forall a (r :: EffectRow).
Parser a r =>
(Context, Text) -> Sem r (Either Text (ParserResult a, Text))
parse @(Snowflake Member) (Context
ctx, Text
msg)
    Sem r (Either Text (Snowflake Member, Text))
-> (Either Text (Snowflake Member, Text)
    -> Either Text (Member, Text))
-> Sem r (Either Text (Member, Text))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Either Text (Snowflake Member, Text)
-> ((Snowflake Member, Text) -> Either Text (Member, Text))
-> Either Text (Member, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(mid :: Snowflake Member
mid, rest :: Text
rest) -> case 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 of
           Just member :: Member
member -> (Member, Text) -> Either Text (Member, Text)
forall a b. b -> Either a b
Right (Member
member, Text
rest)
           _           -> Text -> Either Text (Member, Text)
forall a b. a -> Either a b
Left ("Couldn't find member with id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Snowflake Member -> Text
forall a. TextShow a => a -> Text
showtl Snowflake Member
mid))

instance P.Member CacheEff r => Parser User r where
  parse :: (Context, Text) -> Sem r (Either Text (ParserResult User, Text))
parse (ctx :: Context
ctx, msg :: Text
msg) = do
    Either Text (Snowflake User, Text)
r <- (Context, Text)
-> Sem r (Either Text (ParserResult (Snowflake User), Text))
forall a (r :: EffectRow).
Parser a r =>
(Context, Text) -> Sem r (Either Text (ParserResult a, Text))
parse @(Snowflake User) (Context
ctx, Text
msg)
    case Either Text (Snowflake User, Text)
r of
      Right (uid :: Snowflake User
uid, rest :: Text
rest) -> Snowflake User -> Sem r (Maybe User)
forall (r :: EffectRow).
MemberWithError CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser Snowflake User
uid Sem r (Maybe User)
-> (Maybe User -> Either Text (User, Text))
-> Sem r (Either Text (User, Text))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Just member :: User
member -> (User, Text) -> Either Text (User, Text)
forall a b. b -> Either a b
Right (User
member, Text
rest)
        _           -> Text -> Either Text (User, Text)
forall a b. a -> Either a b
Left ("Couldn't find user with id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Snowflake User -> Text
forall a. TextShow a => a -> Text
showtl Snowflake User
uid)
      Left e :: Text
e            -> Either Text (User, Text) -> Sem r (Either Text (User, Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (User, Text) -> Sem r (Either Text (User, Text)))
-> Either Text (User, Text) -> Sem r (Either Text (User, Text))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (User, Text)
forall a b. a -> Either a b
Left Text
e

instance ShowErrorComponent Text where
  showErrorComponent :: Text -> String
showErrorComponent = Text -> String
L.unpack
  errorComponentLen :: Text -> Int
errorComponentLen = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
L.length

runParserToCommandError :: Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError :: Parsec Text Text a -> Text -> Either Text (a, Text)
runParserToCommandError m :: Parsec Text Text a
m t :: Text
t = case Parsec Text Text (a, Text)
-> String -> Text -> Either (ParseErrorBundle Text Text) (a, Text)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT Text Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Text Text Identity ()
-> Parsec Text Text (a, Text) -> Parsec Text Text (a, Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Text Text a -> ParsecT Text Text Identity (a, Tokens Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (a, Tokens s)
andRemaining Parsec Text Text a
m) "" Text
t of
  Right a :: (a, Text)
a -> (a, Text) -> Either Text (a, Text)
forall a b. b -> Either a b
Right (a, Text)
a
  Left s :: ParseErrorBundle Text Text
s  -> Text -> Either Text (a, Text)
forall a b. a -> Either a b
Left (Text -> Either Text (a, Text))
-> (ParseErrorBundle Text Text -> Text)
-> ParseErrorBundle Text Text
-> Either Text (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
L.pack (String -> Text)
-> (ParseErrorBundle Text Text -> String)
-> ParseErrorBundle Text Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Text -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (ParseErrorBundle Text Text -> Either Text (a, Text))
-> ParseErrorBundle Text Text -> Either Text (a, Text)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Text
s

ping :: MonadParsec e Text m => 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 k e (m :: * -> *) (a :: k).
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 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 k e (m :: * -> *) (a :: k).
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 Text m => m (Snowflake a)
snowflake :: m (Snowflake a)
snowflake = (Word64 -> Snowflake a
forall k (t :: k). 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

emoji :: MonadParsec e Text m => m (Snowflake a)
emoji :: m (Snowflake a)
emoji = m () -> m (Snowflake a)
forall k e (m :: * -> *) (a :: k).
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
== ':')))

andRemaining :: MonadParsec e s m => m a -> m (a, Tokens s)
andRemaining :: m a -> m (a, Tokens s)
andRemaining m :: m a
m = do
  a
a <- m a
m
  Tokens s
rest <- m (Tokens s)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
manySingle
  (a, Tokens s) -> m (a, Tokens s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Tokens s
rest)

item :: MonadParsec e Text m => m 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 Text m => m 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 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
== '\''))) 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 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
== '"'))

-- 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)