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

-- |
-- Unbound parser, whose peeking action decides how much input to consume,
-- and merely informs the executor about how many bytes it consumed.
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

-- |
-- Unsigned integral number encoded in ASCII.
{-# 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