{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Text.Megaparsec.Char.Lexer
(
space,
lexeme,
symbol,
symbol',
skipLineComment,
skipBlockComment,
skipBlockCommentNested,
indentLevel,
incorrectIndent,
indentGuard,
nonIndented,
IndentOpt (..),
indentBlock,
lineFold,
charLiteral,
decimal,
binary,
octal,
hexadecimal,
scientific,
float,
signed,
)
where
import Control.Applicative
import Control.Monad (void)
import qualified Data.Char as Char
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Proxy
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import qualified Data.Set as E
import Text.Megaparsec
import qualified Text.Megaparsec.Char as C
import Text.Megaparsec.Lexer
skipLineComment ::
(MonadParsec e s m, Token s ~ Char) =>
Tokens s ->
m ()
Tokens s
prefix =
Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
C.string Tokens s
prefix m (Tokens s) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Tokens s) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"character") (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token s
'\n'))
{-# INLINEABLE skipLineComment #-}
skipBlockComment ::
(MonadParsec e s m) =>
Tokens s ->
Tokens s ->
m ()
Tokens s
start Tokens s
end = m (Tokens s)
p m (Tokens s) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [Token s] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Token s) -> m (Tokens s) -> m [Token s]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m (Tokens s)
n)
where
p :: m (Tokens s)
p = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
C.string Tokens s
start
n :: m (Tokens s)
n = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
C.string Tokens s
end
{-# INLINEABLE skipBlockComment #-}
skipBlockCommentNested ::
(MonadParsec e s m, Token s ~ Char) =>
Tokens s ->
Tokens s ->
m ()
Tokens s
start Tokens s
end = m (Tokens s)
p m (Tokens s) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m (Tokens s) -> m [()]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m ()
e m (Tokens s)
n)
where
e :: m ()
e = Tokens s -> Tokens s -> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
skipBlockCommentNested Tokens s
start Tokens s
end m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Token s) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
p :: m (Tokens s)
p = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
C.string Tokens s
start
n :: m (Tokens s)
n = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
C.string Tokens s
end
{-# INLINEABLE skipBlockCommentNested #-}
indentLevel :: (TraversableStream s, MonadParsec e s m) => m Pos
indentLevel :: forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel = SourcePos -> Pos
sourceColumn (SourcePos -> Pos) -> m SourcePos -> m Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
{-# INLINE indentLevel #-}
incorrectIndent ::
(MonadParsec e s m) =>
Ordering ->
Pos ->
Pos ->
m a
incorrectIndent :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
Ordering -> Pos -> Pos -> m a
incorrectIndent Ordering
ord Pos
ref Pos
actual =
Set (ErrorFancy e) -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy e) -> m a)
-> (ErrorFancy e -> Set (ErrorFancy e)) -> ErrorFancy e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
E.singleton (ErrorFancy e -> m a) -> ErrorFancy e -> m a
forall a b. (a -> b) -> a -> b
$
Ordering -> Pos -> Pos -> ErrorFancy e
forall e. Ordering -> Pos -> Pos -> ErrorFancy e
ErrorIndentation Ordering
ord Pos
ref Pos
actual
{-# INLINEABLE incorrectIndent #-}
indentGuard ::
(TraversableStream s, MonadParsec e s m) =>
m () ->
Ordering ->
Pos ->
m Pos
indentGuard :: forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
indentGuard m ()
sc Ordering
ord Pos
ref = do
m ()
sc
actual <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel
if compare actual ref == ord
then return actual
else incorrectIndent ord ref actual
{-# INLINEABLE indentGuard #-}
nonIndented ::
(TraversableStream s, MonadParsec e s m) =>
m () ->
m a ->
m a
nonIndented :: forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
m () -> m a -> m a
nonIndented m ()
sc m a
p = m () -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
indentGuard m ()
sc Ordering
EQ Pos
pos1 m Pos -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p
{-# INLINEABLE nonIndented #-}
data IndentOpt m a b
=
IndentNone a
|
IndentMany (Maybe Pos) ([b] -> m a) (m b)
|
IndentSome (Maybe Pos) ([b] -> m a) (m b)
indentBlock ::
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () ->
m (IndentOpt m a b) ->
m a
indentBlock :: forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
indentBlock m ()
sc m (IndentOpt m a b)
r = do
m ()
sc
ref <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel
a <- r
case a of
IndentNone a
x -> a
x a -> m () -> m a
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
sc
IndentMany Maybe Pos
indent [b] -> m a
f m b
p -> do
mlvl <- (m Pos -> m (Maybe Pos)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Pos -> m (Maybe Pos))
-> (m Pos -> m Pos) -> m Pos -> m (Maybe Pos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Pos -> m Pos
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
C.eol m (Tokens s) -> m Pos -> m Pos
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
indentGuard m ()
sc Ordering
GT Pos
ref)
done <- isJust <$> optional eof
case (mlvl, done) of
(Just Pos
lvl, Bool
False) ->
Pos -> Pos -> m () -> m b -> m [b]
forall s e (m :: * -> *) b.
(TraversableStream s, MonadParsec e s m) =>
Pos -> Pos -> m () -> m b -> m [b]
indentedItems Pos
ref (Pos -> Maybe Pos -> Pos
forall a. a -> Maybe a -> a
fromMaybe Pos
lvl Maybe Pos
indent) m ()
sc m b
p m [b] -> ([b] -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [b] -> m a
f
(Maybe Pos, Bool)
_ -> m ()
sc m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [b] -> m a
f []
IndentSome Maybe Pos
indent [b] -> m a
f m b
p -> do
pos <- m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
C.eol m (Tokens s) -> m Pos -> m Pos
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
indentGuard m ()
sc Ordering
GT Pos
ref
let lvl = Pos -> Maybe Pos -> Pos
forall a. a -> Maybe a -> a
fromMaybe Pos
pos Maybe Pos
indent
x <-
if
| pos <= ref -> incorrectIndent GT ref pos
| pos == lvl -> p
| otherwise -> incorrectIndent EQ lvl pos
xs <- indentedItems ref lvl sc p
f (x : xs)
{-# INLINEABLE indentBlock #-}
indentedItems ::
(TraversableStream s, MonadParsec e s m) =>
Pos ->
Pos ->
m () ->
m b ->
m [b]
indentedItems :: forall s e (m :: * -> *) b.
(TraversableStream s, MonadParsec e s m) =>
Pos -> Pos -> m () -> m b -> m [b]
indentedItems Pos
ref Pos
lvl m ()
sc m b
p = m [b]
go
where
go :: m [b]
go = do
m ()
sc
pos <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel
done <- isJust <$> optional eof
if done
then return []
else
if
| pos <= ref -> return []
| pos == lvl -> (:) <$> p <*> go
| otherwise -> incorrectIndent EQ lvl pos
lineFold ::
(TraversableStream s, MonadParsec e s m) =>
m () ->
(m () -> m a) ->
m a
lineFold :: forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
m () -> (m () -> m a) -> m a
lineFold m ()
sc m () -> m a
action =
m ()
sc m () -> m Pos -> m Pos
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel m Pos -> (Pos -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> m a
action (m () -> m a) -> (Pos -> m ()) -> Pos -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Pos -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Pos -> m ()) -> (Pos -> m Pos) -> Pos -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
indentGuard m ()
sc Ordering
GT
{-# INLINEABLE lineFold #-}
charLiteral :: (MonadParsec e s m, Token s ~ Char) => m Char
charLiteral :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral = String -> m Char -> m Char
forall a. String -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"literal character" (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$ do
r <- m String -> m String
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Int -> Int -> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
1 Int
10 m Char
m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
case listToMaybe (Char.readLitChar r) of
Just (Char
c, String
r') -> Char
c Char -> m () -> m Char
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> m (Token s) -> m ()
forall (m :: * -> *) a. Monad m => Int -> m a -> m ()
skipCount (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r') m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
Maybe (Char, String)
Nothing -> ErrorItem (Token s) -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (String -> Char
forall a. HasCallStack => [a] -> a
head String
r Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| []))
{-# INLINEABLE charLiteral #-}
decimal :: (MonadParsec e s m, Token s ~ Char, Num a) => m a
decimal :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal = m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_ m a -> String -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"integer"
{-# INLINEABLE decimal #-}
decimal_ ::
forall e s m a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_ :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_ = Tokens s -> a
mkNum (Tokens s -> a) -> m (Tokens s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"digit") Char -> Bool
Token s -> Bool
Char.isDigit
where
mkNum :: Tokens s -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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) -> (Tokens s -> String) -> Tokens s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
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
Char.digitToInt Char
c)
{-# INLINE decimal_ #-}
binary ::
forall e s m a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary =
Tokens s -> a
mkNum
(Tokens s -> a) -> m (Tokens s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token s -> Bool
isBinDigit
m a -> String -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"binary integer"
where
mkNum :: Tokens s -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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) -> (Tokens s -> String) -> Tokens s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
c)
isBinDigit :: Char -> Bool
isBinDigit Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1'
{-# INLINEABLE binary #-}
octal ::
forall e s m a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
octal :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
octal =
Tokens s -> a
mkNum
(Tokens s -> a) -> m (Tokens s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token s -> Bool
Char.isOctDigit
m a -> String -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"octal integer"
where
mkNum :: Tokens s -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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) -> (Tokens s -> String) -> Tokens s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
8 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
c)
{-# INLINEABLE octal #-}
hexadecimal ::
forall e s m a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal =
Tokens s -> a
mkNum
(Tokens s -> a) -> m (Tokens s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token s -> Bool
Char.isHexDigit
m a -> String -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"hexadecimal integer"
where
mkNum :: Tokens s -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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) -> (Tokens s -> String) -> Tokens s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
c)
{-# INLINEABLE hexadecimal #-}
scientific ::
forall e s m.
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
scientific :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
scientific = do
c' <- m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_
SP c e' <- option (SP c' 0) (try $ dotDecimal_ (Proxy :: Proxy s) c')
e <- option e' (try $ exponent_ e')
return (Sci.scientific c e)
{-# INLINEABLE scientific #-}
data SP = SP !Integer {-# UNPACK #-} !Int
float :: (MonadParsec e s m, Token s ~ Char, RealFloat a) => m a
float :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float = do
c' <- m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_
Sci.toRealFloat
<$> ( ( do
SP c e' <- dotDecimal_ (Proxy :: Proxy s) c'
e <- option e' (try $ exponent_ e')
return (Sci.scientific c e)
)
<|> (Sci.scientific c' <$> exponent_ 0)
)
{-# INLINEABLE float #-}
dotDecimal_ ::
(MonadParsec e s m, Token s ~ Char) =>
Proxy s ->
Integer ->
m SP
dotDecimal_ :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Proxy s -> Integer -> m SP
dotDecimal_ Proxy s
pxy Integer
c' = do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token s
'.')
let mkNum :: Tokens s -> SP
mkNum = (SP -> Char -> SP) -> SP -> String -> SP
forall b a. (b -> a -> b) -> b -> [a] -> b
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) -> (Tokens s -> String) -> Tokens s -> SP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens Proxy s
pxy
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
Char.digitToInt Char
c))
(Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Tokens s -> SP
mkNum (Tokens s -> SP) -> m (Tokens s) -> m SP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"digit") Char -> Bool
Token s -> Bool
Char.isDigit
{-# INLINE dotDecimal_ #-}
exponent_ ::
(MonadParsec e s m, Token s ~ Char) =>
Int ->
m Int
exponent_ :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Int
exponent_ Int
e' = do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char' Char
Token s
'e')
(Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e') (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m () -> m Int -> m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal_
{-# INLINE exponent_ #-}
signed ::
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () ->
m a ->
m a
signed :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed m ()
spc m a
p = (a -> a) -> m (a -> a) -> m (a -> a)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option a -> a
forall a. a -> a
id (m () -> m (a -> a) -> m (a -> a)
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
lexeme m ()
spc m (a -> a)
sign) m (a -> a) -> m a -> m a
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p
where
sign :: m (a -> a)
sign = (a -> a
forall a. a -> a
id (a -> a) -> m Char -> m (a -> a)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token s
'+') m (a -> a) -> m (a -> a) -> m (a -> a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a
forall a. Num a => a -> a
negate (a -> a) -> m Char -> m (a -> a)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token s
'-')
{-# INLINEABLE signed #-}