{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
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 #-}
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO = inlinePerformIO
#endif
peekMaybe :: Get (Maybe Word8)
peekMaybe :: Get (Maybe Word8)
peekMaybe = do
Bool
e <- Get Bool
isEmpty
if Bool
e then Maybe Word8 -> Get (Maybe Word8)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word8
forall a. Maybe a
Nothing
else Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Get Word8 -> Get (Maybe Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
peek
{-# INLINE peekMaybe #-}
peek :: Get Word8
peek :: Get Word8
peek = do
Int -> Get ()
ensureN Int
1
ByteString
bs <- Get ByteString
get
Word8 -> Get Word8
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Word8
B.unsafeHead ByteString
bs)
{-# INLINE peek #-}
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) Get () -> Get Word8 -> Get Word8
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Get Word8
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w
else String -> Get Word8
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfy"
{-# INLINE satisfy #-}
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) Get () -> Get a -> Get a
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Get a
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
else String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"satisfyWith"
{-# INLINE satisfyWith #-}
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w then ByteString -> Get ()
put (ByteString -> ByteString
B.unsafeTail ByteString
bs)
else String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"word8"
{-# INLINE word8 #-}
anyWord8 :: Get Word8
anyWord8 :: Get Word8
anyWord8 = Get Word8
getWord8
{-# INLINE anyWord8 #-}
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 String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"skip"
{-# INLINE skipWord8 #-}
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 Int -> Int -> Bool
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 #-}
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 ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Get [ByteString]
go [ByteString
want] else ByteString -> Get ByteString
forall a. a -> Get a
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 [ByteString] -> Get [ByteString]
forall a. a -> Get a
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 ByteString -> [ByteString] -> [ByteString]
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 [ByteString] -> Get [ByteString]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc'
{-# INLINE takeTill #-}
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 ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Get [ByteString]
go [ByteString
want] else ByteString -> Get ByteString
forall a. a -> Get a
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 [ByteString] -> Get [ByteString]
forall a. a -> Get a
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 ByteString -> [ByteString] -> [ByteString]
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 [ByteString] -> Get [ByteString]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
acc'
{-# INLINE takeWhile #-}
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 String -> Get ByteString
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"takeWhile1" else ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
{-# INLINE takeWhile1 #-}
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
Bool -> Get () -> Get ()
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
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (Get () -> Get ()) -> Get () -> Get ()
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
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
rest) Get ()
go
{-# INLINE skipWhile #-}
skipSpaces :: Get ()
skipSpaces :: Get ()
skipSpaces = (Word8 -> Bool) -> Get ()
skipWhile Word8 -> Bool
isSpace
{-# INLINE skipSpaces #-}
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
B.length ByteString
bs'
then if Int -> ByteString -> ByteString
B.unsafeTake Int
l ByteString
bs' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs
then ByteString -> Get ()
put (Int -> ByteString -> ByteString
B.unsafeDrop Int
l ByteString
bs')
else String -> Get ()
forall a. String -> Get a
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'' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs
then ByteString -> Get ()
put (Int -> ByteString -> ByteString
B.unsafeDrop Int
l ByteString
bs'')
else String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string"
{-# INLINE string #-}
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 = s
-> Consume s
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks s
s0 Consume s
consume' [ByteString] -> ByteString
B.concat (ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat)
where
consume' :: Consume s
consume' s
s1 (PS ForeignPtr Word8
fp Int
off Int
len) = IO (Either s (ByteString, ByteString))
-> Either s (ByteString, ByteString)
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Either s (ByteString, ByteString))
-> Either s (ByteString, ByteString))
-> IO (Either s (ByteString, ByteString))
-> Either s (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8
-> (Ptr Word8 -> IO (Either s (ByteString, ByteString)))
-> IO (Either s (ByteString, ByteString))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (Either s (ByteString, ByteString)))
-> IO (Either s (ByteString, ByteString)))
-> (Ptr Word8 -> IO (Either s (ByteString, ByteString)))
-> IO (Either s (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 -> do
let start :: Ptr b
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
end :: Ptr b
end = Ptr Any
forall {b}. Ptr b
start Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
ForeignPtr Word8
-> Int
-> Ptr Any
-> Ptr Word8
-> Ptr Word8
-> s
-> IO (Either s (ByteString, ByteString))
forall {b}.
ForeignPtr Word8
-> Int
-> Ptr b
-> Ptr Word8
-> Ptr Word8
-> s
-> IO (Either s (ByteString, ByteString))
go ForeignPtr Word8
fp Int
off Ptr Any
forall {b}. Ptr b
start Ptr Word8
forall {b}. Ptr b
end Ptr Word8
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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
Word8
w <- Ptr Word8 -> IO Word8
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) s
s'
Maybe s
_ -> do
let !len1 :: Int
len1 = Ptr Word8
ptr Ptr Word8 -> Ptr b -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
start
!off2 :: Int
off2 = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1
!len2 :: Int
len2 = Ptr Word8
end Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
Either s (ByteString, ByteString)
-> IO (Either s (ByteString, ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> Either s (ByteString, ByteString)
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 = Either s (ByteString, ByteString)
-> IO (Either s (ByteString, ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Either s (ByteString, ByteString)
forall a b. a -> Either a b
Left s
s)
{-# INLINE scan #-}
scanChunks :: s -> Consume s -> Get ByteString
scanChunks :: forall s. s -> Consume s -> Get ByteString
scanChunks s
s Consume s
consume = s
-> Consume s
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks s
s Consume s
consume [ByteString] -> ByteString
B.concat (ByteString -> Get ByteString
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat)
{-# INLINE scanChunks #-}
isSpace :: Word8 -> Bool
isSpace :: Word8 -> Bool
isSpace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
9 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
4
{-# INLINE isSpace #-}
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9
{-# INLINE isDigit #-}
isHexDigit :: Word8 -> Bool
isHexDigit :: Word8 -> Bool
isHexDigit Word8
w = (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57) Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
102) Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
70)
{-# INLINE isHexDigit #-}
isHorizontalSpace :: Word8 -> Bool
isHorizontalSpace :: Word8 -> Bool
isHorizontalSpace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9
{-# INLINE isHorizontalSpace #-}
isEndOfLine :: Word8 -> Bool
isEndOfLine :: Word8 -> Bool
isEndOfLine Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10
{-# INLINE isEndOfLine #-}
endOfLine :: Get ()
endOfLine :: Get ()
endOfLine = do
Word8
w <- Get Word8
getWord8
case Word8
w of
Word8
10 -> () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Word8
13 -> Word8 -> Get ()
word8 Word8
10
Word8
_ -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"endOfLine"
{-# INLINE endOfLine #-}