module Ptr.ParseUnbound where
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Short.Internal as E
import qualified Ptr.IO as D
import qualified Ptr.PokeAndPeek as A
import Ptr.Prelude hiding (peek, take)
import qualified Ptr.Prelude as C
newtype ParseUnbound output
= ParseUnbound (Ptr Word8 -> forall result. (Text -> IO result) -> (output -> Int -> IO result) -> IO result)
deriving instance Functor ParseUnbound
instance Applicative ParseUnbound where
pure :: a -> ParseUnbound a
pure a
x =
(Ptr Word8
-> forall result.
(Text -> IO result) -> (a -> Int -> IO result) -> IO result)
-> ParseUnbound a
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound (\Ptr Word8
ptr Text -> IO result
_ a -> Int -> IO result
succeed -> a -> Int -> IO result
succeed a
x Int
0)
{-# INLINE (<*>) #-}
<*> :: ParseUnbound (a -> b) -> ParseUnbound a -> ParseUnbound b
(<*>) (ParseUnbound Ptr Word8
-> forall result.
(Text -> IO result) -> ((a -> b) -> Int -> IO result) -> IO result
left) (ParseUnbound Ptr Word8
-> forall result.
(Text -> IO result) -> (a -> Int -> IO result) -> IO result
right) =
(Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail b -> Int -> IO result
succeed ->
Ptr Word8
-> (Text -> IO result)
-> ((a -> b) -> Int -> IO result)
-> IO result
Ptr Word8
-> forall result.
(Text -> IO result) -> ((a -> b) -> Int -> IO result) -> IO result
left Ptr Word8
ptr Text -> IO result
fail (((a -> b) -> Int -> IO result) -> IO result)
-> ((a -> b) -> Int -> IO result) -> IO result
forall a b. (a -> b) -> a -> b
$ \a -> b
leftOutput Int
leftSize ->
Ptr Word8
-> (Text -> IO result) -> (a -> Int -> IO result) -> IO result
Ptr Word8
-> forall result.
(Text -> IO result) -> (a -> Int -> IO result) -> IO result
right (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
leftSize) Text -> IO result
fail ((a -> Int -> IO result) -> IO result)
-> (a -> Int -> IO result) -> IO result
forall a b. (a -> b) -> a -> b
$ \a
rightOutput Int
rightSize ->
b -> Int -> IO result
succeed (a -> b
leftOutput a
rightOutput) (Int
leftSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightSize)
instance Monad ParseUnbound where
return :: a -> ParseUnbound a
return = a -> ParseUnbound a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
>>= :: ParseUnbound a -> (a -> ParseUnbound b) -> ParseUnbound b
(>>=) (ParseUnbound Ptr Word8
-> forall result.
(Text -> IO result) -> (a -> Int -> IO result) -> IO result
left) a -> ParseUnbound b
rightK =
(Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result)
-> ParseUnbound b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail b -> Int -> IO result
succeed ->
Ptr Word8
-> (Text -> IO result) -> (a -> Int -> IO result) -> IO result
Ptr Word8
-> forall result.
(Text -> IO result) -> (a -> Int -> IO result) -> IO result
left Ptr Word8
ptr Text -> IO result
fail ((a -> Int -> IO result) -> IO result)
-> (a -> Int -> IO result) -> IO result
forall a b. (a -> b) -> a -> b
$ \a
leftOutput Int
leftSize ->
case a -> ParseUnbound b
rightK a
leftOutput of
ParseUnbound Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result
right ->
Ptr Word8
-> (Text -> IO result) -> (b -> Int -> IO result) -> IO result
Ptr Word8
-> forall result.
(Text -> IO result) -> (b -> Int -> IO result) -> IO result
right (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
leftSize) Text -> IO result
fail b -> Int -> IO result
succeed
{-# INLINE fail #-}
fail :: Text -> ParseUnbound output
fail :: Text -> ParseUnbound output
fail Text
message =
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
_ Text -> IO result
fail output -> Int -> IO result
_ -> Text -> IO result
fail Text
message
{-# INLINE io #-}
io :: Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io :: Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io !Int
size Ptr Word8 -> IO output
ptrIO =
{-# SCC "io" #-}
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail output -> Int -> IO result
succeed -> do
!output
result <- Ptr Word8 -> IO output
ptrIO Ptr Word8
ptr
output -> Int -> IO result
succeed output
result Int
size
{-# INLINE pokeAndPeek #-}
pokeAndPeek :: A.PokeAndPeek input output -> ParseUnbound output
pokeAndPeek :: PokeAndPeek input output -> ParseUnbound output
pokeAndPeek (A.PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
_ Ptr Word8 -> IO output
ptrIO) =
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail output -> Int -> IO result
succeed -> do
!output
result <- Ptr Word8 -> IO output
ptrIO Ptr Word8
ptr
output -> Int -> IO result
succeed output
result Int
size
{-# INLINE word8 #-}
word8 :: ParseUnbound Word8
word8 :: ParseUnbound Word8
word8 =
{-# SCC "word8" #-}
Int -> (Ptr Word8 -> IO Word8) -> ParseUnbound Word8
forall output.
Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io Int
1 Ptr Word8 -> IO Word8
D.peekWord8
{-# INLINE beWord16 #-}
beWord16 :: ParseUnbound Word16
beWord16 :: ParseUnbound Word16
beWord16 =
{-# SCC "beWord16" #-}
Int -> (Ptr Word8 -> IO Word16) -> ParseUnbound Word16
forall output.
Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io Int
2 Ptr Word8 -> IO Word16
D.peekBEWord16
{-# INLINE beWord32 #-}
beWord32 :: ParseUnbound Word32
beWord32 :: ParseUnbound Word32
beWord32 =
{-# SCC "beWord32" #-}
Int -> (Ptr Word8 -> IO Word32) -> ParseUnbound Word32
forall output.
Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io Int
4 Ptr Word8 -> IO Word32
D.peekBEWord32
{-# INLINE beWord64 #-}
beWord64 :: ParseUnbound Word64
beWord64 :: ParseUnbound Word64
beWord64 =
{-# SCC "beWord64" #-}
Int -> (Ptr Word8 -> IO Word64) -> ParseUnbound Word64
forall output.
Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io Int
8 Ptr Word8 -> IO Word64
D.peekBEWord64
{-# INLINE bytes #-}
bytes :: Int -> ParseUnbound ByteString
bytes :: Int -> ParseUnbound ByteString
bytes Int
amount =
{-# SCC "bytes" #-}
Int -> (Ptr Word8 -> IO ByteString) -> ParseUnbound ByteString
forall output.
Int -> (Ptr Word8 -> IO output) -> ParseUnbound output
io Int
amount (\Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ByteString
D.peekBytes Ptr Word8
ptr Int
amount)
{-# INLINE nullTerminatedBytes #-}
nullTerminatedBytes :: ParseUnbound ByteString
nullTerminatedBytes :: ParseUnbound ByteString
nullTerminatedBytes =
{-# SCC "nullTerminatedBytes" #-}
(Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString)
-> (Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
ptr Text -> IO result
fail ByteString -> Int -> IO result
succeed -> do
!ByteString
bytes <- CString -> IO ByteString
B.packCString (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
ByteString -> Int -> IO result
succeed ByteString
bytes (Int -> IO result) -> Int -> IO result
forall a b. (a -> b) -> a -> b
$! Int -> Int
forall a. Enum a => a -> a
succ (ByteString -> Int
B.length ByteString
bytes)
{-# INLINE nullTerminatedShortByteString #-}
nullTerminatedShortByteString :: ParseUnbound ShortByteString
nullTerminatedShortByteString :: ParseUnbound ShortByteString
nullTerminatedShortByteString =
{-# SCC "nullTerminatedShortByteString" #-}
(Ptr Word8
-> forall result.
(Text -> IO result)
-> (ShortByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ShortByteString
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result)
-> (ShortByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ShortByteString)
-> (Ptr Word8
-> forall result.
(Text -> IO result)
-> (ShortByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ShortByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
ptr Text -> IO result
fail ShortByteString -> Int -> IO result
succeed ->
Ptr Word8 -> (Int -> IO ShortByteString -> IO result) -> IO result
forall a. Ptr Word8 -> (Int -> IO ShortByteString -> IO a) -> IO a
D.peekNullTerminatedShortByteString Ptr Word8
ptr ((Int -> IO ShortByteString -> IO result) -> IO result)
-> (Int -> IO ShortByteString -> IO result) -> IO result
forall a b. (a -> b) -> a -> b
$ \ !Int
length IO ShortByteString
create ->
do
!ShortByteString
bytes <- IO ShortByteString
create
ShortByteString -> Int -> IO result
succeed ShortByteString
bytes Int
length
{-# INLINE bytesWhile #-}
bytesWhile :: (Word8 -> Bool) -> ParseUnbound ByteString
bytesWhile :: (Word8 -> Bool) -> ParseUnbound ByteString
bytesWhile Word8 -> Bool
predicate =
{-# SCC "bytesWhile" #-}
(Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString)
-> (Ptr Word8
-> forall result.
(Text -> IO result)
-> (ByteString -> Int -> IO result) -> IO result)
-> ParseUnbound ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail ByteString -> Int -> IO result
succeed ->
let iterate :: Int -> IO result
iterate !Int
i =
do
Word8
byte <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
C.peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
i)
if Word8 -> Bool
predicate Word8
byte
then Int -> IO result
iterate (Int -> Int
forall a. Enum a => a -> a
succ Int
i)
else do
ByteString
bytes <- CStringLen -> IO ByteString
B.packCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
i)
ByteString -> Int -> IO result
succeed ByteString
bytes Int
i
in Int -> IO result
iterate Int
0
{-# INLINE skipWhile #-}
skipWhile :: (Word8 -> Bool) -> ParseUnbound ()
skipWhile :: (Word8 -> Bool) -> ParseUnbound ()
skipWhile Word8 -> Bool
predicate =
{-# SCC "skipWhile" #-}
(Ptr Word8
-> forall result.
(Text -> IO result) -> (() -> Int -> IO result) -> IO result)
-> ParseUnbound ()
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (() -> Int -> IO result) -> IO result)
-> ParseUnbound ())
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (() -> Int -> IO result) -> IO result)
-> ParseUnbound ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail () -> Int -> IO result
succeed ->
let iterate :: Int -> IO result
iterate !Int
i =
do
Word8
byte <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
C.peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
i)
if Word8 -> Bool
predicate Word8
byte
then Int -> IO result
iterate (Int -> Int
forall a. Enum a => a -> a
succ Int
i)
else () -> Int -> IO result
succeed () Int
i
in Int -> IO result
iterate Int
0
{-# INLINE foldWhile #-}
foldWhile :: (Word8 -> Bool) -> (state -> Word8 -> state) -> state -> ParseUnbound state
foldWhile :: (Word8 -> Bool)
-> (state -> Word8 -> state) -> state -> ParseUnbound state
foldWhile Word8 -> Bool
predicate state -> Word8 -> state
step state
start =
{-# SCC "foldWhile" #-}
(Ptr Word8
-> forall result.
(Text -> IO result) -> (state -> Int -> IO result) -> IO result)
-> ParseUnbound state
forall output.
(Ptr Word8
-> forall result.
(Text -> IO result) -> (output -> Int -> IO result) -> IO result)
-> ParseUnbound output
ParseUnbound ((Ptr Word8
-> forall result.
(Text -> IO result) -> (state -> Int -> IO result) -> IO result)
-> ParseUnbound state)
-> (Ptr Word8
-> forall result.
(Text -> IO result) -> (state -> Int -> IO result) -> IO result)
-> ParseUnbound state
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Text -> IO result
fail state -> Int -> IO result
succeed ->
let iterate :: state -> Int -> IO result
iterate !state
state !Int
i =
do
Word8
byte <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
C.peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
i)
if Word8 -> Bool
predicate Word8
byte
then state -> Int -> IO result
iterate (state -> Word8 -> state
step state
state Word8
byte) (Int -> Int
forall a. Enum a => a -> a
succ Int
i)
else state -> Int -> IO result
succeed state
state Int
i
in state -> Int -> IO result
iterate state
start Int
0
{-# INLINE unsignedASCIIIntegral #-}
unsignedASCIIIntegral :: Integral a => ParseUnbound a
unsignedASCIIIntegral :: ParseUnbound a
unsignedASCIIIntegral =
{-# SCC "unsignedASCIIIntegral" #-}
(Word8 -> Bool) -> (a -> Word8 -> a) -> a -> ParseUnbound a
forall state.
(Word8 -> Bool)
-> (state -> Word8 -> state) -> state -> ParseUnbound state
foldWhile Word8 -> Bool
forall a. (Ord a, Num a) => a -> Bool
byteIsDigit a -> Word8 -> a
forall a a. (Integral a, Num a) => a -> a -> a
step a
0
where
byteIsDigit :: a -> Bool
byteIsDigit a
byte =
a
byte a -> a -> a
forall a. Num a => a -> a -> a
- a
48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9
step :: a -> a -> a
step !a
state !a
byte =
a
state a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
byte a -> a -> a
forall a. Num a => a -> a -> a
- a
48