-- |
-- Module      :  Data.ByteString.Parser.Char8
-- License     :  CC0-1.0
--
-- Maintainer  :  mordae@anilinux.org
-- Stability   :  unstable
-- Portability :  non-portable (ghc)
--
-- This module provides a parser for ASCII 'ByteString'.
--

module Data.ByteString.Parser.Char8
  ( Parser(..)
  , parseOnly

    -- * Characters
  , char
  , notChar
  , anyChar
  , satisfy
  , space
  , isSpace
  , skipSpace
  , peekChar

    -- * Strings
  , string
  , stringCI
  , Data.ByteString.Parser.Char8.take
  , scan
  , runScanner
  , inRange
  , notInRange
  , Data.ByteString.Parser.Char8.takeWhile
  , takeWhile1
  , takeTill
  , takeTill1

    -- * Numbers
  , signed
  , decimal
  , hexadecimal
  , octal
  , fractional

    -- * Combinators
  , provided
  , choice
  , Data.ByteString.Parser.count
  , optional
  , eitherP
  , option
  , many
  , many1
  , manyTill
  , sepBy
  , sepBy1
  , wrap
  , match

    -- * End Of Input
  , takeByteString
  , endOfInput
  , atEnd

    -- * Miscelaneous
    -- |
    -- These are all generic methods, but since I sometimes forget about them,
    -- it is nice to have them listed here for reference what writing parsers.
  , Control.Applicative.empty
  , pure
  , guard
  , when
  , unless
  , void
  )
