module SimpleParser.Common
( TextLabel (..)
, EmbedTextLabel (..)
, CompoundTextLabel (..)
, sepByParser
, betweenParser
, lexemeParser
, newlineParser
, spaceParser
, hspaceParser
, spaceParser1
, hspaceParser1
, decimalParser
, signedNumStartPred
, scientificParser
, signedParser
, escapedStringParser
, spanParser
, getStreamPos
) where
import Control.Monad (void)
import Control.Monad.State (get, gets)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.List (foldl')
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import SimpleParser.Chunked (Chunked (..))
import SimpleParser.Input (dropTokensWhile, dropTokensWhile1, foldTokensWhile, matchToken, takeTokensWhile1)
import SimpleParser.Parser (ParserT, defaultParser, greedyStarParser, optionalParser, orParser)
import SimpleParser.Stream (PosStream (..), Span (..), Stream (..))
data TextLabel =
TextLabelSpace
| TextLabelHSpace
| TextLabelDigit
deriving (TextLabel -> TextLabel -> Bool
(TextLabel -> TextLabel -> Bool)
-> (TextLabel -> TextLabel -> Bool) -> Eq TextLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextLabel -> TextLabel -> Bool
$c/= :: TextLabel -> TextLabel -> Bool
== :: TextLabel -> TextLabel -> Bool
$c== :: TextLabel -> TextLabel -> Bool
Eq, Int -> TextLabel -> ShowS
[TextLabel] -> ShowS
TextLabel -> String
(Int -> TextLabel -> ShowS)
-> (TextLabel -> String)
-> ([TextLabel] -> ShowS)
-> Show TextLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextLabel] -> ShowS
$cshowList :: [TextLabel] -> ShowS
show :: TextLabel -> String
$cshow :: TextLabel -> String
showsPrec :: Int -> TextLabel -> ShowS
$cshowsPrec :: Int -> TextLabel -> ShowS
Show)
class EmbedTextLabel l where
embedTextLabel :: TextLabel -> l
instance EmbedTextLabel TextLabel where
embedTextLabel :: TextLabel -> TextLabel
embedTextLabel = TextLabel -> TextLabel
forall a. a -> a
id
data CompoundTextLabel l =
CompoundTextLabelText !TextLabel
| CompoundTextLabelCustom !l
deriving (CompoundTextLabel l -> CompoundTextLabel l -> Bool
(CompoundTextLabel l -> CompoundTextLabel l -> Bool)
-> (CompoundTextLabel l -> CompoundTextLabel l -> Bool)
-> Eq (CompoundTextLabel l)
forall l.
Eq l =>
CompoundTextLabel l -> CompoundTextLabel l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompoundTextLabel l -> CompoundTextLabel l -> Bool
$c/= :: forall l.
Eq l =>
CompoundTextLabel l -> CompoundTextLabel l -> Bool
== :: CompoundTextLabel l -> CompoundTextLabel l -> Bool
$c== :: forall l.
Eq l =>
CompoundTextLabel l -> CompoundTextLabel l -> Bool
Eq, Int -> CompoundTextLabel l -> ShowS
[CompoundTextLabel l] -> ShowS
CompoundTextLabel l -> String
(Int -> CompoundTextLabel l -> ShowS)
-> (CompoundTextLabel l -> String)
-> ([CompoundTextLabel l] -> ShowS)
-> Show (CompoundTextLabel l)
forall l. Show l => Int -> CompoundTextLabel l -> ShowS
forall l. Show l => [CompoundTextLabel l] -> ShowS
forall l. Show l => CompoundTextLabel l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompoundTextLabel l] -> ShowS
$cshowList :: forall l. Show l => [CompoundTextLabel l] -> ShowS
show :: CompoundTextLabel l -> String
$cshow :: forall l. Show l => CompoundTextLabel l -> String
showsPrec :: Int -> CompoundTextLabel l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> CompoundTextLabel l -> ShowS
Show, a -> CompoundTextLabel b -> CompoundTextLabel a
(a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
(forall a b.
(a -> b) -> CompoundTextLabel a -> CompoundTextLabel b)
-> (forall a b. a -> CompoundTextLabel b -> CompoundTextLabel a)
-> Functor CompoundTextLabel
forall a b. a -> CompoundTextLabel b -> CompoundTextLabel a
forall a b. (a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CompoundTextLabel b -> CompoundTextLabel a
$c<$ :: forall a b. a -> CompoundTextLabel b -> CompoundTextLabel a
fmap :: (a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
$cfmap :: forall a b. (a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
Functor, CompoundTextLabel a -> Bool
(a -> m) -> CompoundTextLabel a -> m
(a -> b -> b) -> b -> CompoundTextLabel a -> b
(forall m. Monoid m => CompoundTextLabel m -> m)
-> (forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m)
-> (forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m)
-> (forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b)
-> (forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b)
-> (forall a. (a -> a -> a) -> CompoundTextLabel a -> a)
-> (forall a. (a -> a -> a) -> CompoundTextLabel a -> a)
-> (forall a. CompoundTextLabel a -> [a])
-> (forall a. CompoundTextLabel a -> Bool)
-> (forall a. CompoundTextLabel a -> Int)
-> (forall a. Eq a => a -> CompoundTextLabel a -> Bool)
-> (forall a. Ord a => CompoundTextLabel a -> a)
-> (forall a. Ord a => CompoundTextLabel a -> a)
-> (forall a. Num a => CompoundTextLabel a -> a)
-> (forall a. Num a => CompoundTextLabel a -> a)
-> Foldable CompoundTextLabel
forall a. Eq a => a -> CompoundTextLabel a -> Bool
forall a. Num a => CompoundTextLabel a -> a
forall a. Ord a => CompoundTextLabel a -> a
forall m. Monoid m => CompoundTextLabel m -> m
forall a. CompoundTextLabel a -> Bool
forall a. CompoundTextLabel a -> Int
forall a. CompoundTextLabel a -> [a]
forall a. (a -> a -> a) -> CompoundTextLabel a -> a
forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: CompoundTextLabel a -> a
$cproduct :: forall a. Num a => CompoundTextLabel a -> a
sum :: CompoundTextLabel a -> a
$csum :: forall a. Num a => CompoundTextLabel a -> a
minimum :: CompoundTextLabel a -> a
$cminimum :: forall a. Ord a => CompoundTextLabel a -> a
maximum :: CompoundTextLabel a -> a
$cmaximum :: forall a. Ord a => CompoundTextLabel a -> a
elem :: a -> CompoundTextLabel a -> Bool
$celem :: forall a. Eq a => a -> CompoundTextLabel a -> Bool
length :: CompoundTextLabel a -> Int
$clength :: forall a. CompoundTextLabel a -> Int
null :: CompoundTextLabel a -> Bool
$cnull :: forall a. CompoundTextLabel a -> Bool
toList :: CompoundTextLabel a -> [a]
$ctoList :: forall a. CompoundTextLabel a -> [a]
foldl1 :: (a -> a -> a) -> CompoundTextLabel a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
foldr1 :: (a -> a -> a) -> CompoundTextLabel a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
foldl' :: (b -> a -> b) -> b -> CompoundTextLabel a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
foldl :: (b -> a -> b) -> b -> CompoundTextLabel a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
foldr' :: (a -> b -> b) -> b -> CompoundTextLabel a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
foldr :: (a -> b -> b) -> b -> CompoundTextLabel a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
foldMap' :: (a -> m) -> CompoundTextLabel a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
foldMap :: (a -> m) -> CompoundTextLabel a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
fold :: CompoundTextLabel m -> m
$cfold :: forall m. Monoid m => CompoundTextLabel m -> m
Foldable, Functor CompoundTextLabel
Foldable CompoundTextLabel
Functor CompoundTextLabel
-> Foldable CompoundTextLabel
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b))
-> (forall (f :: * -> *) a.
Applicative f =>
CompoundTextLabel (f a) -> f (CompoundTextLabel a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b))
-> (forall (m :: * -> *) a.
Monad m =>
CompoundTextLabel (m a) -> m (CompoundTextLabel a))
-> Traversable CompoundTextLabel
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
CompoundTextLabel (m a) -> m (CompoundTextLabel a)
forall (f :: * -> *) a.
Applicative f =>
CompoundTextLabel (f a) -> f (CompoundTextLabel a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
sequence :: CompoundTextLabel (m a) -> m (CompoundTextLabel a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CompoundTextLabel (m a) -> m (CompoundTextLabel a)
mapM :: (a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b)
sequenceA :: CompoundTextLabel (f a) -> f (CompoundTextLabel a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CompoundTextLabel (f a) -> f (CompoundTextLabel a)
traverse :: (a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
$cp2Traversable :: Foldable CompoundTextLabel
$cp1Traversable :: Functor CompoundTextLabel
Traversable)
instance EmbedTextLabel (CompoundTextLabel l) where
embedTextLabel :: TextLabel -> CompoundTextLabel l
embedTextLabel = TextLabel -> CompoundTextLabel l
forall l. TextLabel -> CompoundTextLabel l
CompoundTextLabelText
sepByParser :: (Chunked seq elem, Monad m) =>
ParserT l s e m elem ->
ParserT l s e m () ->
ParserT l s e m seq
sepByParser :: ParserT l s e m elem -> ParserT l s e m () -> ParserT l s e m seq
sepByParser ParserT l s e m elem
thing ParserT l s e m ()
sep = do
Maybe elem
ma <- ParserT l s e m elem -> ParserT l s e m (Maybe elem)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser ParserT l s e m elem
thing
case Maybe elem
ma of
Maybe elem
Nothing -> seq -> ParserT l s e m seq
forall (f :: * -> *) a. Applicative f => a -> f a
pure seq
forall a. Monoid a => a
mempty
Just elem
a -> do
seq
as <- ParserT l s e m elem -> ParserT l s e m seq
forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser (ParserT l s e m ()
sep ParserT l s e m () -> ParserT l s e m elem -> ParserT l s e m elem
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT l s e m elem
thing)
seq -> ParserT l s e m seq
forall (f :: * -> *) a. Applicative f => a -> f a
pure (elem -> seq -> seq
forall chunk token. Chunked chunk token => token -> chunk -> chunk
consChunk elem
a seq
as)
betweenParser :: Monad m =>
ParserT l s e m () ->
ParserT l s e m () ->
ParserT l s e m a ->
ParserT l s e m a
betweenParser :: ParserT l s e m ()
-> ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
betweenParser ParserT l s e m ()
start ParserT l s e m ()
end ParserT l s e m a
thing = do
ParserT l s e m ()
start
a
a <- ParserT l s e m a
thing
ParserT l s e m ()
end
a -> ParserT l s e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
lexemeParser :: Monad m =>
ParserT l s e m () ->
ParserT l s e m a ->
ParserT l s e m a
lexemeParser :: ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
lexemeParser ParserT l s e m ()
spc ParserT l s e m a
p = ParserT l s e m a
p ParserT l s e m a -> ParserT l s e m () -> ParserT l s e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l s e m ()
spc
newlineParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
newlineParser :: ParserT l s e m ()
newlineParser = ParserT l s e m Char -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'\n')
spaceParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
spaceParser :: ParserT l s e m ()
spaceParser = ParserT l s e m Int -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Token s -> Bool) -> ParserT l s e m Int
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile Char -> Bool
Token s -> Bool
isSpace)
isHSpace :: Char -> Bool
isHSpace :: Char -> Bool
isHSpace Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'
hspaceParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
hspaceParser :: ParserT l s e m ()
hspaceParser = ParserT l s e m Int -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Token s -> Bool) -> ParserT l s e m Int
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile Char -> Bool
Token s -> Bool
isHSpace)
spaceParser1 :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
spaceParser1 :: ParserT l s e m ()
spaceParser1 = ParserT l s e m Int -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 (l -> Maybe l
forall a. a -> Maybe a
Just (TextLabel -> l
forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelSpace)) Char -> Bool
Token s -> Bool
isSpace)
hspaceParser1 :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
hspaceParser1 :: ParserT l s e m ()
hspaceParser1 = ParserT l s e m Int -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 (l -> Maybe l
forall a. a -> Maybe a
Just (TextLabel -> l
forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelHSpace)) Char -> Bool
Token s -> Bool
isHSpace)
decimalParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) => ParserT l s e m a
decimalParser :: ParserT l s e m a
decimalParser = (Chunk s -> a) -> ParserT l s e m (Chunk s) -> ParserT l s e m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunk s -> a
mkNum (Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 (l -> Maybe l
forall a. a -> Maybe a
Just (TextLabel -> l
forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelDigit)) Char -> Bool
Token s -> Bool
isDigit) where
mkNum :: Chunk s -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Char -> a
forall a. Num a => a -> Char -> a
step a
0 (String -> a) -> (Chunk s -> String) -> Chunk s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk s -> String
forall chunk token. Chunked chunk token => chunk -> [token]
chunkToTokens
step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)
data SP = SP !Integer !Int
dotDecimalParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => Integer -> ParserT l s e m SP
dotDecimalParser :: Integer -> ParserT l s e m SP
dotDecimalParser Integer
c' = do
ParserT l s e m Char -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'.')
let mkNum :: Chunk s -> SP
mkNum = (SP -> Char -> SP) -> SP -> String -> SP
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SP -> Char -> SP
step (Integer -> Int -> SP
SP Integer
c' Int
0) (String -> SP) -> (Chunk s -> String) -> Chunk s -> SP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk s -> String
forall chunk token. Chunked chunk token => chunk -> [token]
chunkToTokens
step :: SP -> Char -> SP
step (SP Integer
a Int
e') Char
c = Integer -> Int -> SP
SP (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)) (Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(Chunk s -> SP) -> ParserT l s e m (Chunk s) -> ParserT l s e m SP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunk s -> SP
mkNum (Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 (l -> Maybe l
forall a. a -> Maybe a
Just (TextLabel -> l
forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelDigit)) Char -> Bool
Token s -> Bool
isDigit)
exponentParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => Int -> ParserT l s e m Int
exponentParser :: Int -> ParserT l s e m Int
exponentParser Int
e' = do
ParserT l s e m Char -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT l s e m Char
-> ParserT l s e m Char -> ParserT l s e m Char
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser (Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'e') (Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'E'))
(Int -> Int) -> ParserT l s e m Int -> ParserT l s e m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e') (ParserT l s e m () -> ParserT l s e m Int -> ParserT l s e m Int
forall s (m :: * -> *) a l e.
(Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
signedParser (() -> ParserT l s e m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParserT l s e m Int
forall l s (m :: * -> *) a e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m a
decimalParser)
signedNumStartPred :: Char -> Bool
signedNumStartPred :: Char -> Bool
signedNumStartPred Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
scientificParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m Scientific
scientificParser :: ParserT l s e m Scientific
scientificParser = do
Integer
c' <- ParserT l s e m Integer
forall l s (m :: * -> *) a e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m a
decimalParser
SP Integer
c Int
e' <- SP -> ParserT l s e m SP -> ParserT l s e m SP
forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser (Integer -> Int -> SP
SP Integer
c' Int
0) (Integer -> ParserT l s e m SP
forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
Integer -> ParserT l s e m SP
dotDecimalParser Integer
c')
Int
e <- Int -> ParserT l s e m Int -> ParserT l s e m Int
forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser Int
e' (Int -> ParserT l s e m Int
forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
Int -> ParserT l s e m Int
exponentParser Int
e')
Scientific -> ParserT l s e m Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e)
signedParser :: (Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m () ->
ParserT l s e m a ->
ParserT l s e m a
signedParser :: ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
signedParser ParserT l s e m ()
spc ParserT l s e m a
p = (a -> a) -> ParserT l s e m (a -> a) -> ParserT l s e m (a -> a)
forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser a -> a
forall a. a -> a
id (ParserT l s e m ()
-> ParserT l s e m (a -> a) -> ParserT l s e m (a -> a)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
lexemeParser ParserT l s e m ()
spc ParserT l s e m (a -> a)
forall l e. ParserT l s e m (a -> a)
sign) ParserT l s e m (a -> a) -> ParserT l s e m a -> ParserT l s e m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT l s e m a
p where
sign :: ParserT l s e m (a -> a)
sign = ParserT l s e m (a -> a)
-> ParserT l s e m (a -> a) -> ParserT l s e m (a -> a)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser (a -> a
forall a. a -> a
id (a -> a) -> ParserT l s e m Char -> ParserT l s e m (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'+') (a -> a
forall a. Num a => a -> a
negate (a -> a) -> ParserT l s e m Char -> ParserT l s e m (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
'-')
data Pair = Pair ![Char] !Bool
escapedStringParser :: (Stream s, Token s ~ Char, Monad m) => Char -> ParserT l s e m (Chunk s)
escapedStringParser :: Char -> ParserT l s e m (Chunk s)
escapedStringParser Char
quoteChar =
let quoteParser :: ParserT l s e m ()
quoteParser = ParserT l s e m Char -> ParserT l s e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> ParserT l s e m (Token s)
forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
Token s
quoteChar)
accParser :: ParserT l s e m Pair
accParser = (Token s -> Pair -> (Bool, Pair)) -> Pair -> ParserT l s e m Pair
forall s (m :: * -> *) x l e.
(Stream s, Monad m) =>
(Token s -> x -> (Bool, x)) -> x -> ParserT l s e m x
foldTokensWhile Char -> Pair -> (Bool, Pair)
Token s -> Pair -> (Bool, Pair)
go (String -> Bool -> Pair
Pair [] Bool
False)
innerParser :: ParserT l s e m (Chunk s)
innerParser = (Pair -> Chunk s)
-> ParserT l s e m Pair -> ParserT l s e m (Chunk s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair String
acc Bool
_) -> String -> Chunk s
forall chunk token. Chunked chunk token => [token] -> chunk
revTokensToChunk String
acc) ParserT l s e m Pair
accParser
escChar :: Char
escChar = Char
'\\'
go :: Char -> Pair -> (Bool, Pair)
go Char
c (Pair String
acc Bool
esc)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
escChar =
if Bool
esc
then (Bool
True, String -> Bool -> Pair
Pair (Char
escCharChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
False)
else (Bool
True, String -> Bool -> Pair
Pair String
acc Bool
True)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
quoteChar =
if Bool
esc
then (Bool
True, String -> Bool -> Pair
Pair (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
False)
else (Bool
False, String -> Bool -> Pair
Pair String
acc Bool
False)
| Bool
otherwise =
if Bool
esc
then (Bool
True, String -> Bool -> Pair
Pair (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:Char
escCharChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
False)
else (Bool
True, String -> Bool -> Pair
Pair (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Bool
False)
in ParserT l s e m ()
-> ParserT l s e m ()
-> ParserT l s e m (Chunk s)
-> ParserT l s e m (Chunk s)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m ()
-> ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
betweenParser ParserT l s e m ()
quoteParser ParserT l s e m ()
quoteParser ParserT l s e m (Chunk s)
innerParser
spanParser :: (PosStream s, Monad m) => (Span (Pos s) -> a -> b) -> ParserT l s e m a -> ParserT l s e m b
spanParser :: (Span (Pos s) -> a -> b) -> ParserT l s e m a -> ParserT l s e m b
spanParser Span (Pos s) -> a -> b
f ParserT l s e m a
p = do
s
start <- ParserT l s e m s
forall s (m :: * -> *). MonadState s m => m s
get
a
val <- ParserT l s e m a
p
s
end <- ParserT l s e m s
forall s (m :: * -> *). MonadState s m => m s
get
b -> ParserT l s e m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span (Pos s) -> a -> b
f (Pos s -> Pos s -> Span (Pos s)
forall p. p -> p -> Span p
Span (s -> Pos s
forall s. PosStream s => s -> Pos s
streamViewPos s
start) (s -> Pos s
forall s. PosStream s => s -> Pos s
streamViewPos s
end)) a
val)
getStreamPos :: (PosStream s, Monad m) => ParserT l s e m (Pos s)
getStreamPos :: ParserT l s e m (Pos s)
getStreamPos = (s -> Pos s) -> ParserT l s e m (Pos s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets s -> Pos s
forall s. PosStream s => s -> Pos s
streamViewPos