module Ptr.Parse
where
import Ptr.Prelude hiding (peek, take)
import qualified Ptr.PokeAndPeek as A
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Short.Internal as E
import qualified Ptr.Prelude as C
import qualified Ptr.IO as D
newtype Parse output =
Parse (Int -> Ptr Word8 -> forall result. (Int -> IO result) -> (Text -> IO result) -> (output -> Int -> Ptr Word8 -> IO result) -> IO result)
deriving instance Functor Parse
instance Applicative Parse where
pure x =
Parse (\ availableAmount ptr _ _ succeed -> succeed x availableAmount ptr)
{-# INLINE (<*>) #-}
(<*>) (Parse left) (Parse right) =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput !leftAvailableAmount !leftPtr ->
right leftAvailableAmount leftPtr failWithEOI failWithMessage $ \ rightOutput !rightAvailableAmount !rightPtr ->
succeed (leftOutput rightOutput) rightAvailableAmount rightPtr
instance Alternative Parse where
empty =
Parse (\ _ _ failWithEOI _ _ -> failWithEOI 0)
{-# INLINE (<|>) #-}
(<|>) (Parse left) (Parse right) =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
left availableAmount ptr
(\ _ -> right availableAmount ptr failWithEOI failWithMessage succeed)
failWithMessage succeed
instance Monad Parse where
return = pure
{-# INLINE (>>=) #-}
(>>=) (Parse left) rightK =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
left availableAmount ptr failWithEOI failWithMessage $ \ leftOutput !leftAvailableAmount !leftPtr ->
case rightK leftOutput of
Parse right ->
right leftAvailableAmount leftPtr failWithEOI failWithMessage succeed
instance MonadPlus Parse where
mzero = empty
mplus = (<|>)
instance MonadIO Parse where
{-# INLINE liftIO #-}
liftIO io =
Parse $ \ availableAmount ptr _ _ succeed -> io >>= \ output -> succeed output availableAmount ptr
{-# INLINE fail #-}
fail :: Text -> Parse output
fail message =
Parse $ \ _ _ _ failWithMessage _ -> failWithMessage message
{-# INLINE io #-}
io :: Int -> (Ptr Word8 -> IO output) -> Parse output
io !requiredAmount ptrIO =
{-# SCC "io" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
if availableAmount >= requiredAmount
then do
!result <- ptrIO ptr
succeed result (availableAmount - requiredAmount) (plusPtr ptr requiredAmount)
else failWithEOI (requiredAmount - availableAmount)
{-# INLINE mapInIO #-}
mapInIO :: (output -> IO newOutput) -> Parse output -> Parse newOutput
mapInIO io (Parse parseIO) =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
parseIO availableAmount ptr failWithEOI failWithMessage
(\ output newAvailableAmount newPtr -> io output >>= \ newOutput -> succeed newOutput newAvailableAmount newPtr)
{-# INLINE pokeAndPeek #-}
pokeAndPeek :: A.PokeAndPeek input output -> Parse output
pokeAndPeek (A.PokeAndPeek requiredAmount _ ptrIO) =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
if availableAmount >= requiredAmount
then do
!result <- ptrIO ptr
succeed result (availableAmount - requiredAmount) (plusPtr ptr requiredAmount)
else failWithEOI (requiredAmount - availableAmount)
{-# INLINE limiting #-}
limiting :: Int -> Parse output -> Parse output
limiting limitAmount (Parse io) =
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
if availableAmount >= limitAmount
then io limitAmount ptr failWithEOI failWithMessage succeed
else failWithEOI (limitAmount - availableAmount)
{-# INLINE peekRemainders #-}
peekRemainders :: Parse ByteString
peekRemainders =
{-# SCC "peekRemainders" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do
!bytes <- D.peekBytes ptr availableAmount
succeed bytes availableAmount ptr
{-# INLINE word8 #-}
word8 :: Parse Word8
word8 =
{-# SCC "word8" #-}
io 1 D.peekWord8
{-# INLINE beWord16 #-}
beWord16 :: Parse Word16
beWord16 =
{-# SCC "beWord16" #-}
io 2 D.peekBEWord16
{-# INLINE beWord32 #-}
beWord32 :: Parse Word32
beWord32 =
{-# SCC "beWord32" #-}
io 4 D.peekBEWord32
{-# INLINE beWord64 #-}
beWord64 :: Parse Word64
beWord64 =
{-# SCC "beWord64" #-}
io 8 D.peekBEWord64
{-# INLINE bytes #-}
bytes :: Int -> Parse ByteString
bytes amount =
{-# SCC "bytes" #-}
io amount (\ ptr -> D.peekBytes ptr amount)
{-# INLINE allBytes #-}
allBytes :: Parse ByteString
allBytes =
{-# SCC "allBytes" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do
!bytes <- D.peekBytes ptr availableAmount
succeed bytes 0 (plusPtr ptr availableAmount)
{-# INLINE nullTerminatedBytes #-}
nullTerminatedBytes :: Parse ByteString
nullTerminatedBytes =
{-# SCC "nullTerminatedBytes" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed -> do
!bytes <- B.packCString (castPtr ptr)
case succ (B.length bytes) of
consumedAmount -> if consumedAmount <= availableAmount
then succeed bytes (availableAmount - consumedAmount) (plusPtr ptr consumedAmount)
else failWithEOI (consumedAmount - availableAmount)
{-# INLINE nullTerminatedShortByteString #-}
nullTerminatedShortByteString :: Parse ShortByteString
nullTerminatedShortByteString =
{-# SCC "nullTerminatedShortByteString" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
D.peekNullTerminatedShortByteString ptr $ \ length create ->
if length <= availableAmount
then do
!result <- create
succeed result (availableAmount - length) (plusPtr ptr length)
else failWithEOI (length - availableAmount)
{-# INLINE bytesWhile #-}
bytesWhile :: (Word8 -> Bool) -> Parse ByteString
bytesWhile predicate =
{-# SCC "bytesWhile" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
let
iterate !availableAmount !unconsumedAmount !currentPtr =
if unconsumedAmount > 0
then do
byte <- C.peek currentPtr
if predicate byte
then iterate availableAmount (pred unconsumedAmount) (plusPtr currentPtr 1)
else do
bytes <- B.packCStringLen (castPtr ptr, availableAmount - unconsumedAmount)
succeed bytes unconsumedAmount currentPtr
else failWithEOI 0
in iterate availableAmount availableAmount ptr
{-# INLINE skipWhile #-}
skipWhile :: (Word8 -> Bool) -> Parse ()
skipWhile predicate =
{-# SCC "skipWhile" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
let
iterate !availableAmount !unconsumedAmount !ptr =
if unconsumedAmount > 0
then do
byte <- C.peek ptr
if predicate byte
then iterate availableAmount (pred unconsumedAmount) (plusPtr ptr 1)
else succeed () unconsumedAmount ptr
else failWithEOI 0
in iterate availableAmount availableAmount ptr
{-# INLINE foldWhile #-}
foldWhile :: (Word8 -> Bool) -> (state -> Word8 -> state) -> state -> Parse state
foldWhile predicate step start =
{-# SCC "foldWhile" #-}
Parse $ \ !availableAmount !ptr failWithEOI failWithMessage succeed ->
let
iterate !state !unconsumedAmount !ptr =
if unconsumedAmount > 0
then do
byte <- C.peek ptr
if predicate byte
then iterate (step state byte) (pred unconsumedAmount) (plusPtr ptr 1)
else succeed state unconsumedAmount ptr
else failWithEOI 0
in iterate start availableAmount ptr
{-# INLINE unsignedASCIIIntegral #-}
unsignedASCIIIntegral :: Integral a => Parse a
unsignedASCIIIntegral =
{-# SCC "unsignedASCIIIntegral" #-}
foldWhile byteIsDigit step 0
where
byteIsDigit byte =
byte - 48 <= 9
step !state !byte =
state * 10 + fromIntegral byte - 48