{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 Data.Word (Word8)
import Text.Megaparsec
import Text.Megaparsec.Lexer
import qualified Data.Scientific as Sci
import qualified Text.Megaparsec.Byte as B
skipLineComment :: (MonadParsec e s m, Token s ~ Word8)
=> Tokens s
-> m ()
prefix :: 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 "character") (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 10))
{-# INLINEABLE skipLineComment #-}
skipBlockComment :: (MonadParsec e s m, Token s ~ Word8)
=> Tokens s
-> Tokens s
-> m ()
start :: Tokens s
start end :: 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 ()
start :: Tokens s
start end :: 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
<?> "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 "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 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 a -> a -> a
forall a. Num 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
- 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
<?> "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 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 a -> a -> a
forall a. Num 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
- 48)
isBinDigit :: a -> Bool
isBinDigit w :: a
w = a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 48 Bool -> Bool -> Bool
|| a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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
<?> "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 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 a -> a -> a
forall a. Num 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
- 48)
isOctDigit :: a -> Bool
isOctDigit w :: a
w = a
w a -> a -> a
forall a. Num a => a -> a -> a
- 48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 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
<?> "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 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
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 57 = a
a a -> a -> a
forall a. Num 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
- 48)
| a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 97 = a
a a -> a -> a
forall a. Num 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
- 87)
| Bool
otherwise = a
a a -> a -> a
forall a. Num 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
- 55)
isHexDigit :: a -> Bool
isHexDigit w :: a
w =
(a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 57) Bool -> Bool -> Bool
||
(a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 97 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 102) Bool -> Bool -> Bool
||
(a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 65 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 c :: Integer
c e' :: Int
e' <- SP -> m SP -> m SP
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Integer -> Int -> SP
SP Integer
c' 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 c :: Integer
c e' :: 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_ 0))
{-# INLINEABLE float #-}
dotDecimal_ :: (MonadParsec e s m, Token s ~ Word8)
=> Proxy s
-> Integer
-> m SP
dotDecimal_ :: Proxy s -> Integer -> m SP
dotDecimal_ pxy :: Proxy s
pxy c' :: 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 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' 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 a :: Integer
a e' :: Int
e') w :: a
w = Integer -> Int -> SP
SP
(Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 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
- 48))
(Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 "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_ e' :: 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' 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 spc :: m ()
spc p :: 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 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 45)
{-# INLINEABLE signed #-}
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit w :: Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 48 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 10
{-# INLINE isDigit #-}