-- | Something that can parse user input
module CalamityCommands.Parser (
  ParameterParser (..),
  Named,
  KleeneStarConcat,
  KleenePlusConcat,

  -- * Parameter parsing utilities
  ParserEffs,
  runCommandParser,
  ParserState (..),
  parseMP,
  SpannedError (..),
) where

import CalamityCommands.ParameterInfo

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

import Data.Char (isSpace)
import Data.Generics.Labels ()
import Data.Kind
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe)
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 Numeric.Natural (Natural)
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (decimal, float, signed)

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)

{- | The current state of the parser, used so that the entire remaining input is
 available.

 This is used instead of just concatenating parsers to allow for more
 flexibility, for example, this could be used to construct flag-style parsers
 that parse a parameter from anywhere in the input message.
-}
data ParserState = ParserState
  { -- | The current offset, or where the next parser should start parsing at
    ParserState -> Int
off :: Int
  , -- | The input message ot parse
    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 c r =
  ( P.State ParserState
      ': P.Error (S.Text, L.Text) -- (failing parser name, error reason)
        ': P.Reader c -- the current parser state
          ': r -- context
  )

-- | Run a command parser, @ctx@ is the context, @t@ is the text input
runCommandParser :: c -> L.Text -> P.Sem (ParserEffs c r) a -> P.Sem r (Either (S.Text, L.Text) a)
runCommandParser :: c
-> Text -> Sem (ParserEffs c r) a -> Sem r (Either (Text, Text) a)
runCommandParser c
ctx Text
t = c
-> Sem (Reader c : 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 c
ctx (Sem (Reader c : r) (Either (Text, Text) a)
 -> Sem r (Either (Text, Text) a))
-> (Sem (ParserEffs c r) a
    -> Sem (Reader c : r) (Either (Text, Text) a))
-> Sem (ParserEffs c r) a
-> Sem r (Either (Text, Text) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Error (Text, Text) : Reader c : r) a
-> Sem (Reader c : 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 c : r) a
 -> Sem (Reader c : r) (Either (Text, Text) a))
-> (Sem (ParserEffs c r) a
    -> Sem (Error (Text, Text) : Reader c : r) a)
-> Sem (ParserEffs c r) a
-> Sem (Reader c : r) (Either (Text, Text) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserState
-> Sem (ParserEffs c r) a
-> Sem (Error (Text, Text) : Reader c : r) a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
P.evalState (Int -> Text -> ParserState
ParserState Int
0 Text
t)

{- | A typeclass for things that can be parsed as parameters to commands.

 Any type that is an instance of ParamerParser can be used in the type level
 parameter @ps@ of 'CalamityCommands.Dsl.command',
 'CalamityCommands.CommandUtils.buildCommand', etc.
-}
class Typeable a => ParameterParser (a :: Type) c r where
  type ParserResult a

  type ParserResult a = a

  parameterInfo :: ParameterInfo
  default parameterInfo :: ParameterInfo
  parameterInfo = Maybe Text -> TypeRep -> Text -> ParameterInfo
ParameterInfo Maybe Text
forall a. Maybe a
Nothing (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a) (ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r)

  parameterDescription :: S.Text

  parse :: P.Sem (ParserEffs c 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, ParameterParser a c r) => ParameterParser (Named s a) c r where
  type ParserResult (Named s a) = ParserResult a

  parameterInfo :: ParameterInfo
parameterInfo =
    let ParameterInfo Maybe Text
_ TypeRep
type_ Text
typeDescription = ParameterParser a c r => ParameterInfo
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
ParameterInfo
parameterInfo @a @c @r
     in Maybe Text -> TypeRep -> Text -> ParameterInfo
ParameterInfo (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Proxy s -> Text) -> Proxy s -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Maybe Text) -> Proxy s -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s) TypeRep
type_ Text
typeDescription

  parameterDescription :: Text
parameterDescription = ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r

  parse :: Sem (ParserEffs c r) (ParserResult (Named s a))
parse = ((Text, Text) -> (Text, Text))
-> Sem (ParserEffs c r) (ParserResult a)
-> Sem (ParserEffs c 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
.~ ParameterParser (Named s a) c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @(Named s a) @c @r) (Sem (ParserEffs c r) (ParserResult a)
 -> Sem (ParserEffs c r) (ParserResult a))
