{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Socks5.Parse
( Parser
, Result(..)
, parse
, parseFeed
, byte
, anyByte
, bytes
, take
, takeWhile
, takeAll
, skip
, skipWhile
, skipAll
, takeStorable
) where
import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B (toForeignPtr)
import Data.Word
import Foreign.Storable (Storable, peekByteOff, sizeOf)
import Foreign.ForeignPtr (withForeignPtr)
import Prelude hiding (take, takeWhile)
import System.IO.Unsafe (unsafePerformIO)
data Result a =
ParseFail String
| ParseMore (ByteString -> Result a)
| ParseOK ByteString a
instance Show a => Show (Result a) where
show :: Result a -> String
show (ParseFail err :: String
err) = "ParseFailure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
show (ParseMore _) = "ParseMore _"
show (ParseOK b :: ByteString
b a :: a
a) = "ParseOK " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
b
type Failure r = ByteString -> String -> Result r
type Success a r = ByteString -> a -> Result r
newtype Parser a = Parser
{ Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser :: forall r . ByteString -> Failure r -> Success a r -> Result r }
instance Monad Parser where
return :: a -> Parser a
return v :: a
v = (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a)
-> (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf _ ok :: Success a r
ok -> Success a r
ok ByteString
buf a
v
m :: Parser a
m >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= k :: a -> Parser b
k = (forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b)
-> (forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success b r
ok ->
Parser a -> ByteString -> Failure r -> Success a r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser a
m ByteString
buf Failure r
err (\buf' :: ByteString
buf' a :: a
a -> Parser b -> ByteString -> Failure r -> Success b r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (a -> Parser b
k a
a) ByteString
buf' Failure r
err Success b r
ok)
#if MIN_VERSION_base(4,13,0)
instance MonadFail Parser where
#endif
fail :: String -> Parser a
fail errorMsg :: String
errorMsg = (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a)
-> (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err _ -> Failure r
err ByteString
buf ("failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errorMsg)
instance MonadPlus Parser where
mzero :: Parser a
mzero = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Parser.MonadPlus.mzero"
mplus :: Parser a -> Parser a -> Parser a
mplus f :: Parser a
f g :: Parser a
g = (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a)
-> (forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success a r
ok ->
Parser a -> ByteString -> Failure r -> Success a r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser a
f ByteString
buf (\_ _ -> Parser a -> ByteString -> Failure r -> Success a r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser a
g ByteString
buf Failure r
err Success a r
ok) Success a r
ok
instance Functor Parser where
fmap :: (a -> b) -> Parser a -> Parser b
fmap f :: a -> b
f p :: Parser a
p = (forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b)
-> (forall r. ByteString -> Failure r -> Success b r -> Result r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success b r
ok ->
Parser a -> ByteString -> Failure r -> Success a r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser a
p ByteString
buf Failure r
err (\b :: ByteString
b a :: a
a -> Success b r
ok ByteString
b (a -> b
f a
a))
instance Applicative Parser where
pure :: a -> Parser a
pure = a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Parser (a -> b) -> Parser a -> Parser b
(<*>) d :: Parser (a -> b)
d e :: Parser a
e = Parser (a -> b)
d Parser (a -> b) -> ((a -> b) -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: a -> b
b -> Parser a
e Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> b -> Parser b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
instance Alternative Parser where
empty :: Parser a
empty = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Parser.Alternative.empty"
<|> :: Parser a -> Parser a -> Parser a
(<|>) = Parser a -> Parser a -> Parser a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
parseFeed :: Monad m => m B.ByteString -> Parser a -> B.ByteString -> m (Result a)
parseFeed :: m ByteString -> Parser a -> ByteString -> m (Result a)
parseFeed feeder :: m ByteString
feeder p :: Parser a
p initial :: ByteString
initial = Result a -> m (Result a)
forall a. Result a -> m (Result a)
loop (Result a -> m (Result a)) -> Result a -> m (Result a)
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
parse Parser a
p ByteString
initial
where loop :: Result a -> m (Result a)
loop (ParseMore k :: ByteString -> Result a
k) = m ByteString
feeder m ByteString -> (ByteString -> m (Result a)) -> m (Result a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Result a -> m (Result a)
loop (Result a -> m (Result a))
-> (ByteString -> Result a) -> ByteString -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result a
k)
loop r :: Result a
r = Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
r
parse :: Parser a -> ByteString -> Result a
parse :: Parser a -> ByteString -> Result a
parse p :: Parser a
p s :: ByteString
s = Parser a -> ByteString -> Failure a -> Success a a -> Result a
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser a
p ByteString
s (\_ msg :: String
msg -> String -> Result a
forall a. String -> Result a
ParseFail String
msg) (\b :: ByteString
b a :: a
a -> Success a a
forall a. ByteString -> a -> Result a
ParseOK ByteString
b a
a)
getMore :: Parser ()
getMore :: Parser ()
getMore = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok -> (ByteString -> Result r) -> Result r
forall a. (ByteString -> Result a) -> Result a
ParseMore ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \nextChunk :: ByteString
nextChunk ->
if ByteString -> Bool
B.null ByteString
nextChunk
then Failure r
err ByteString
buf "EOL: need more data"
else Success () r
ok (ByteString -> ByteString -> ByteString
B.append ByteString
buf ByteString
nextChunk) ()
getAll :: Parser ()
getAll :: Parser ()
getAll = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok -> (ByteString -> Result r) -> Result r
forall a. (ByteString -> Result a) -> Result a
ParseMore ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \nextChunk :: ByteString
nextChunk ->
if ByteString -> Bool
B.null ByteString
nextChunk
then Success () r
ok ByteString
buf ()
else Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser ()
getAll (ByteString -> ByteString -> ByteString
B.append ByteString
buf ByteString
nextChunk) Failure r
err Success () r
ok
flushAll :: Parser ()
flushAll :: Parser ()
flushAll = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok -> (ByteString -> Result r) -> Result r
forall a. (ByteString -> Result a) -> Result a
ParseMore ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \nextChunk :: ByteString
nextChunk ->
if ByteString -> Bool
B.null ByteString
nextChunk
then Success () r
ok ByteString
buf ()
else Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser ()
getAll ByteString
B.empty Failure r
err Success () r
ok
anyByte :: Parser Word8
anyByte :: Parser Word8
anyByte = (forall r. ByteString -> Failure r -> Success Word8 r -> Result r)
-> Parser Word8
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success Word8 r -> Result r)
-> Parser Word8)
-> (forall r.
ByteString -> Failure r -> Success Word8 r -> Result r)
-> Parser Word8
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success Word8 r
ok ->
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
buf of
Nothing -> Parser Word8
-> ByteString -> Failure r -> Success Word8 r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser Word8 -> Parser Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Word8
anyByte) ByteString
buf Failure r
err Success Word8 r
ok
Just (c1 :: Word8
c1,b2 :: ByteString
b2) -> Success Word8 r
ok ByteString
b2 Word8
c1
byte :: Word8 -> Parser ()
byte :: Word8 -> Parser ()
byte w :: Word8
w = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok ->
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
buf of
Nothing -> Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser ()
byte Word8
w) ByteString
buf Failure r
err Success () r
ok
Just (c1 :: Word8
c1,b2 :: ByteString
b2) | Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w -> Success () r
ok ByteString
b2 ()
| Bool
otherwise -> Failure r
err ByteString
buf ("byte " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ " : failed")
bytes :: ByteString -> Parser ()
bytes :: ByteString -> Parser ()
bytes allExpected :: ByteString
allExpected = ByteString -> Parser ()
consumeEq ByteString
allExpected
where errMsg :: String
errMsg = "bytes " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
allExpected String -> ShowS
forall a. [a] -> [a] -> [a]
++ " : failed"
consumeEq :: ByteString -> Parser ()
consumeEq expected :: ByteString
expected = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \actual :: ByteString
actual err :: Failure r
err ok :: Success () r
ok ->
let eLen :: Int
eLen = ByteString -> Int
B.length ByteString
expected in
if ByteString -> Int
B.length ByteString
actual Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
eLen
then
let (aMatch :: ByteString
aMatch,aRem :: ByteString
aRem) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
eLen ByteString
actual
in if ByteString
aMatch ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expected
then Success () r
ok ByteString
aRem ()
else Failure r
err ByteString
actual String
errMsg
else
let (eMatch :: ByteString
eMatch, eRem :: ByteString
eRem) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
actual) ByteString
expected
in if ByteString
actual ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
eMatch
then Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ()
consumeEq ByteString
eRem) ByteString
B.empty Failure r
err Success () r
ok
else Failure r
err ByteString
actual String
errMsg
takeStorable :: Storable d
=> Parser d
takeStorable :: Parser d
takeStorable = d -> Parser d
forall d. Storable d => d -> Parser d
anyStorable d
forall a. HasCallStack => a
undefined
where
anyStorable :: Storable d => d -> Parser d
anyStorable :: d -> Parser d
anyStorable a :: d
a = do
(fptr :: ForeignPtr Word8
fptr, off :: Int
off, _) <- ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> Parser ByteString -> Parser (ForeignPtr Word8, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString
take (d -> Int
forall a. Storable a => a -> Int
sizeOf d
a)
d -> Parser d
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Parser d) -> d -> Parser d
forall a b. (a -> b) -> a -> b
$ IO d -> d
forall a. IO a -> a
unsafePerformIO (IO d -> d) -> IO d -> d
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO d) -> IO d
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO d) -> IO d) -> (Ptr Word8 -> IO d) -> IO d
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> Ptr Word8 -> Int -> IO d
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
off
take :: Int -> Parser ByteString
take :: Int -> Parser ByteString
take n :: Int
n = (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString)
-> (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success ByteString r
ok ->
if ByteString -> Int
B.length ByteString
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then let (b1 :: ByteString
b1,b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
buf in Success ByteString r
ok ByteString
b2 ByteString
b1
else Parser ByteString
-> ByteString -> Failure r -> Success ByteString r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser ByteString
take Int
n) ByteString
buf Failure r
err Success ByteString r
ok
takeWhile :: (Word8 -> Bool) -> Parser ByteString
takeWhile :: (Word8 -> Bool) -> Parser ByteString
takeWhile predicate :: Word8 -> Bool
predicate = (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString)
-> (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success ByteString r
ok ->
case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
predicate ByteString
buf of
(_, b2 :: ByteString
b2) | ByteString -> Bool
B.null ByteString
b2 -> Parser ByteString
-> ByteString -> Failure r -> Success ByteString r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Bool) -> Parser ByteString
takeWhile Word8 -> Bool
predicate) ByteString
buf Failure r
err Success ByteString r
ok
(b1 :: ByteString
b1, b2 :: ByteString
b2) -> Success ByteString r
ok ByteString
b2 ByteString
b1
takeAll :: Parser ByteString
takeAll :: Parser ByteString
takeAll = (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString)
-> (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success ByteString r
ok ->
Parser ByteString
-> ByteString -> Failure r -> Success ByteString r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getAll Parser () -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
returnBuffer) ByteString
buf Failure r
err Success ByteString r
ok
where
returnBuffer :: Parser ByteString
returnBuffer = (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString)
-> (forall r.
ByteString -> Failure r -> Success ByteString r -> Result r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf _ ok :: Success ByteString r
ok -> Success ByteString r
ok ByteString
B.empty ByteString
buf
skip :: Int -> Parser ()
skip :: Int -> Parser ()
skip n :: Int
n = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok ->
if ByteString -> Int
B.length ByteString
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
then Success () r
ok (Int -> ByteString -> ByteString
B.drop Int
n ByteString
buf) ()
else Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser ()
skip (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
buf)) ByteString
B.empty Failure r
err Success () r
ok
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile p :: Word8 -> Bool
p = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok ->
case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
p ByteString
buf of
(_, b2 :: ByteString
b2) | ByteString -> Bool
B.null ByteString
b2 -> Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser (Parser ()
getMore Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Bool) -> Parser ()
skipWhile Word8 -> Bool
p) ByteString
B.empty Failure r
err Success () r
ok
(_, b2 :: ByteString
b2) -> Success () r
ok ByteString
b2 ()
skipAll :: Parser ()
skipAll :: Parser ()
skipAll = (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a.
(forall r. ByteString -> Failure r -> Success a r -> Result r)
-> Parser a
Parser ((forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ())
-> (forall r. ByteString -> Failure r -> Success () r -> Result r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \buf :: ByteString
buf err :: Failure r
err ok :: Success () r
ok -> Parser () -> ByteString -> Failure r -> Success () r -> Result r
forall a.
Parser a
-> forall r. ByteString -> Failure r -> Success a r -> Result r
runParser Parser ()
flushAll ByteString
buf Failure r
err Success () r
ok