-- | Common parsers.
-- See <https://hackage.haskell.org/package/megaparsec-9.0.1/docs/Text-Megaparsec-Char-Lexer.html Text.Megaparsec.Char.Lexer>.
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 (..))

-- | Enumeration of common labels in textual parsing.
data TextLabel =
    TextLabelSpace
  | TextLabelHSpace
  | TextLabelDigit
  deriving (TextLabel -> TextLabel -> Bool
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
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 = forall a. a -> a
id

-- | Union of text and custom labels
data CompoundTextLabel l =
    CompoundTextLabelText !TextLabel
  | CompoundTextLabelCustom !l
  deriving (CompoundTextLabel l -> CompoundTextLabel l -> Bool
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
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, 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
<$ :: forall a b. a -> CompoundTextLabel b -> CompoundTextLabel a
$c<$ :: forall a b. a -> CompoundTextLabel b -> CompoundTextLabel a
fmap :: forall a b. (a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
$cfmap :: forall a b. (a -> b) -> CompoundTextLabel a -> CompoundTextLabel b
Functor, 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 :: forall a. Num a => CompoundTextLabel a -> a
$cproduct :: forall a. Num a => CompoundTextLabel a -> a
sum :: forall a. Num a => CompoundTextLabel a -> a
$csum :: forall a. Num a => CompoundTextLabel a -> a
minimum :: forall a. Ord a => CompoundTextLabel a -> a
$cminimum :: forall a. Ord a => CompoundTextLabel a -> a
maximum :: forall a. Ord a => CompoundTextLabel a -> a
$cmaximum :: forall a. Ord a => CompoundTextLabel a -> a
elem :: forall a. Eq a => a -> CompoundTextLabel a -> Bool
$celem :: forall a. Eq a => a -> CompoundTextLabel a -> Bool
length :: forall a. CompoundTextLabel a -> Int
$clength :: forall a. CompoundTextLabel a -> Int
null :: forall a. CompoundTextLabel a -> Bool
$cnull :: forall a. CompoundTextLabel a -> Bool
toList :: forall a. CompoundTextLabel a -> [a]
$ctoList :: forall a. CompoundTextLabel a -> [a]
foldl1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
foldr1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CompoundTextLabel a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CompoundTextLabel a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CompoundTextLabel a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CompoundTextLabel a -> m
fold :: forall m. Monoid m => CompoundTextLabel m -> m
$cfold :: forall m. Monoid m => CompoundTextLabel m -> m
Foldable, Functor CompoundTextLabel
Foldable CompoundTextLabel
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 :: forall (m :: * -> *) a.
Monad m =>
CompoundTextLabel (m a) -> m (CompoundTextLabel a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CompoundTextLabel (m a) -> m (CompoundTextLabel a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompoundTextLabel a -> m (CompoundTextLabel b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CompoundTextLabel (f a) -> f (CompoundTextLabel a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CompoundTextLabel (f a) -> f (CompoundTextLabel a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompoundTextLabel a -> f (CompoundTextLabel b)
Traversable)

instance EmbedTextLabel (CompoundTextLabel l) where
  embedTextLabel :: TextLabel -> CompoundTextLabel l
embedTextLabel = forall l. TextLabel -> CompoundTextLabel l
CompoundTextLabelText

-- | Yields the maximal list of separated items. May return an empty list.
sepByParser :: (Chunked seq elem, Monad m) =>
  -- | How to parse item
  ParserT l s e m elem ->
  -- | How to parse separator
  ParserT l s e m () ->
  ParserT l s e m seq
sepByParser :: forall seq elem (m :: * -> *) l s e.
(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
thing ParserT l s e m ()
sep = do
  Maybe elem
ma <- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    Just elem
a -> do
      seq
as <- 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT l s e m elem
thing)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall chunk token. Chunked chunk token => token -> chunk -> chunk
consChunk elem
a seq
as)

-- | Parses between start and end markers.
betweenParser :: Monad m =>
  -- | How to parse start
  ParserT l s e m () ->
  -- | How to parse end
  ParserT l s e m () ->
  -- | How to parse inside
  ParserT l s e m a ->
  ParserT l s e m a
betweenParser :: 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 ()
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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | A wrapper for lexemes (equivalent to Megaparsec's 'lexeme').
lexemeParser :: Monad m =>
  -- | How to consume white space after lexeme
  ParserT l s e m () ->
  -- | How to parse actual lexeme
  ParserT l s e m a ->
  ParserT l s e m a
lexemeParser :: 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
p = ParserT l s e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l s e m ()
spc

-- | Consumes a newline character.
newlineParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
newlineParser :: forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
newlineParser = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
'\n')

-- | Consumes 0 or more space characters.
spaceParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
spaceParser :: forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
spaceParser = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile Char -> Bool
isSpace)

isHSpace :: Char -> Bool
isHSpace :: Char -> Bool
isHSpace Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r'

-- | Consumes 0 or more non-line-break space characters
hspaceParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
hspaceParser :: forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
hspaceParser = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile Char -> Bool
isHSpace)

-- | Consumes 1 or more space characters.
spaceParser1 :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
spaceParser1 :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
spaceParser1 = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 (forall a. a -> Maybe a
Just (forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelSpace)) Char -> Bool
isSpace)

-- | Consumes 1 or more non-line-break space characters
hspaceParser1 :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m ()
hspaceParser1 :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
hspaceParser1 = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 (forall a. a -> Maybe a
Just (forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelHSpace)) Char -> Bool
isHSpace)

-- | Parses an integer in decimal representation (equivalent to Megaparsec's 'decimal').
decimalParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) => ParserT l s e m a
decimalParser :: forall l s (m :: * -> *) a e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m a
decimalParser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunk s -> a
mkNum (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 (forall a. a -> Maybe a
Just (forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelDigit)) Char -> Bool
isDigit) where
  mkNum :: Chunk s -> a
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Num a => a -> Char -> a
step a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chunk token. Chunked chunk token => chunk -> [token]
chunkToTokens
  step :: a -> Char -> a
step a
a Char
c = a
a forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> 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 :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
Integer -> ParserT l s e m SP
dotDecimalParser Integer
c' = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
'.')
  let mkNum :: Chunk s -> SP
mkNum = 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Num a => a -> a -> a
* Integer
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)) (Int
e' forall a. Num a => a -> a -> a
- Int
1)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunk s -> SP
mkNum (forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 (forall a. a -> Maybe a
Just (forall l. EmbedTextLabel l => TextLabel -> l
embedTextLabel TextLabel
TextLabelDigit)) Char -> Bool
isDigit)

exponentParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => Int -> ParserT l s e m Int
exponentParser :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
Int -> ParserT l s e m Int
exponentParser Int
e' = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
'e') (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
'E'))
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
e') (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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall l s (m :: * -> *) a e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m, Num a) =>
ParserT l s e m a
decimalParser)

-- | Predicate for satisfying the start of signed numbers
signedNumStartPred :: Char -> Bool
signedNumStartPred :: Char -> Bool
signedNumStartPred Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Parses a floating point value as a 'Scientific' number (equivalent to Megaparsec's 'scientific').
scientificParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m Scientific
scientificParser :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m Scientific
scientificParser = do
  Integer
c' <- 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' <- 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) (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 <- forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser Int
e' (forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
Int -> ParserT l s e m Int
exponentParser Int
e')
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e)

-- | Parses a number as a literal integer or a 'Scientific' number.
-- Though 'Scientific' can represent integers, this allows you to distinugish integer literals from scientific literals
-- since that information is lost after parsing.
numParser :: (EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) => ParserT l s e m (Either Integer Scientific)
numParser :: forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m (Either Integer Scientific)
numParser = do
  Integer
c' <- 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) <- 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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
True) (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) <- 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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
True) (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 there is no decimal or exponent, return this as an integer
  -- Otherwise return as scientific, which may be float or exponentiated integer
  if Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
b2
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Integer
c')
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
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
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)

-- | Consumes an optional + or - representing the sign of a number.
signParser :: (Stream s, Token s ~ Char, Monad m) => ParserT l s e m (Maybe Sign)
signParser :: forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m (Maybe Sign)
signParser = do
  Maybe Char
mc <- 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
'+' -> forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> Maybe a
Just Sign
SignPos
    Just Char
