module CalamityCommands.Parser (
ParameterParser (..),
Named,
KleeneStarConcat,
KleenePlusConcat,
ParserEffs,
runCommandParser,
ParserState (..),
parseMP,
) where
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.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)
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 c r =
( P.State ParserState
': P.Error (S.Text, L.Text)
': P.Reader c
': r
)
type ParserCtxE c r = P.Reader c ': r
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 ctx :: c
ctx t :: 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 0 Text
t)
class Typeable a => ParameterParser (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 c r) (ParserResult a)
data Named (s :: Symbol) (a :: Type)
instance (KnownSymbol s, ParameterParser a r) => ParameterParser (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
<> ParameterParser a r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @a @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) r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @(Named s a) @r) (Sem (ParserEffs c r) (ParserResult a)
-> Sem (ParserEffs c r) (ParserResult (Named s a)))
-> Sem (ParserEffs c r) (ParserResult a)
-> Sem (ParserEffs c r) (ParserResult (Named s a))
forall a b. (a -> b) -> a -> b
$ forall c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c 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 c r)) a -> P.Sem (ParserEffs c r) a
parseMP :: Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP n :: Text
n m :: ParsecT SpannedError Text (Sem (ParserCtxE 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) : ParserCtxE 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) : ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
(ParserEffs c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> (Sem
(ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
(Error (Text, Text) : ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
(ParserCtxE 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
(ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
(Error (Text, Text) : ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise (Sem
(ParserCtxE c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int))
-> Sem
(ParserEffs c r)
(Either (ParseErrorBundle Text SpannedError) (a, Int)))
-> Sem
(ParserCtxE 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 (ParserCtxE c r)) (a, Int)
-> String
-> Text
-> Sem
(ParserCtxE 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 (ParserCtxE 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 (ParserCtxE c r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) (a, Int)
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) (a, Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) (a, Int)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m (a, Int)
trackOffsets (ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SpannedError Text (Sem (ParserCtxE c 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 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 s :: 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 r where
parse :: Sem (ParserEffs c r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser Text r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @L.Text) ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item
instance ParameterParser S.Text r where
parse :: Sem (ParserEffs c r) (ParserResult Text)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser Text r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @S.Text) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e (m :: * -> *). MonadParsec e Text m => m Text
item)
instance ParameterParser Integer r where
parse :: Sem (ParserEffs c r) (ParserResult Integer)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Integer
-> Sem (ParserEffs c r) Integer
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser Integer r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @Integer) (ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Integer
-> ParsecT SpannedError Text (Sem (ParserCtxE 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 (ParserCtxE c r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (ParserCtxE c r)) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
instance ParameterParser Natural r where
parse :: Sem (ParserEffs c r) (ParserResult Natural)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Natural
-> Sem (ParserEffs c r) Natural
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser Natural r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @Natural) ParsecT SpannedError Text (Sem (ParserCtxE c r)) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
instance ParameterParser Int r where
parse :: Sem (ParserEffs c r) (ParserResult Int)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Int
-> Sem (ParserEffs c r) Int
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser Int r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @Int) (ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Int
-> ParsecT SpannedError Text (Sem (ParserCtxE 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 (ParserCtxE c r)) ()
forall a. Monoid a => a
mempty ParsecT SpannedError Text (Sem (ParserCtxE c r)) Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
instance ParameterParser Word r where
parse :: Sem (ParserEffs c r) (ParserResult Word)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Word
-> Sem (ParserEffs c r) Word
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser Word r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @Word) ParsecT SpannedError Text (Sem (ParserCtxE c r)) Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
instance ParameterParser Float r where
parse :: Sem (ParserEffs c r) (ParserResult Float)
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
-> Sem (ParserEffs c r) Float
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser Float r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @Float) (ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
-> ParsecT SpannedError Text (Sem (ParserCtxE 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 (ParserCtxE c r)) ()
forall a. Monoid a => a
mempty (ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal))
instance ParameterParser a r => ParameterParser (Maybe a) 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 (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a 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)
instance (ParameterParser a r, ParameterParser b r) => ParameterParser (Either a b) 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 <- forall c.
ParameterParser (Maybe a) r =>
Sem (ParserEffs c r) (ParserResult (Maybe a))
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c 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 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')
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
<$> forall c.
ParameterParser b r =>
Sem (ParserEffs c r) (ParserResult b)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
parse @b @r
instance ParameterParser a r => ParameterParser [a] r where
type ParserResult [a] = [ParserResult a]
parse :: Sem (ParserEffs c r) (ParserResult [a])
parse = [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
forall c. [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 l :: [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 (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a 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 a :: ParserResult a
a -> [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
forall c. [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]
Nothing -> [ParserResult a] -> Sem (ParserEffs c r) [ParserResult a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ParserResult a]
l
instance (ParameterParser a r, Typeable a) => ParameterParser (NonEmpty a) r where
type ParserResult (NonEmpty a) = NonEmpty (ParserResult a)
parse :: Sem (ParserEffs c r) (ParserResult (NonEmpty a))
parse = do
ParserResult a
a <- forall (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a
[ParserResult a]
as <- forall (r :: [(* -> *) -> * -> *]) c.
ParameterParser [a] r =>
Sem (ParserEffs c r) (ParserResult [a])
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a 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
data KleeneStarConcat (a :: Type)
instance (Monoid (ParserResult a), ParameterParser a r) => ParameterParser (KleeneStarConcat a) 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 (r :: [(* -> *) -> * -> *]) c.
ParameterParser [a] r =>
Sem (ParserEffs c r) (ParserResult [a])
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
parse @[a]
instance {-# OVERLAPS #-} ParameterParser (KleeneStarConcat L.Text) r where
type ParserResult (KleeneStarConcat L.Text) = ParserResult L.Text
parse :: Sem (ParserEffs c r) (ParserResult (KleeneStarConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser (KleeneStarConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @(KleeneStarConcat L.Text)) ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
manySingle
instance {-# OVERLAPS #-} ParameterParser (KleeneStarConcat S.Text) r where
type ParserResult (KleeneStarConcat S.Text) = ParserResult S.Text
parse :: Sem (ParserEffs c r) (ParserResult (KleeneStarConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser (KleeneStarConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @(KleeneStarConcat S.Text)) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
manySingle)
data KleenePlusConcat (a :: Type)
instance (Semigroup (ParserResult a), ParameterParser a r) => ParameterParser (KleenePlusConcat a) 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 (r :: [(* -> *) -> * -> *]) c.
ParameterParser (NonEmpty a) r =>
Sem (ParserEffs c r) (ParserResult (NonEmpty a))
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
parse @(NonEmpty a)
instance {-# OVERLAPS #-} ParameterParser (KleenePlusConcat L.Text) r where
type ParserResult (KleenePlusConcat L.Text) = ParserResult L.Text
parse :: Sem (ParserEffs c r) (ParserResult (KleenePlusConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser (KleenePlusConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @(KleenePlusConcat L.Text)) ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
someSingle
instance {-# OVERLAPS #-} ParameterParser (KleenePlusConcat S.Text) r where
type ParserResult (KleenePlusConcat S.Text) = ParserResult S.Text
parse :: Sem (ParserEffs c r) (ParserResult (KleenePlusConcat Text))
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> Sem (ParserEffs c r) Text
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]).
ParameterParser (KleenePlusConcat Text) r =>
Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @(KleenePlusConcat S.Text)) (Text -> Text
L.toStrict (Text -> Text)
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SpannedError Text (Sem (ParserCtxE c r)) Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
someSingle)
instance (ParameterParser a r, ParameterParser b r) => ParameterParser (a, b) r where
type ParserResult (a, b) = (ParserResult a, ParserResult b)
parse :: Sem (ParserEffs c r) (ParserResult (a, b))
parse = do
ParserResult a
a <- forall (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a r =>
Sem (ParserEffs c r) (ParserResult a)
parse @a
ParserResult b
b <- forall (r :: [(* -> *) -> * -> *]) c.
ParameterParser b r =>
Sem (ParserEffs c r) (ParserResult b)
forall a (r :: [(* -> *) -> * -> *]) c.
ParameterParser a 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)
instance ParameterParser () r where
parse :: Sem (ParserEffs c r) (ParserResult ())
parse = Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) ()
-> Sem (ParserEffs c r) ()
forall c (r :: [(* -> *) -> * -> *]) a.
Text
-> ParsecT SpannedError Text (Sem (ParserCtxE c r)) a
-> Sem (ParserEffs c r) a
parseMP (forall (r :: [(* -> *) -> * -> *]). ParameterParser () r => Text
forall a (r :: [(* -> *) -> * -> *]). ParameterParser a r => Text
parserName @()) ParsecT SpannedError Text (Sem (ParserCtxE c 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
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") (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") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"'))
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)