{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
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 =
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
B.string Tokens s
prefix forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"character") (forall a. Eq a => a -> a -> Bool
/= Token s
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m (Tokens s)
n)
where
p :: m (Tokens s)
p = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
B.string Tokens s
start
n :: m (Tokens s)
n = 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m ()
e m (Tokens s)
n)
where
e :: m ()
e = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s -> Tokens s -> m ()
skipBlockCommentNested Tokens s
start Tokens s
end forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
p :: m (Tokens s)
p = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
B.string Tokens s
start
n :: m (Tokens s)
n = 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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_ 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_ :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_ = Tokens s -> a
mkNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"digit") Word8 -> Bool
isDigit
where
mkNum :: Tokens s -> a
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Integral a, Num a) => a -> a -> a
step a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> a -> a
step a
a a
w = 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 (a
w 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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
binary =
Tokens s -> a
mkNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing forall {a}. (Eq a, Num a) => a -> Bool
isBinDigit
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"binary integer"
where
mkNum :: Tokens s -> a
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Integral a, Num a) => a -> a -> a
step a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> a -> a
step a
a a
w = a
a forall a. Num a => a -> a -> a
* a
2 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w forall a. Num a => a -> a -> a
- a
48)
isBinDigit :: a -> Bool
isBinDigit a
w = a
w forall a. Eq a => a -> a -> Bool
== a
48 Bool -> Bool -> Bool
|| a
w 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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
octal =
Tokens s -> a
mkNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing forall {a}. (Ord a, Num a) => a -> Bool
isOctDigit
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"octal integer"
where
mkNum :: Tokens s -> a
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Integral a, Num a) => a -> a -> a
step a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> a -> a
step a
a a
w = a
a forall a. Num a => a -> a -> a
* a
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w forall a. Num a => a -> a -> a
- a
48)
isOctDigit :: a -> Bool
isOctDigit a
w = a
w forall a. Num a => a -> a -> a
- a
48 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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
hexadecimal =
Tokens s -> a
mkNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing forall {a}. (Ord a, Num a) => a -> Bool
isHexDigit
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"hexadecimal integer"
where
mkNum :: Tokens s -> a
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a}. (Num a, Integral a) => a -> a -> a
step a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
step :: a -> a -> a
step a
a a
w
| a
w forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
57 = a
a forall a. Num a => a -> a -> a
* a
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w forall a. Num a => a -> a -> a
- a
48)
| a
w forall a. Ord a => a -> a -> Bool
>= a
97 = a
a forall a. Num a => a -> a -> a
* a
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w forall a. Num a => a -> a -> a
- a
87)
| Bool
otherwise = a
a forall a. Num a => a -> a -> a
* a
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w forall a. Num a => a -> a -> a
- a
55)
isHexDigit :: a -> Bool
isHexDigit a
w =
(a
w forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
57)
Bool -> Bool -> Bool
|| (a
w forall a. Ord a => a -> a -> Bool
>= a
97 Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
102)
Bool -> Bool -> Bool
|| (a
w forall a. Ord a => a -> a -> Bool
>= a
65 Bool -> Bool -> Bool
&& a
w 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 :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
scientific = do
Integer
c' <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_
SP Integer
c Int
e' <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Integer -> Int -> SP
SP Integer
c' Int
0) (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s -> Integer -> m SP
dotDecimal_ (forall {k} (t :: k). Proxy t
Proxy :: Proxy s) Integer
c')
Int
e <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
e' (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
e')
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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, RealFloat a) =>
m a
float = do
Integer
c' <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal_
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( do
SP Integer
c Int
e' <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s -> Integer -> m SP
dotDecimal_ (forall {k} (t :: k). Proxy t
Proxy :: Proxy s) Integer
c'
Int
e <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
e' (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
e')
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
c Int
e)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Int -> Scientific
Sci.scientific Integer
c' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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_ :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Proxy s -> Integer -> m SP
dotDecimal_ Proxy s
pxy Integer
c' = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Integral a => SP -> a -> SP
step (Integer -> Int -> SP
SP Integer
c' Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 (a
w forall a. Num a => a -> a -> a
- a
48))
(Int
e' forall a. Num a => a -> a -> a
- Int
1)
Tokens s -> SP
mkNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"digit") Word8 -> Bool
isDigit
{-# INLINE dotDecimal_ #-}
exponent_ ::
(MonadParsec e s m, Token s ~ Word8) =>
Int ->
m Int
exponent_ :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Int -> m Int
exponent_ Int
e' = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
B.char' Token s
101)
(forall a. Num a => a -> a -> a
+ Int
e') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
signed (forall (m :: * -> *) a. Monad m => a -> m a
return ()) 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 :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
signed m ()
spc m a
p = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. a -> a
id (forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
lexeme m ()
spc m (a -> a)
sign) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p
where
sign :: m (a -> a)
sign = (forall a. a -> a
id forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
B.char Token s
43) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 forall a. Num a => a -> a -> a
- Word8
48 forall a. Ord a => a -> a -> Bool
< Word8
10
{-# INLINE isDigit #-}