'-' -> forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> Maybe a
Just Sign
SignNeg
    Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Optionally negate the number according to the sign (treating 'Nothing' as positive sign).
applySign :: Num a => Maybe Sign -> a -> a
applySign :: forall a. Num a => Maybe Sign -> a -> a
applySign Maybe Sign
ms a
n =
  case Maybe Sign
ms of
    Just Sign
SignNeg -> forall a. Num a => a -> a
negate a
n
    Maybe Sign
_ -> a
n

-- | Parses an optional sign character followed by a number and yields a correctly-signed
-- number (equivalend to Megaparsec's 'signed').
signedParser :: (Stream s, Token s ~ Char, Monad m, Num a) =>
  -- | How to consume white space after the sign
  ParserT l s e m () ->
  -- | How to parse the number itself
  ParserT l s e m a ->
  -- | Parser for signed numbers
  ParserT l s e m a
signedParser :: 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 ()
spc ParserT l s e m a
p = do
  Maybe Sign
ms <- 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
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => Maybe Sign -> a -> a
applySign Maybe Sign
ms) ParserT l s e m a
p

data Pair = Pair ![Char] !Bool

-- | Given a quote charcter (like a single or double quote), yields the contents of the
-- string bounded by those quotes. The contents may contain backslash-escaped quotes.
-- Returns nothing if outside quotes are missing or the stream ends before unquote.
escapedStringParser :: (Stream s, Token s ~ Char, Monad m) => Char -> ParserT l s e m (Chunk s)
escapedStringParser :: forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
Char -> ParserT l s e m (Chunk s)
escapedStringParser Char
quoteChar =
  let quoteParser :: ParserT l s e m ()
quoteParser = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
quoteChar)
      accParser :: ParserT l s e m Pair
accParser = 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)
go (String -> Bool -> Pair
Pair [] Bool
False)
      innerParser :: ParserT l s e m (Chunk s)
innerParser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair String
acc Bool
_) -> 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 forall a. Eq a => a -> a -> Bool
== Char
escChar =
          if Bool
esc
            then (Bool
True, String -> Bool -> Pair
Pair (Char
escCharforall a. a -> [a] -> [a]
:String
acc) Bool
False) -- Was escaped escape, append one
            else (Bool
True, String -> Bool -> Pair
Pair String
acc Bool
True) -- Skip appending this esc
        | Char
c forall a. Eq a => a -> a -> Bool
== Char
quoteChar =
          if Bool
esc
            then (Bool
True, String -> Bool -> Pair
Pair (Char
cforall a. a -> [a] -> [a]
:String
acc) Bool
False) -- Escaped quote
            else (Bool
False, String -> Bool -> Pair
Pair String
acc Bool
False) -- End of quote
        | Bool
otherwise =
          if Bool
esc
            then (Bool
True, String -> Bool -> Pair
Pair (Char
cforall a. a -> [a] -> [a]
:Char
escCharforall a. a -> [a] -> [a]
:String
acc) Bool
False) -- Was a non-quote esc, append both
            else (Bool
True, String -> Bool -> Pair
Pair (Char
cforall a. a -> [a] -> [a]
:String
acc) Bool
False) -- Just consume char
  in 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

-- | Adds span information to parsed values.
spanParser :: (PosStream s, Monad m) => (Span (Pos s) -> a -> b) -> ParserT l s e m a -> ParserT l s e m b
spanParser :: forall s (m :: * -> *) a b l e.
(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
f ParserT l s e m a
p = do
  s
start <- forall s (m :: * -> *). MonadState s m => m s
get
  a
val <- ParserT l s e m a
p
  s
end <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span (Pos s) -> a -> b
f (forall p. p -> p -> Span p
Span (forall s. PosStream s => s -> Pos s
streamViewPos s
start) (forall s. PosStream s => s -> Pos s
streamViewPos s
end)) a
val)

-- | Gets the current stream position
getStreamPos :: (PosStream s, Monad m) => ParserT l s e m (Pos s)
getStreamPos :: forall s (m :: * -> *) l e.
(PosStream s, Monad m) =>
ParserT l s e m (Pos s)
getStreamPos = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s. PosStream s => s -> Pos s
streamViewPos