where
  import Prelude hiding (null, length, splitAt, take)

  import Control.Applicative
  import Control.Monad

  import Data.Maybe
  import Data.Word
  import GHC.Base (unsafeChr)

  import Data.ByteString as BS
  import Data.ByteString.Unsafe as BS

  import Snack.Combinators

  import Data.ByteString.Parser ( Parser(..), parseOnly
                                , string, count, match
                                , takeByteString, endOfInput, atEnd
                                )

  import qualified Data.ByteString.Lex.Fractional as LF
  import qualified Data.ByteString.Lex.Integral as LI


  -- |
  -- Accepts a single, matching ASCII character.
  --
  {-# INLINE CONLIKE char #-}
  char :: Char -> Parser Char
  char :: Char -> Parser Char
char Char
c = (Char -> Bool) -> Parser Char
satisfy (Char
c ==)


  -- |
  -- Accepts a single, differing ASCII character.
  --
  {-# INLINE CONLIKE notChar #-}
  notChar :: Char -> Parser Char
  notChar :: Char -> Parser Char
notChar Char
c = (Char -> Bool) -> Parser Char
satisfy (Char
c /=)


  -- |
  -- Accepts a single character.
  --
  {-# INLINE anyChar #-}
  anyChar :: Parser Char
  anyChar :: Parser Char
anyChar = (ByteString -> Maybe (Char, ByteString)) -> Parser Char
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then Maybe (Char, ByteString)
forall a. Maybe a
Nothing
       else (Char, ByteString) -> Maybe (Char, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Char
w2c (ByteString -> Word8
unsafeHead ByteString
inp), ByteString -> ByteString
unsafeTail ByteString
inp)


  -- |
  -- Accepts a single character matching the predicate.
  --
  {-# INLINE CONLIKE satisfy #-}
  satisfy :: (Char -> Bool) -> Parser Char
  satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isOk = (ByteString -> Maybe (Char, ByteString)) -> Parser Char
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then Maybe (Char, ByteString)
forall a. Maybe a
Nothing
       else let c :: Char
c = Word8 -> Char
w2c (ByteString -> Word8
unsafeHead ByteString
inp)
             in if Char -> Bool
isOk Char
c
                   then (Char, ByteString) -> Maybe (Char, ByteString)
forall a. a -> Maybe a
Just (Char
c, ByteString -> ByteString
unsafeTail ByteString
inp)
                   else Maybe (Char, ByteString)
forall a. Maybe a
Nothing


  -- |
  -- Accepts a single ASCII white space character.
  -- See 'isSpace' for details.
  --
  {-# INLINE space #-}
  space :: Parser Char
  space :: Parser Char
space = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isSpace


  -- |
  -- Accepts multiple ASCII white space characters.
  -- See 'isSpace' for details.
  --
  {-# INLINE skipSpace #-}
  skipSpace :: Parser ()
  skipSpace :: Parser ()
skipSpace = Parser ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ()) -> Parser ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString
Data.ByteString.Parser.Char8.takeWhile Char -> Bool
isSpace


  -- |
  -- True for any of the @[' ', '\\t', '\\n', '\\v', '\\f', '\\r']@ characters.
  --
  -- Please note that "Data.Text.Parser" re-exports 'Data.Char.isString', that
  -- considers more unicode codepoints, making it significantly slower.
  --
  {-# INLINE isSpace #-}
  isSpace :: Char -> Bool
  isSpace :: Char -> Bool
isSpace Char
c = (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Bool -> Bool -> Bool
|| (Char
'\t' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\r')


  -- |
  -- Peeks ahead, but does not consume.
  --
  -- Be careful, peeking behind end of the input fails.
  -- You might want to check using 'atEnd' beforehand.
  --
  {-# INLINE peekChar #-}
  peekChar :: Parser Char
  peekChar :: Parser Char
peekChar = (ByteString -> Maybe (Char, ByteString)) -> Parser Char
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    if ByteString -> Bool
null ByteString
inp
       then Maybe (Char, ByteString)
forall a. Maybe a
Nothing
       else (Char, ByteString) -> Maybe (Char, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Char
w2c (ByteString -> Word8
unsafeHead ByteString
inp), ByteString
inp)


  -- |
  -- Accepts a matching string.
  -- Matching is performed in a case-insensitive manner under ASCII.
  --
  {-# INLINE CONLIKE stringCI #-}
  stringCI :: ByteString -> Parser ByteString
  stringCI :: ByteString -> Parser ByteString
stringCI ByteString
str = (ByteString -> Maybe (ByteString, ByteString)) -> Parser ByteString
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    let (ByteString
pfx, ByteString
sfx) = Int -> ByteString -> (ByteString, ByteString)
splitAt (ByteString -> Int
length ByteString
str) ByteString
inp
     in case ByteString -> ByteString
toCaseFold ByteString
pfx ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
toCaseFold ByteString
str of
          Bool
True -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
pfx, ByteString
sfx)
          Bool
False -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing


  -- |
  -- Perform simple ASCII case folding.
  --
  {-# INLINE toCaseFold #-}
  toCaseFold :: ByteString -> ByteString
  toCaseFold :: ByteString -> ByteString
toCaseFold = (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
forall {a}. (Ord a, Num a) => a -> a
foldCase
    where foldCase :: a -> a
foldCase a
w | a
65 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
90 = a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
32
          foldCase a
w = a
w


  -- |
  -- Accepts given number of characters.
  -- Fails when not enough characters are available.
  --
  {-# INLINE CONLIKE take #-}
  take :: Int -> Parser ByteString
  take :: Int -> Parser ByteString
take Int
n = (ByteString -> Maybe (ByteString, ByteString)) -> Parser ByteString
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
length ByteString
inp
       then Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
       else (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (Int -> ByteString -> (ByteString, ByteString)
splitAt Int
n ByteString
inp)


  -- |
  -- Scans ahead statefully and then accepts whatever bytes the scanner liked.
  -- Scanner returns 'Nothing' to mark end of the acceptable extent.
  --
  {-# INLINE CONLIKE scan #-}
  scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString
  scan :: forall s. s -> (s -> Char -> Maybe s) -> Parser ByteString
scan s
state s -> Char -> Maybe s
scanner = (ByteString, s) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, s) -> ByteString)
-> Parser (ByteString, s) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> (s -> Char -> Maybe s) -> Parser (ByteString, s)
forall s. s -> (s -> Char -> Maybe s) -> Parser (ByteString, s)
runScanner s
state s -> Char -> Maybe s
scanner


  -- |
  -- Like 'scan', but also returns the final scanner state.
  --
  {-# INLINE CONLIKE runScanner #-}
  runScanner :: s -> (s -> Char -> Maybe s) -> Parser (ByteString, s)
  runScanner :: forall s. s -> (s -> Char -> Maybe s) -> Parser (ByteString, s)
runScanner s
state s -> Char -> Maybe s
scanner = (ByteString -> Maybe ((ByteString, s), ByteString))
-> Parser (ByteString, s)
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp -> ByteString -> s -> Int -> Maybe ((ByteString, s), ByteString)
loop ByteString
inp s
state Int
0
    where
      loop :: ByteString -> s -> Int -> Maybe ((ByteString, s), ByteString)
loop ByteString
inp !s
st !Int
n =
        case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
inp of
          Bool
True -> ((ByteString, s), ByteString)
-> Maybe ((ByteString, s), ByteString)
forall a. a -> Maybe a
Just ((ByteString
inp, s
st), ByteString
forall a. Monoid a => a
mempty)
          Bool
False ->
            case ByteString -> Int -> Word8
unsafeIndex ByteString
inp Int
n of
              Word8
w ->
                case s -> Char -> Maybe s
scanner s
st (Word8 -> Char
w2c Word8
w) of
                  Maybe s
Nothing -> ((ByteString, s), ByteString)
-> Maybe ((ByteString, s), ByteString)
forall a. a -> Maybe a
Just ((Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
inp, s
st), Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
inp)
                  Just s
st' -> ByteString -> s -> Int -> Maybe ((ByteString, s), ByteString)
loop ByteString
inp s
st' (Int -> Int
forall a. Enum a => a -> a
succ Int
n)


  -- |
  -- Efficiently consume as long as the input characters match the predicate.
  -- An inverse of 'takeTill'.
  --
  {-# INLINE CONLIKE takeWhile #-}
  takeWhile :: (Char -> Bool) -> Parser ByteString
  takeWhile :: (Char -> Bool) -> Parser ByteString
takeWhile Char -> Bool
test = (Char -> Bool) -> Parser ByteString
takeTill (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
test)


  -- |
  -- Like 'takeWhile', but requires at least a single character.
  --
  {-# INLINE CONLIKE takeWhile1 #-}
  takeWhile1 :: (Char -> Bool) -> Parser ByteString
  takeWhile1 :: (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
test = (ByteString -> Bool) -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
(a -> Bool) -> m a -> m a
provided (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
null) (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$
                    (Char -> Bool) -> Parser ByteString
Data.ByteString.Parser.Char8.takeWhile Char -> Bool
test


  -- |
  -- Efficiently consume until a character matching the predicate is found.
  -- An inverse of 'Data.ByteString.Parser.Char8.takeWhile'.
  --
  {-# INLINE CONLIKE takeTill #-}
  takeTill :: (Char -> Bool) -> Parser ByteString
  takeTill :: (Char -> Bool) -> Parser ByteString
takeTill Char -> Bool
test = (ByteString -> Maybe (ByteString, ByteString)) -> Parser ByteString
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser \ByteString
inp ->
    let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (ByteString -> Int
length ByteString
inp) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex (Char -> Bool
test (Char -> Bool) -> (Word8 -> Char) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c) ByteString
inp
     in (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (Int -> ByteString -> (ByteString, ByteString)
splitAt Int
n ByteString
inp)


  -- |
  -- Same as 'takeTill', but requires at least a single character.
  --
  {-# INLINE CONLIKE takeTill1 #-}
  takeTill1 :: (Char -> Bool) -> Parser ByteString
  takeTill1 :: (Char -> Bool) -> Parser ByteString
takeTill1 Char -> Bool
test = (ByteString -> Bool) -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
(a -> Bool) -> m a -> m a
provided (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
null) (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$
                    (Char -> Bool) -> Parser ByteString
Data.ByteString.Parser.Char8.takeTill Char -> Bool
test


  -- |
  -- Accepts optional @\'+\'@ or @\'-\'@ character and then applies it to
  -- the following parser result.
  --
  {-# INLINE signed #-}
  signed :: (Num a) => Parser a -> Parser a
  signed :: forall a. Num a => Parser a -> Parser a
signed Parser a
runNumber = (Char -> Parser Char
char Char
'-' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'+' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser a
runNumber)


  -- |
  -- Accepts an integral number in the decimal format.
  --
  {-# INLINE decimal #-}
  decimal :: (Integral a) => Parser a
  decimal :: forall a. Integral a => Parser a
decimal = (ByteString -> Maybe (a, ByteString)) -> Parser a
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readDecimal


  -- |
  -- Accepts an integral number in the hexadecimal format in either case.
  -- Does not look for @0x@ or similar prefixes.
  --
  {-# INLINE hexadecimal #-}
  hexadecimal :: (Integral a) => Parser a
  hexadecimal :: forall a. Integral a => Parser a
hexadecimal = (ByteString -> Maybe (a, ByteString)) -> Parser a
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readHexadecimal


  -- |
  -- Accepts an integral number in the octal format.
  --
  {-# INLINE octal #-}
  octal :: (Integral a) => Parser a
  octal :: forall a. Integral a => Parser a
octal = (ByteString -> Maybe (a, ByteString)) -> Parser a
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
LI.readOctal


  -- |
  -- Accepts a fractional number as a decimal optinally followed by a colon
  -- and the fractional part. Does not support exponentiation.
  --
  {-# INLINE fractional #-}
  fractional :: (Fractional a) => Parser a
  fractional :: forall a. Fractional a => Parser a
fractional = (ByteString -> Maybe (a, ByteString)) -> Parser a
forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
Parser ByteString -> Maybe (a, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
LF.readDecimal


  {-# INLINE w2c #-}
  w2c :: Word8 -> Char
  w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- vim:set ft=haskell sw=2 ts=2 et: