{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
module Text.Megaparsec.Byte.Lexer
(
space,
lexeme,
symbol,
symbol',
skipLineComment,
skipBlockComment,
skipBlockCommentNested,
decimal,
binary,
octal,
hexadecimal,
scientific,
float,
signed,
)
where
import Control.Applicative
import Data.Functor (void)
import Data.List (foldl')
import Data.Proxy
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import Data.Word (Word8)
import Text.Megaparsec
import qualified Text.Megaparsec.Byte as B
import Text.Megaparsec.Lexer
skipLineComment ::
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s ->
m ()
Tokens s
prefix =
Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
B.string Tokens s
prefix m (Tokens s) -> m () -> m ()
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") (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
10))
{-# INLINEABLE skipLineComment #-}
skipBlockComment ::
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s ->
Tokens s ->
m ()
Tokens s
start Tokens s
end = m (Tokens s)
p m (Tokens s) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [Word8] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word8 -> m (Tokens s) -> m [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Word8
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)
B.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)
B.string Tokens s
end
{-# INLINEABLE skipBlockComment #-}
skipBlockCommentNested ::
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s ->
Tokens s ->
m ()
Tokens s
start Tokens s
end = m (Tokens s)
p m (Tokens s) -> m () -> m ()
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 ~ Word8) =>
Tokens s -> Tokens s -> m ()
skipBlockCommentNested Tokens s
start Tokens s
end m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Word8
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)
B.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)
B.string Tokens s
end
{-# INLINEABLE skipBlockCommentNested #-}
decimal ::
forall e s m a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal :: m a
decimal = m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, 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 ~ Word8, Num a) =>
m a
decimal_ :: 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") Word8 -> Bool
Token s -> Bool
isDigit
where
mkNum :: Tokens s -> a
mkNum = (a -> Word8 -> a) -> a -> [Word8] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Word8 -> a
forall a a. (Integral a, Num a) => a -> a -> a
step a
0 ([Word8] -> a) -> (Tokens s -> [Word8]) -> 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 -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
{-# INLINE decimal_ #-}
binary ::
forall e s m a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
binary :: 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 Token s -> Bool
forall a. (Eq a, Num a) => a -> 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 -> Word8 -> a) -> a -> [Word8] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Word8 -> a
forall a a. (Integral a, Num a) => a -> a -> a
step a
0 ([Word8] -> a) -> (Tokens s -> [Word8]) -> 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 -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
isBinDigit :: a -> Bool
isBinDigit a
w = a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
48 Bool -> Bool -> Bool
|| a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
49
{-# INLINEABLE binary #-}
octal ::
forall e s m a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
octal :: 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 Token s -> Bool
forall a. (Ord a, Num a) => a -> Bool
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 -> Word8 -> a) -> a -> [Word8] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Word8 -> a
forall a a. (Integral a, Num a) => a -> a -> a
step a
0 ([Word8] -> a) -> (Tokens s -> [Word8]) -> 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 -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
8 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
isOctDigit :: a -> Bool
isOctDigit a
w = a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
8
{-# INLINEABLE octal #-}
hexadecimal ::
forall e s m a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
hexadecimal :: 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 Token s -> Bool
forall a. (Ord a, Num a) => a -> Bool
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 -> Word8 -> a) -> a -> [Word8] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Word8 -> a
forall a a. (Num a, Integral a) => a -> a -> a
step a
0 ([Word8] -> a) -> (Tokens s -> [Word8]) -> 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 -> a -> a
step a
a a
w
| a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57 = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
| a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
97 = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
87)
| Bool
otherwise = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
55)
isHexDigit :: a -> Bool
isHexDigit a
w =
(a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57)
Bool -> Bool -> Bool
|| (a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
97 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
102)
Bool -> Bool -> Bool
|| (a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
65 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
70)
{-# INLINEABLE hexadecimal #-}
scientific ::
forall e s m.
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
scientific :: m Scientific
scientific = do
Integer
c' <- m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_
SP Integer
c Int
e' <- SP -> m SP -> m SP
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Integer -> Int -> SP
SP Integer
c' Int
0) (m SP -> m SP
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m SP -> m SP) -> m SP -> m SP
forall a b. (a -> b) -> a -> b
$ Proxy s -> Integer -> m SP
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s -> Integer -> m SP
dotDecimal_ (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Integer
c')
Int
e <- Int -> m Int -> m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
e' (m Int -> m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
e')
Scientific -> m Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e)
{-# INLINEABLE scientific #-}
data SP = SP !Integer {-# UNPACK #-} !Int
float :: (MonadParsec e s m, Token s ~ Word8, RealFloat a) => m a
float :: m a
float = do
Integer
c' <- m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_
Scientific -> a
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat
(Scientific -> a) -> m Scientific -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( do
SP Integer
c Int
e' <- Proxy s -> Integer -> m SP
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s -> Integer -> m SP
dotDecimal_ (forall s. Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Integer
c'
Int
e <- Int -> m Int -> m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
e' (m Int -> m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
e')
Scientific -> m Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e)
)
m Scientific -> m Scientific -> m Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Int -> Scientific
Sci.scientific Integer
c' (Int -> Scientific) -> m Int -> m Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
0)
)
{-# INLINEABLE float #-}
dotDecimal_ ::
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s ->
Integer ->
m SP
dotDecimal_ :: Proxy s -> Integer -> m SP
dotDecimal_ Proxy s
pxy Integer
c' = do
m Word8 -> 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 ~ Word8) =>
Token s -> m (Token s)
B.char Token s
46)
let mkNum :: Tokens s -> SP
mkNum = (SP -> Word8 -> SP) -> SP -> [Word8] -> SP
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SP -> Word8 -> SP
forall a. Integral a => SP -> a -> SP
step (Integer -> Int -> SP
SP Integer
c' Int
0) ([Word8] -> SP) -> (Tokens s -> [Word8]) -> 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 -> a -> SP
step (SP Integer
a Int
e') a
w =
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
+ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48))
(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") Word8 -> Bool
Token s -> Bool
isDigit
{-# INLINE dotDecimal_ #-}
exponent_ ::
(MonadParsec e s m, Token s ~ Word8) =>
Int ->
m Int
exponent_ :: Int -> m Int
exponent_ Int
e' = do
m Word8 -> 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 ~ Word8) =>
Token s -> m (Token s)
B.char' Token s
101)
(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 ~ Word8, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_
{-# INLINE exponent_ #-}
signed ::
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () ->
m a ->
m a
signed :: 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 (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 Word8 -> m (a -> 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 ~ Word8) =>
Token s -> m (Token s)
B.char Token s
43) m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a
forall a. Num a => a -> a
negate (a -> a) -> m Word8 -> m (a -> 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 ~ Word8) =>
Token s -> m (Token s)
B.char Token s
45)
{-# INLINEABLE signed #-}
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10
{-# INLINE isDigit #-}