-> Sem (ParserEffs c r) (ParserResult a)
-> Sem (ParserEffs c r) (ParserResult a)
forall a b. (a -> b) -> a -> b
$ ParameterParser a c r => Sem (ParserEffs c r) (ParserResult a)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a @c @r

parserName :: forall a c r. ParameterParser a c r => S.Text
parserName :: Text
parserName =
  let ParameterInfo (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
name) TypeRep
type_ Text
_ = ParameterParser a c r => ParameterInfo
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
ParameterInfo
parameterInfo @a @c @r
   in Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
S.pack (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
type_)

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

{- | Parse a paremeter using a MegaParsec parser.

 On failure this constructs a nice-looking megaparsec error for the failed parameter.
-}
parseMP ::
  -- | The name of the parser
  S.Text ->
  -- | The megaparsec parser
  ParsecT SpannedError L.Text (P.Sem (P.Reader c ': r)) a ->
  P.Sem (ParserEffs c r) a
parseMP :: Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP Text
n ParsecT SpannedError Text (Sem (Reader c : r)) a
m = do
  ParserState
s <- Sem (ParserEffs c 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) : Reader c : r)
  (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs c r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise (Sem
   (Error (Text, Text) : Reader c : r)
   (Either (ParseErrorBundle Text SpannedError) (a, Int))
 -> Sem
      (ParserEffs c r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> (Sem
      (Reader c : r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int))
    -> Sem
         (Error (Text, Text) : Reader c : r)
         (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
     (Reader c : r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs c r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Reader c : r)
  (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (Error (Text, Text) : Reader c : r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise (Sem
   (Reader c : r)
   (Either (ParseErrorBundle Text SpannedError) (a, Int))
 -> Sem
      (ParserEffs c r)
      (Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
     (Reader c : r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
     (ParserEffs c r)
     (Either (ParseErrorBundle Text SpannedError) (a, Int))
forall a b. (a -> b) -> a -> b
$ ParsecT SpannedError Text (Sem (Reader c : r)) (a, Int)
-> String
-> Text
-> Sem
     (Reader c : 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 (Reader c : 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 (Reader c : r)) ()
-> ParsecT SpannedError Text (Sem (Reader c : r)) (a, Int)
-> ParsecT SpannedError Text (Sem (Reader c : r)) (a, Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> ParsecT SpannedError Text (Sem (Reader c : r)) (a, Int)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m (a, Int)
trackOffsets (ParsecT SpannedError Text (Sem (Reader c : r)) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT SpannedError Text (Sem (Reader c : r)) ()
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (Reader c : r)) a
m)) String
"" (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, Int
offset) -> do
      (ParserState -> ParserState) -> Sem (ParserEffs c 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 c r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left ParseErrorBundle Text SpannedError
s -> (Text, Text) -> Sem (ParserEffs c 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.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text SpannedError
s)

instance ParameterParser L.Text c r where
  parse :: Sem (ParserEffs c r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP (forall c (r :: [(* -> *) -> * -> *]).
ParameterParser Text c r =>
Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @L.Text) ParsecT SpannedError Text (Sem (Reader c : r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item
  parameterDescription :: Text
parameterDescription = Text
"word or quoted string"

instance ParameterParser S.Text c r where
  parse :: Sem (ParserEffs c r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP (forall c (r :: [(* -> *) -> * -> *]).
ParameterParser Text c r =>
Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @S.Text) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (Reader c : r)) Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (Reader c : r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item)
  parameterDescription :: Text
parameterDescription = Text
"word or quoted string"

instance ParameterParser Integer c r where
  parse :: Sem (ParserEffs c r) (ParserResult Integer)
parse = Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Integer
-> Sem (ParserEffs c r) Integer
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP (forall c (r :: [(* -> *) -> * -> *]).
ParameterParser Integer c r =>
Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @Integer) (ParsecT SpannedError Text (Sem (Reader c : r)) ()
-> ParsecT SpannedError Text (Sem (Reader c : r)) Integer
-> ParsecT SpannedError Text (Sem (Reader c : 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 (Reader c : r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (Reader c : r)) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
  parameterDescription :: Text
parameterDescription = Text
"number"

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

instance ParameterParser Int c r where
  parse :: Sem (ParserEffs c r) (ParserResult Int)
parse = Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Int
-> Sem (ParserEffs c r) Int
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP (forall c (r :: [(* -> *) -> * -> *]).
ParameterParser Int c r =>
Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @Int) (ParsecT SpannedError Text (Sem (Reader c : r)) ()
-> ParsecT SpannedError Text (Sem (Reader c : r)) Int
-> ParsecT SpannedError Text (Sem (Reader c : 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 (Reader c : r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (Reader c : r)) Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
  parameterDescription :: Text
parameterDescription = Text
"number"

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

instance ParameterParser Float c r where
  parse :: Sem (ParserEffs c r) (ParserResult Float)
parse = Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) Float
-> Sem (ParserEffs c r) Float
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (Reader c : r)) a
-> Sem (ParserEffs c r) a
parseMP (forall c (r :: [(* -> *) -> * -> *]).
ParameterParser Float c r =>
Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parserName @Float) (ParsecT SpannedError Text (Sem (Reader c : r)) ()
-> ParsecT SpannedError Text (Sem (Reader c : r)) Float
-> ParsecT SpannedError Text (Sem (Reader c : 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 (Reader c : r)) ()
forall a. Monoid a => a
mempty (ParsecT SpannedError Text (Sem (Reader c : r)) Float
-> ParsecT SpannedError Text (Sem (Reader c : r)) Float
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT SpannedError Text (Sem (Reader c : r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float ParsecT SpannedError Text (Sem (Reader c : r)) Float
-> ParsecT SpannedError Text (Sem (Reader c : r)) Float
-> ParsecT SpannedError Text (Sem (Reader c : r)) Float
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (Reader c : r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal))
  parameterDescription :: Text
parameterDescription = Text
"number"

instance ParameterParser a c r => ParameterParser (Maybe a) c r where
  type ParserResult (Maybe a) = Maybe (ParserResult a)

  parse :: Sem (ParserEffs c r) (ParserResult (Maybe a))
parse = Sem (ParserEffs c r) (Maybe (ParserResult a))
-> ((Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a)))
-> Sem (ParserEffs c 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 c r) (ParserResult a)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a) (Sem (ParserEffs c r) (Maybe (ParserResult a))
-> (Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall a b. a -> b -> a
const (Sem (ParserEffs c r) (Maybe (ParserResult a))
 -> (Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a)))
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
-> (Text, Text)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall a b. (a -> b) -> a -> b
$ Maybe (ParserResult a)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParserResult a)
forall a. Maybe a
Nothing)
  parameterDescription :: Text
parameterDescription = Text
"optional " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r

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

  parse :: Sem (ParserEffs c r) (ParserResult (Either a b))
parse = do
    Maybe (ParserResult a)
l <- ParameterParser (Maybe a) c r =>
Sem (ParserEffs c r) (ParserResult (Maybe a))
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @(Maybe a) @c @r
    case Maybe (ParserResult a)
l of
      Just ParserResult a
l' -> Either (ParserResult a) (ParserResult b)
-> Sem (ParserEffs c 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')
      Maybe (ParserResult a)
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 c r) (ParserResult b)
-> Sem (ParserEffs c r) (Either (ParserResult a) (ParserResult b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterParser b c r => Sem (ParserEffs c r) (ParserResult b)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @b @c @r
  parameterDescription :: Text
parameterDescription = Text
"either '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' or '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser b c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @b @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

instance ParameterParser a c r => ParameterParser [a] c r where
  type ParserResult [a] = [ParserResult a]

  parse :: Sem (ParserEffs c r) (ParserResult [a])
parse = [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
go []
   where
    go :: [ParserResult a] -> P.Sem (ParserEffs c r) [ParserResult a]
    go :: [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
go [ParserResult a]
l =
      Sem (ParserEffs c r) (Maybe (ParserResult a))
-> ((Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a)))
-> Sem (ParserEffs c 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 c r) (ParserResult a)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a) (Sem (ParserEffs c r) (Maybe (ParserResult a))
-> (Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall a b. a -> b -> a
const (Sem (ParserEffs c r) (Maybe (ParserResult a))
 -> (Text, Text) -> Sem (ParserEffs c r) (Maybe (ParserResult a)))
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
-> (Text, Text)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall a b. (a -> b) -> a -> b
$ Maybe (ParserResult a)
-> Sem (ParserEffs c r) (Maybe (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParserResult a)
forall a. Maybe a
Nothing) Sem (ParserEffs c r) (Maybe (ParserResult a))
-> (Maybe (ParserResult a)
    -> Sem (ParserEffs c r) [ParserResult a])
-> Sem (ParserEffs c r) [ParserResult a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just ParserResult a
a -> [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
go ([ParserResult a] -> Sem (ParserEffs c r) [ParserResult a])
-> [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
forall a b. (a -> b) -> a -> b
$ [ParserResult a]
l [ParserResult a] -> [ParserResult a] -> [ParserResult a]
forall a. Semigroup a => a -> a -> a
<> [ParserResult a
a]
        Maybe (ParserResult a)
Nothing -> [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ParserResult a]
l

  parameterDescription :: Text
parameterDescription = Text
"zero or more '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

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

  parse :: Sem (ParserEffs c r) (ParserResult (NonEmpty a))
parse = do
    ParserResult a
a <- forall c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a
    [ParserResult a]
as <- forall c (r :: [(* -> *) -> * -> *]).
ParameterParser [a] c r =>
Sem (ParserEffs c r) (ParserResult [a])
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @[a]
    NonEmpty (ParserResult a)
-> Sem (ParserEffs c r) (NonEmpty (ParserResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (ParserResult a)
 -> Sem (ParserEffs c r) (NonEmpty (ParserResult a)))
-> NonEmpty (ParserResult a)
-> Sem (ParserEffs c 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

  parameterDescription :: Text
parameterDescription = Text
"one or more '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

{- | A parser that consumes zero or more of @a@ then concatenates them together.

 @'KleeneStarConcat' 'L.Text'@ therefore consumes all remaining input.
-}
data KleeneStarConcat (a :: Type)

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

  parse :: Sem (ParserEffs c r) (ParserResult (KleeneStarConcat a))
parse = [ParserResult a] -> ParserResult a
forall a. Monoid a => [a] -> a
mconcat ([ParserResult a] -> ParserResult a)
-> Sem (ParserEffs c r) [ParserResult a]
-> Sem (ParserEffs c r) (ParserResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (r :: [(* -> *) -> * -> *]).
ParameterParser [a] c r =>
Sem (ParserEffs c r) (ParserResult [a])
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @[a]
  parameterDescription :: Text
parameterDescription = Text
"zero or more '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

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

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

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

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

{- | A parser that consumes one or more of @a@ then concatenates them together.

 @'KleenePlusConcat' 'L.Text'@ therefore consumes all remaining input.
-}
data KleenePlusConcat (a :: Type)

instance (Semigroup (ParserResult a), ParameterParser a c r) => ParameterParser (KleenePlusConcat a) c r where
  type ParserResult (KleenePlusConcat a) = ParserResult a

  parse :: Sem (ParserEffs c 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 c r) (NonEmpty (ParserResult a))
-> Sem (ParserEffs c r) (ParserResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (r :: [(* -> *) -> * -> *]).
ParameterParser (NonEmpty a) c r =>
Sem (ParserEffs c r) (ParserResult (NonEmpty a))
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @(NonEmpty a)
  parameterDescription :: Text
parameterDescription = Text
"one or more '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

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

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

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

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

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

  parse :: Sem (ParserEffs c r) (ParserResult (a, b))
parse = do
    ParserResult a
a <- forall c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a
    ParserResult b
b <- forall c (r :: [(* -> *) -> * -> *]).
ParameterParser b c r =>
Sem (ParserEffs c r) (ParserResult b)
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @b
    (ParserResult a, ParserResult b)
-> Sem (ParserEffs c r) (ParserResult a, ParserResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserResult a
a, ParserResult b
b)
  parameterDescription :: Text
parameterDescription = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser a c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @a @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' then '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterParser b c r => Text
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
Text
parameterDescription @b @c @r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

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

instance ShowErrorComponent SpannedError where
  showErrorComponent :: SpannedError -> String
showErrorComponent (SpannedError Text
t Int
_ Int
_) = Text -> String
L.unpack Text
t
  errorComponentLen :: SpannedError -> Int
errorComponentLen (SpannedError Text
_ Int
s Int
e) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
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 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

trackOffsets :: MonadParsec e s m => m a -> m (a, Int)
trackOffsets :: m a -> m (a, Int)
trackOffsets 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 String
"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 String
"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
"'") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"'") (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 String
"any character") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')))
    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
"\"") (Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\"") (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 String
"any character") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))

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