{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
-- |
-- Module      :  Data.Binary.Parser.Word8
-- Copyright   :  Bryan O'Sullivan 2007-2015, Winterland 2016
-- License     :  BSD3
--
-- Maintainer  :  drkoster@qq.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple, efficient combinator parsing for 'B.ByteString' strings.
--
module Data.Binary.Parser.Word8 where

import           Control.Applicative
import           Control.Monad
import           Data.Binary.Get
import           Data.Binary.Get.Internal
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as B
import           Data.ByteString.Internal (ByteString (..))
import qualified Data.ByteString.Unsafe   as B
import           Data.Word
import           Foreign.ForeignPtr       (withForeignPtr)
import           Foreign.Ptr              (minusPtr, plusPtr)
import qualified Foreign.Storable         as Storable (Storable (peek))
import           Prelude                  hiding (takeWhile)

#if MIN_VERSION_bytestring(0,10,6)
import           Data.ByteString.Internal (accursedUnutterablePerformIO)
#else
import           Data.ByteString.Internal (inlinePerformIO)

{-# INLINE accursedUnutterablePerformIO #-}
-- | You must be truly desperate to come to me for help.
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO = inlinePerformIO
#endif

--------------------------------------------------------------------------------

-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of
-- input has been reached. Does not consume any input.
--
peekMaybe :: Get (Maybe Word8)
peekMaybe :: Get (Maybe Word8)
peekMaybe = do
    Bool
e <- Get Bool
isEmpty
    if Bool
e then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
         else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
peek
{-# INLINE peekMaybe #-}

-- | Match any byte, to perform lookahead.  Does not consume any
-- input, but will fail if end of input has been reached.
--
peek :: Get Word8
peek :: Get Word8
peek = do
    Int -> Get ()
ensureN Int
1
    ByteString
bs <- Get ByteString
get
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Word8
B.unsafeHead ByteString
bs)
{-# INLINE peek #-}

-- | The parser @satisfy p@ succeeds for any byte for which the
-- predicate @p@ returns 'True'. Returns the byte that is actually
-- parsed.
--
-- >digit = satisfy isDigit
-- >    where isDigit w = w >= 48 && w <= 57
--
satisfy :: (Word8 -> Bool) -> Get Word8
satisfy :: (Word8 -> Bool) -> Get Word8
satisfy Word8 -> Bool
p = do
    Int -> Get ()
ensureN Int
1
    ByteString
bs <- Get ByteString
get
    let w :: Word8
w = ByteString -> Word8
B.unsafeHead ByteString
bs
    if Word8 -> Bool
p Word8
w then ByteString -> Get ()
put (ByteString -> ByteString
B.unsafeTail ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w
           else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfy"
{-# INLINE satisfy #-}

-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
-- the predicate @p@ returns 'True' on the transformed value. The
-- parser returns the transformed byte that was parsed.
--
satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Get a
satisfyWith :: forall a. (Word8 -> a) -> (a -> Bool) -> Get a
satisfyWith Word8 -> a
f a -> Bool
p = do
    Int -> Get ()
ensureN Int
1
    ByteString
bs <- Get ByteString
get
    let w :: Word8
w = ByteString -> Word8
B.unsafeHead ByteString
bs
        r :: a
r = Word8 -> a
f Word8
w
    if a -> Bool
p a
r then ByteString -> Get ()
put (ByteString -> ByteString
B.unsafeTail ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
           else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfyWith"
{-# INLINE satisfyWith #-}

-- | Match a specific byte.
--
word8 :: Word8 -> Get ()
word8 :: Word8 -> Get ()
word8 Word8
c = do
    Int -> Get ()
ensureN Int
1
    ByteString
bs <- Get ByteString
get
    let w :: Word8
w = ByteString -> Word8
B.unsafeHead ByteString
bs
    if Word8
c forall a. Eq a => a -> a -> Bool
== Word8
w then ByteString -> Get ()
put (ByteString -> ByteString
B.unsafeTail ByteString
bs)
              else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"word8"
{-# INLINE word8 #-}

-- | Match any byte.
--
anyWord8 :: Get Word8
anyWord8 :: Get Word8
anyWord8 = Get Word8
getWord8
{-# INLINE anyWord8 #-}

-- | The parser @skipWord8 p@ succeeds for any byte for which the predicate @p@ returns 'True'.
--
skipWord8 :: (Word8 -> Bool) -> Get ()
skipWord8 :: (Word8 -> Bool) -> Get ()
skipWord8 Word8 -> Bool
p = do
    Int -> Get ()
ensureN Int
1
    ByteString
bs <- Get ByteString
get
    let w :: Word8
w = ByteString -> Word8
B.unsafeHead ByteString
bs
    if Word8 -> Bool
p Word8
w then ByteString -> Get ()
put (ByteString -> ByteString
B.unsafeTail ByteString
bs)
              else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"skip"
{-# INLINE skipWord8 #-}

--------------------------------------------------------------------------------

-- | This is a faster version of 'skip' for small N (smaller than chunk size).
--
skipN :: Int -> Get ()
skipN :: Int -> Get ()
skipN Int
n = do
    ByteString
bs <- Get ByteString
get
    let l :: Int
l = ByteString -> Int
B.length ByteString
bs
    if Int
l forall a. Ord a => a -> a -> Bool
> Int
n then ByteString -> Get ()
put (Int -> ByteString -> ByteString
B.unsafeDrop Int
n ByteString
bs)
             else Int -> Get ()
skip Int
n
{-# INLINE skipN #-}

-- | Consume input as long as the predicate returns 'False' or reach the end of input,
-- and return the consumed input.
--
takeTill :: (Word8 -> Bool) -> Get ByteString
takeTill :: (Word8 -> Bool) -> Get ByteString
takeTill Word8 -> Bool
p = do
    ByteString
bs <- Get ByteString
get
    let (ByteString
want, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break Word8 -> Bool
p ByteString
bs
    ByteString -> Get ()
put ByteString
rest
    if ByteString -> Bool
B.null ByteString
rest then [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Get [ByteString]
go [ByteString
want] else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
want
  where
    go :: [ByteString] -> Get [ByteString]
go [ByteString]
acc = do
        Bool
e <- Get Bool
isEmpty -- isEmpty will draw input here
        if Bool
e
        then forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc
        else do
            ByteString
bs <- Get ByteString
get
            let (ByteString
want, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break Word8 -> Bool
p ByteString
bs
                acc' :: [ByteString]
acc' = ByteString
want forall a. a -> [a] -> [a]
: [ByteString]
acc
            ByteString -> Get ()
put ByteString
rest
            if ByteString -> Bool
B.null ByteString
rest then [ByteString] -> Get [ByteString]
go [ByteString]
acc' else forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc'
{-# INLINE takeTill #-}

-- | Consume input as long as the predicate returns 'True' or reach the end of input,
-- and return the consumed input.
--
takeWhile :: (Word8 -> Bool) -> Get ByteString
takeWhile :: (Word8 -> Bool) -> Get ByteString
takeWhile Word8 -> Bool
p = do
    ByteString
bs <- Get ByteString
get
    let (ByteString
want, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
p ByteString
bs
    ByteString -> Get ()
put ByteString
rest
    if ByteString -> Bool
B.null ByteString
rest then [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Get [ByteString]
go [ByteString
want] else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
want
  where
    go :: [ByteString] -> Get [ByteString]
go [ByteString]
acc = do
        Bool
e <- Get Bool
isEmpty
        if Bool
e
        then forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc
        else do
            ByteString
bs <- Get ByteString
get
            let (ByteString
want, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
p ByteString
bs
                acc' :: [ByteString]
acc' = ByteString
want forall a. a -> [a] -> [a]
: [ByteString]
acc
            ByteString -> Get ()
put ByteString
rest
            if ByteString -> Bool
B.null ByteString
rest then [ByteString] -> Get [ByteString]
go [ByteString]
acc' else forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc'
{-# INLINE takeWhile #-}

-- | Similar to 'takeWhile', but requires the predicate to succeed on at least one byte
-- of input: it will fail if the predicate never returns 'True' or reach the end of input
--
takeWhile1 :: (Word8 -> Bool) -> Get ByteString
takeWhile1 :: (Word8 -> Bool) -> Get ByteString
takeWhile1 Word8 -> Bool
p = do
    ByteString
bs <- (Word8 -> Bool) -> Get ByteString
takeWhile Word8 -> Bool
p
    if ByteString -> Bool
B.null ByteString
bs then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"takeWhile1" else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
{-# INLINE takeWhile1 #-}

-- | Skip past input for as long as the predicate returns 'True'.
--
skipWhile :: (Word8 -> Bool) -> Get ()
skipWhile :: (Word8 -> Bool) -> Get ()
skipWhile Word8 -> Bool
p = do
    ByteString
bs <- Get ByteString
get
    let rest :: ByteString
rest = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
p ByteString
bs
    ByteString -> Get ()
put ByteString
rest
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
rest) Get ()
go
  where
    go :: Get ()
go = do
        Bool
e <- Get Bool
isEmpty
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e forall a b. (a -> b) -> a -> b
$ do
            ByteString
bs <- Get ByteString
get
            let rest :: ByteString
rest = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
p ByteString
bs
            ByteString -> Get ()
put ByteString
rest
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
rest) Get ()
go
{-# INLINE skipWhile #-}

-- | Skip over white space using 'isSpace'.
--
skipSpaces :: Get ()
skipSpaces :: Get ()
skipSpaces = (Word8 -> Bool) -> Get ()
skipWhile Word8 -> Bool
isSpace
{-# INLINE skipSpaces #-}

-- | @string s@ parses a sequence of bytes that identically match @s@.
--
string :: ByteString -> Get ()
string :: ByteString -> Get ()
string ByteString
bs = do
    let l :: Int
l = ByteString -> Int
B.length ByteString
bs
    ByteString
bs' <- Get ByteString
get
    if Int
l forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
B.length ByteString
bs'              -- current chunk is enough
    then if Int -> ByteString -> ByteString
B.unsafeTake Int
l ByteString
bs' forall a. Eq a => a -> a -> Bool
== ByteString
bs
        then ByteString -> Get ()
put (Int -> ByteString -> ByteString
B.unsafeDrop Int
l ByteString
bs')
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string"
    else do
        Int -> Get ()
ensureN Int
l
        ByteString
bs'' <- Get ByteString
get
        if Int -> ByteString -> ByteString
B.unsafeTake Int
l ByteString
bs'' forall a. Eq a => a -> a -> Bool
== ByteString
bs
        then ByteString -> Get ()
put (Int -> ByteString -> ByteString
B.unsafeDrop Int
l ByteString
bs'')
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string"
{-# INLINE string #-}

-- | A stateful scanner.  The predicate consumes and transforms a
-- state argument, and each transformed state is passed to successive
-- invocations of the predicate on each byte of the input until one
-- returns 'Nothing' or the input ends.
--
-- This parser does not fail.  It will return an empty string if the
-- predicate returns 'Nothing' on the first byte of input.
--
scan :: s -> (s -> Word8 -> Maybe s) -> Get ByteString
scan :: forall s. s -> (s -> Word8 -> Maybe s) -> Get ByteString
scan s
s0 s -> Word8 -> Maybe s
consume = forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks s
s0 s -> ByteString -> Either s (ByteString, ByteString)
consume' [ByteString] -> ByteString
B.concat (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat)
  where
    consume' :: s -> ByteString -> Either s (ByteString, ByteString)
consume' s
s1 (PS ForeignPtr Word8
fp Int
off Int
len) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 -> do
            let start :: Ptr b
start = Ptr Word8
ptr0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
                end :: Ptr b
end   = forall {b}. Ptr b
start forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
            forall {b}.
ForeignPtr Word8
-> Int
-> Ptr b
-> Ptr Word8
-> Ptr Word8
-> s
-> IO (Either s (ByteString, ByteString))
go ForeignPtr Word8
fp Int
off forall {b}. Ptr b
start forall {b}. Ptr b
end forall {b}. Ptr b
start s
s1
    go :: ForeignPtr Word8
-> Int
-> Ptr b
-> Ptr Word8
-> Ptr Word8
-> s
-> IO (Either s (ByteString, ByteString))
go ForeignPtr Word8
fp Int
off Ptr b
start Ptr Word8
end Ptr Word8
ptr !s
s
        | Ptr Word8
ptr forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
            Word8
w <- forall a. Storable a => Ptr a -> IO a
Storable.peek Ptr Word8
ptr
            case s -> Word8 -> Maybe s
consume s
s Word8
w of
                Just s
s' -> ForeignPtr Word8
-> Int
-> Ptr b
-> Ptr Word8
-> Ptr Word8
-> s
-> IO (Either s (ByteString, ByteString))
go ForeignPtr Word8
fp Int
off Ptr b
start Ptr Word8
end (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) s
s'
                Maybe s
_       -> do
                    let !len1 :: Int
len1 = Ptr Word8
ptr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
start
                        !off2 :: Int
off2 = Int
off forall a. Num a => a -> a -> a
+ Int
len1
                        !len2 :: Int
len2 = Ptr Word8
end forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
len1, ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off2 Int
len2))
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left s
s)
{-# INLINE scan #-}

-- | Similar to 'scan', but working on 'ByteString' chunks, The predicate
-- consumes a 'ByteString' chunk and transforms a state argument,
-- and each transformed state is passed to successive invocations of
-- the predicate on each chunk of the input until one chunk got splited to
-- @Right (ByteString, ByteString)@ or the input ends.
--
scanChunks :: s -> Consume s -> Get ByteString
scanChunks :: forall s. s -> Consume s -> Get ByteString
scanChunks s
s Consume s
consume = forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks s
s Consume s
consume [ByteString] -> ByteString
B.concat (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat)
{-# INLINE scanChunks #-}

--------------------------------------------------------------------------------

-- | Fast 'Word8' predicate for matching ASCII space characters
--
-- >isSpace w = w == 32 || w - 9 <= 4
--
isSpace :: Word8 -> Bool
isSpace :: Word8 -> Bool
isSpace Word8
w = Word8
w forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| Word8
w forall a. Num a => a -> a -> a
- Word8
9 forall a. Ord a => a -> a -> Bool
<= Word8
4
{-# INLINE isSpace #-}

-- | Decimal digit predicate.
--
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
9
{-# INLINE isDigit #-}

-- | Hex digit predicate.
--
isHexDigit :: Word8 -> Bool
isHexDigit :: Word8 -> Bool
isHexDigit Word8
w = (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
57) Bool -> Bool -> Bool
|| (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
102) Bool -> Bool -> Bool
|| (Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
70)
{-# INLINE isHexDigit #-}

-- | A predicate that matches either a space @\' \'@ or horizontal tab
-- @\'\\t\'@ character.
--
isHorizontalSpace :: Word8 -> Bool
isHorizontalSpace :: Word8 -> Bool
isHorizontalSpace Word8
w = Word8
w forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
9
{-# INLINE isHorizontalSpace #-}

-- | A predicate that matches either a carriage return @\'\\r\'@ or
-- newline @\'\\n\'@ character.
--
isEndOfLine :: Word8 -> Bool
isEndOfLine :: Word8 -> Bool
isEndOfLine Word8
w = Word8
w forall a. Eq a => a -> a -> Bool
== Word8
13 Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
10
{-# INLINE isEndOfLine #-}

--------------------------------------------------------------------------------

-- | Match either a single newline byte @\'\\n\'@, or a carriage
-- return followed by a newline byte @\"\\r\\n\"@.
endOfLine :: Get ()
endOfLine :: Get ()
endOfLine = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
        Word8
10 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Word8
13 -> Word8 -> Get ()
word8 Word8
10
        Word8
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"endOfLine"
{-# INLINE endOfLine #-}