module SimpleParser.Common
( TextLabel (..)
, EmbedTextLabel (..)
, CompoundTextLabel (..)
, sepByParser
, betweenParser
, lexemeParser
, newlineParser
, spaceParser
, hspaceParser
, spaceParser1
, hspaceParser1
, decimalParser
, signedNumStartPred
, scientificParser
, numParser
, Sign (..)
, signParser
, applySign
, signedParser
, escapedStringParser
, spanParser
, getStreamPos
) where
import Control.Monad (void)
import Control.Monad.State (get, gets)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Functor (($>))
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, peekToken, popToken,
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)
numParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m (Either Integer Scientific)
numParser :: ParserT l s e m (Either Integer Scientific)
numParser = 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', Bool
b1) <- (SP, Bool)
-> ParserT l s e m (SP, Bool) -> ParserT l s e m (SP, Bool)
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, Bool
False) ((SP -> (SP, Bool))
-> ParserT l s e m SP -> ParserT l s e m (SP, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
True) (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, Bool
b2) <- (Int, Bool)
-> ParserT l s e m (Int, Bool) -> ParserT l s e m (Int, Bool)
forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser (Int
e', Bool
False) ((Int -> (Int, Bool))
-> ParserT l s e m Int -> ParserT l s e m (Int, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
True) (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'))
if Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
b2
then Either Integer Scientific
-> ParserT l s e m (Either Integer Scientific)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either Integer Scientific
forall a b. a -> Either a b
Left Integer
c')
else Either Integer Scientific
-> ParserT l s e m (Either Integer Scientific)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Either Integer Scientific
forall a b. b -> Either a b
Right (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e))
data Sign = SignPos | SignNeg deriving (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show)
signParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m (Maybe Sign)
signParser :: ParserT l s e m (Maybe Sign)
signParser = do
Maybe Char
mc <- ParserT l s e m (Maybe Char)
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken
case Maybe Char
mc of
Just Char
'+' -> ParserT l s e m (Maybe Char)
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken ParserT l s e m (Maybe Char)
-> Maybe Sign -> ParserT l s e m (Maybe Sign)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
SignPos
Just Char
'-' -> ParserT l s e m (Maybe Char)
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken ParserT l s e m (Maybe Char)
-> Maybe Sign -> ParserT l s e m (Maybe Sign)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Sign -> Maybe Sign
forall a. a -> Maybe a
Just Sign
SignNeg
Maybe Char
_ -> Maybe Sign -> ParserT l s e m (Maybe Sign)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Sign
forall a. Maybe a
Nothing
applySign :: Num a => Maybe Sign -> a -> a
applySign :: Maybe Sign -> a -> a
applySign Maybe Sign
ms a
n =
case Maybe Sign
ms of
Just Sign
SignNeg -> a -> a
forall a. Num a => a -> a
negate a
n
Maybe Sign
_ -> a
n
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 = do
Maybe Sign
ms <- ParserT l s e m (Maybe Sign)
forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m (Maybe Sign)
signParser
ParserT l s e m ()
spc
(a -> a) -> ParserT l s e m a -> ParserT l s e m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Sign -> a -> a
forall a. Num a => Maybe Sign -> a -> a
applySign Maybe Sign
ms) ParserT l s e m a
p
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