Lexer.hs

{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Module      :  Text.Megaparsec.Byte.Lexer
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Stripped-down version of "Text.Megaparsec.Char.Lexer" for streams of
-- bytes.
--
-- This module is intended to be imported qualified:
--
-- > import qualified Text.Megaparsec.Byte.Lexer as L
module Text.Megaparsec.Byte.Lexer
  ( -- * White space
    space,
    lexeme,
    symbol,
    symbol',
    skipLineComment,
    skipBlockComment,
    skipBlockCommentNested,

    -- * Numbers
    decimal,
    binary,
    octal,
    hexadecimal,
    scientific,
    float,
    signed,
  )
where

import Control.Applicative
import Data.Functor (void)
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

----------------------------------------------------------------------------
-- White space

-- | Given a comment prefix this function returns a parser that skips line
-- comments. Note that it stops just before the newline character but
-- doesn't consume the newline. Newline is either supposed to be consumed by
-- 'space' parser or picked up manually.
skipLineComment ::
  (MonadParsec e s m, Token s ~ Word8) =>
  -- | Line comment prefix
  Tokens s ->
  m ()
skipLineComment prefix =
  B.string prefix *> void (takeWhileP (Just "character") (/= 10))
{-# INLINEABLE skipLineComment #-}

-- | @'skipBlockComment' start end@ skips non-nested block comment starting
-- with @start@ and ending with @end@.
skipBlockComment ::
  (MonadParsec e s m) =>
  -- | Start of block comment
  Tokens s ->
  -- | End of block comment
  Tokens s ->
  m ()
skipBlockComment start end = p >> void (manyTill anySingle n)
  where
    p = B.string start
    n = B.string end
{-# INLINEABLE skipBlockComment #-}

-- | @'skipBlockCommentNested' start end@ skips possibly nested block
-- comment starting with @start@ and ending with @end@.
--
-- @since 5.0.0
skipBlockCommentNested ::
  (MonadParsec e s m, Token s ~ Word8) =>
  -- | Start of block comment
  Tokens s ->
  -- | End of block comment
  Tokens s ->
  m ()
skipBlockCommentNested start end = p >> void (manyTill e n)
  where
    e = skipBlockCommentNested start end <|> void anySingle
    p = B.string start
    n = B.string end
{-# INLINEABLE skipBlockCommentNested #-}

----------------------------------------------------------------------------
-- Numbers

-- | Parse an integer in the decimal representation according to the format
-- of integer literals described in the Haskell report.
--
-- If you need to parse signed integers, see the 'signed' combinator.
--
-- __Warning__: this function does not perform range checks.
decimal ::
  forall e s m a.
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  m a
decimal = decimal_ <?> "integer"
{-# INLINEABLE decimal #-}

-- | A non-public helper to parse decimal integers.
decimal_ ::
  forall e s m a.
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  m a
decimal_ = mkNum <$> takeWhile1P (Just "digit") isDigit
  where
    mkNum = fromInteger . foldl' step 0 . chunkToTokens (Proxy :: Proxy s)
    step a w = a * 10 + fromIntegral (w - 48)
{-# INLINE decimal_ #-}

-- | Parse an integer in the binary representation. The binary number is
-- expected to be a non-empty sequence of zeroes “0” and ones “1”.
--
-- You could of course parse some prefix before the actual number:
--
-- > binary = char 48 >> char' 98 >> L.binary
--
-- __Warning__: this function does not perform range checks.
--
-- @since 7.0.0
binary ::
  forall e s m a.
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  m a
binary =
  mkNum
    <$> takeWhile1P Nothing isBinDigit
    <?> "binary integer"
  where
    mkNum = fromInteger . foldl' step 0 . chunkToTokens (Proxy :: Proxy s)
    step a w = a * 2 + fromIntegral (w - 48)
    isBinDigit w = w == 48 || w == 49
{-# INLINEABLE binary #-}

-- | Parse an integer in the octal representation. The format of the octal
-- number is expected to be according to the Haskell report except for the
-- fact that this parser doesn't parse “0o” or “0O” prefix. It is a
-- responsibility of the programmer to parse correct prefix before parsing
-- the number itself.
--
-- For example you can make it conform to the Haskell report like this:
--
-- > octal = char 48 >> char' 111 >> L.octal
--
-- __Warning__: this function does not perform range checks.
octal ::
  forall e s m a.
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  m a
octal =
  mkNum
    <$> takeWhile1P Nothing isOctDigit
    <?> "octal integer"
  where
    mkNum = fromInteger . foldl' step 0 . chunkToTokens (Proxy :: Proxy s)
    step a w = a * 8 + fromIntegral (w - 48)
    isOctDigit w = w - 48 < 8
{-# INLINEABLE octal #-}

-- | Parse an integer in the hexadecimal representation. The format of the
-- hexadecimal number is expected to be according to the Haskell report
-- except for the fact that this parser doesn't parse “0x” or “0X” prefix.
-- It is a responsibility of the programmer to parse correct prefix before
-- parsing the number itself.
--
-- For example you can make it conform to the Haskell report like this:
--
-- > hexadecimal = char 48 >> char' 120 >> L.hexadecimal
--
-- __Warning__: this function does not perform range checks.
hexadecimal ::
  forall e s m a.
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  m a
hexadecimal =
  mkNum
    <$> takeWhile1P Nothing isHexDigit
    <?> "hexadecimal integer"
  where
    mkNum = fromInteger . foldl' step 0 . chunkToTokens (Proxy :: Proxy s)
    step a w
      | w >= 48 && w <= 57 = a * 16 + fromIntegral (w - 48)
      | w >= 97 = a * 16 + fromIntegral (w - 87)
      | otherwise = a * 16 + fromIntegral (w - 55)
    isHexDigit w =
      (w >= 48 && w <= 57)
        || (w >= 97 && w <= 102)
        || (w >= 65 && w <= 70)
{-# INLINEABLE hexadecimal #-}

-- | Parse a floating point value as a 'Scientific' number. 'Scientific' is
-- great for parsing of arbitrary precision numbers coming from an untrusted
-- source. See documentation in "Data.Scientific" for more information.
--
-- The parser can be used to parse integers or floating point values. Use
-- functions like 'Data.Scientific.floatingOrInteger' from "Data.Scientific"
-- to test and extract integer or real values.
--
-- This function does not parse sign, if you need to parse signed numbers,
-- see 'signed'.
scientific ::
  forall e s m.
  (MonadParsec e s m, Token s ~ Word8) =>
  m Scientific
scientific = do
  c' <- 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

-- | Parse a floating point number according to the syntax for floating
-- point literals described in the Haskell report.
--
-- This function does not parse sign, if you need to parse signed numbers,
-- see 'signed'.
--
-- __Note__: in versions /6.0.0/–/6.1.1/ this function accepted plain integers.
float :: (MonadParsec e s m, Token s ~ Word8, RealFloat a) => m a
float = do
  c' <- 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 ~ Word8) =>
  Proxy s ->
  Integer ->
  m SP
dotDecimal_ pxy c' = do
  void (B.char 46)
  let mkNum = foldl' step (SP c' 0) . chunkToTokens pxy
      step (SP a e') w =
        SP
          (a * 10 + fromIntegral (w - 48))
          (e' - 1)
  mkNum <$> takeWhile1P (Just "digit") isDigit
{-# INLINE dotDecimal_ #-}

exponent_ ::
  (MonadParsec e s m, Token s ~ Word8) =>
  Int ->
  m Int
exponent_ e' = do
  void (B.char' 101)
  (+ e') <$> signed (return ()) decimal_
{-# INLINE exponent_ #-}

-- | @'signed' space p@ parser parses an optional sign character (“+” or
-- “-”), then if there is a sign it consumes optional white space (using
-- @space@ parser), then it runs parser @p@ which should return a number.
-- Sign of the number is changed according to the previously parsed sign
-- character.
--
-- For example, to parse signed integer you can write:
--
-- > lexeme        = L.lexeme spaceConsumer
-- > integer       = lexeme L.decimal
-- > signedInteger = L.signed spaceConsumer integer
signed ::
  (MonadParsec e s m, Token s ~ Word8, Num a) =>
  -- | How to consume white space after the sign
  m () ->
  -- | How to parse the number itself
  m a ->
  -- | Parser for signed numbers
  m a
signed spc p = option id (lexeme spc sign) <*> p
  where
    sign = (id <$ B.char 43) <|> (negate <$ B.char 45)
{-# INLINEABLE signed #-}

----------------------------------------------------------------------------
-- Helpers

-- | A fast predicate to check if the given 'Word8' is a digit in ASCII.
isDigit :: Word8 -> Bool
isDigit w = w - 48 < 10
{-# INLINE isDigit #-}