module Ptr.Read
  ( Read,
    Status (..),
    runOnPtr,
    runOnByteString,
    runOnByteStringFinishing,
    skip,
    skipWhile,
    byteString,
    byteStringWhile,
    foldlWhile',
    word8,
    int16InBe,
    int32InBe,
    int64InBe,
    nullTerminatedByteString,
    asciiIntegral,
  )
where

import qualified Data.ByteString.Internal as ByteString
import qualified Ptr.IO as IO
import Ptr.Prelude hiding (Read)
import qualified Ptr.Util.ByteString as ByteString
import qualified Ptr.Util.Word8Predicates as Word8Predicates
import qualified StrictList

-- |
-- Deserializer highly optimized for reading from pointers.
--
-- Parsing ByteString is just a special case.
newtype Read a
  = Read (Ptr Word8 -> Ptr Word8 -> IO (Status a))

instance Functor Read where
  fmap :: (a -> b) -> Read a -> Read b
fmap a -> b
f (Read Ptr Word8 -> Ptr Word8 -> IO (Status a)
cont) =
    (Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (\Ptr Word8
start Ptr Word8
end -> (Status a -> Status b) -> IO (Status a) -> IO (Status b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Status a -> Status b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Ptr Word8 -> Ptr Word8 -> IO (Status a)
cont Ptr Word8
start Ptr Word8
end))

instance Applicative Read where
  pure :: a -> Read a
pure a
a =
    (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (\Ptr Word8
s Ptr Word8
e -> Status a -> IO (Status a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> a -> Status a
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
s a
a))
  Read Ptr Word8 -> Ptr Word8 -> IO (Status (a -> b))
lGetStatus <*> :: Read (a -> b) -> Read a -> Read b
<*> Read Ptr Word8 -> Ptr Word8 -> IO (Status a)
rGetStatus =
    (Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read ((Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b)
-> (Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
start Ptr Word8
end -> do
      Ptr Word8 -> Ptr Word8 -> IO (Status (a -> b))
lGetStatus Ptr Word8
start Ptr Word8
end IO (Status (a -> b))
-> (Status (a -> b) -> IO (Status b)) -> IO (Status b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FinishedStatus Ptr Word8
lAfter a -> b
lRes ->
          Ptr Word8 -> Ptr Word8 -> IO (Status a)
rGetStatus Ptr Word8
lAfter Ptr Word8
end IO (Status a) -> (IO (Status a) -> IO (Status b)) -> IO (Status b)
forall a b. a -> (a -> b) -> b
& (Status a -> Status b) -> IO (Status a) -> IO (Status b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Status a -> Status b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lRes)
        UnfinishedStatus Read (a -> b)
lNextPeek ->
          Status b -> IO (Status b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read b -> Status b
forall a. Read a -> Status a
UnfinishedStatus (Read (a -> b)
lNextPeek Read (a -> b) -> Read a -> Read b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status a)
rGetStatus))

instance Monad Read where
  return :: a -> Read a
return = a -> Read a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Read Ptr Word8 -> Ptr Word8 -> IO (Status a)
lGetStatus >>= :: Read a -> (a -> Read b) -> Read b
>>= a -> Read b
k =
    (Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read ((Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b)
-> (Ptr Word8 -> Ptr Word8 -> IO (Status b)) -> Read b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
start Ptr Word8
end ->
      Ptr Word8 -> Ptr Word8 -> IO (Status a)
lGetStatus Ptr Word8
start Ptr Word8
end IO (Status a) -> (Status a -> IO (Status b)) -> IO (Status b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FinishedStatus Ptr Word8
lAfter a
lRes ->
          a -> Read b
k a
lRes Read b -> (Read b -> IO (Status b)) -> IO (Status b)
forall a b. a -> (a -> b) -> b
& \(Read Ptr Word8 -> Ptr Word8 -> IO (Status b)
rGetStatus) -> Ptr Word8 -> Ptr Word8 -> IO (Status b)
rGetStatus Ptr Word8
lAfter Ptr Word8
end
        UnfinishedStatus Read a
lNextPeek ->
          Status b -> IO (Status b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read b -> Status b
forall a. Read a -> Status a
UnfinishedStatus (Read a
lNextPeek Read a -> (a -> Read b) -> Read b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Read b
k))

-- |
-- Result of a single iteration.
--
-- Errors can be achieved by using Either for output.
data Status a
  = FinishedStatus {-# UNPACK #-} !(Ptr Word8) a
  | UnfinishedStatus (Read a)
  deriving (a -> Status b -> Status a
(a -> b) -> Status a -> Status b
(forall a b. (a -> b) -> Status a -> Status b)
-> (forall a b. a -> Status b -> Status a) -> Functor Status
forall a b. a -> Status b -> Status a
forall a b. (a -> b) -> Status a -> Status b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Status b -> Status a
$c<$ :: forall a b. a -> Status b -> Status a
fmap :: (a -> b) -> Status a -> Status b
$cfmap :: forall a b. (a -> b) -> Status a -> Status b
Functor)

-------------------------

runOnPtr :: Read a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
runOnPtr :: Read a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
runOnPtr =
  Read a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
coerce

runOnByteString :: Read a -> ByteString -> Either (Read a) (a, ByteString)
runOnByteString :: Read a -> ByteString -> Either (Read a) (a, ByteString)
runOnByteString (Read Ptr Word8 -> Ptr Word8 -> IO (Status a)
read) (ByteString.PS ForeignPtr Word8
bsFp Int
bsOff Int
bsSize) =
  IO (Either (Read a) (a, ByteString))
-> Either (Read a) (a, ByteString)
forall a. IO a -> a
unsafePerformIO (IO (Either (Read a) (a, ByteString))
 -> Either (Read a) (a, ByteString))
-> IO (Either (Read a) (a, ByteString))
-> Either (Read a) (a, ByteString)
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Either (Read a) (a, ByteString)))
-> IO (Either (Read a) (a, ByteString))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bsFp ((Ptr Word8 -> IO (Either (Read a) (a, ByteString)))
 -> IO (Either (Read a) (a, ByteString)))
-> (Ptr Word8 -> IO (Either (Read a) (a, ByteString)))
-> IO (Either (Read a) (a, ByteString))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
      let startP :: Ptr Word8
startP = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
bsOff
          endP :: Ptr Word8
endP = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
startP Int
bsSize
       in Ptr Word8 -> Ptr Word8 -> IO (Status a)
read Ptr Word8
startP Ptr Word8
endP IO (Status a)
-> (Status a -> Either (Read a) (a, ByteString))
-> IO (Either (Read a) (a, ByteString))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            FinishedStatus Ptr Word8
newStartP a
res ->
              let newBsOff :: Int
newBsOff = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
newStartP Ptr Word8
p
                  newBs :: ByteString
newBs = ForeignPtr Word8 -> Int -> Int -> ByteString
ByteString.PS ForeignPtr Word8
bsFp Int
newBsOff (Int
bsSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
newBsOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bsOff))
               in (a, ByteString) -> Either (Read a) (a, ByteString)
forall a b. b -> Either a b
Right (a
res, ByteString
newBs)
            UnfinishedStatus Read a
next ->
              Read a -> Either (Read a) (a, ByteString)
forall a b. a -> Either a b
Left Read a
next

runOnByteStringFinishing :: Read a -> ByteString -> Maybe a
runOnByteStringFinishing :: Read a -> ByteString -> Maybe a
runOnByteStringFinishing Read a
read ByteString
byteString =
  Read a -> ByteString -> Either (Read a) (a, ByteString)
forall a. Read a -> ByteString -> Either (Read a) (a, ByteString)
runOnByteString Read a
read ByteString
byteString
    Either (Read a) (a, ByteString)
-> (Either (Read a) (a, ByteString) -> Maybe a) -> Maybe a
forall a b. a -> (a -> b) -> b
& (Read a -> Maybe a)
-> ((a, ByteString) -> Maybe a)
-> Either (Read a) (a, ByteString)
-> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Read a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> ((a, ByteString) -> a) -> (a, ByteString) -> Maybe a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, ByteString) -> a
forall a b. (a, b) -> a
fst)

-------------------------

skip ::
  -- |
  --  Amount of bytes to skip.
  --
  --  __Warning:__ It is your responsibility to ensure that it is not negative.
  Int ->
  Read ()
skip :: Int -> Read ()
skip =
  (Ptr Word8 -> Ptr Word8 -> IO (Status ())) -> Read ()
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read ((Ptr Word8 -> Ptr Word8 -> IO (Status ())) -> Read ())
-> (Int -> Ptr Word8 -> Ptr Word8 -> IO (Status ()))
-> Int
-> Read ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop
  where
    loop :: Int -> Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop Int
needed Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
post Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then Status () -> IO (Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> () -> Status ()
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
post ())
        else Status () -> IO (Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Read () -> Status ()
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status ())) -> Read ()
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (Int -> Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop Int
nextNeeded)))
      where
        post :: Ptr Word8
post = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
needed
        nextNeeded :: Int
nextNeeded = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
post Ptr Word8
end

skipWhile :: (Word8 -> Bool) -> Read ()
skipWhile :: (Word8 -> Bool) -> Read ()
skipWhile Word8 -> Bool
predicate =
  (Ptr Word8 -> Ptr Word8 -> IO (Status ())) -> Read ()
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop
  where
    loop :: Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
post Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then do
          Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start
          if Word8 -> Bool
predicate Word8
w
            then Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop Ptr Word8
post Ptr Word8
end
            else Status () -> IO (Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> () -> Status ()
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
start ())
        else Status () -> IO (Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Read () -> Status ()
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status ())) -> Read ()
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status ())
loop))
      where
        post :: Ptr Word8
post = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1

byteString ::
  -- |
  --  Size of the bytestring.
  --
  --  __Warning:__ It is your responsibility to ensure that it is not negative.
  Int ->
  Read ByteString
byteString :: Int -> Read ByteString
byteString Int
totalNeededSize =
  (Ptr Word8 -> Ptr Word8 -> IO (Status ByteString))
-> Read ByteString
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
totalNeededSize List ByteString
forall a. List a
Nil)
  where
    collectChunks :: Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
neededSize List ByteString
chunks Ptr Word8
startPtr Ptr Word8
endPtr =
      let nextPtr :: Ptr Word8
nextPtr = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
startPtr Int
neededSize
       in -- If there's enough
          if Ptr Word8
nextPtr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
endPtr
            then
              let lastChunkLength :: Int
lastChunkLength = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
nextPtr Ptr Word8
startPtr
                  !chunk :: ByteString
chunk = Int -> Ptr Word8 -> ByteString
ByteString.fromPtr Int
lastChunkLength Ptr Word8
startPtr
                  merged :: ByteString
merged = ByteString -> Int -> List ByteString -> ByteString
ByteString.fromReverseStrictListWithHead ByteString
chunk (Int
totalNeededSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastChunkLength) List ByteString
chunks
               in Status ByteString -> IO (Status ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> ByteString -> Status ByteString
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
nextPtr ByteString
merged)
            else
              let lastChunkLength :: Int
lastChunkLength = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
endPtr Ptr Word8
startPtr
                  !chunk :: ByteString
chunk = Int -> Ptr Word8 -> ByteString
ByteString.fromPtr Int
lastChunkLength Ptr Word8
startPtr
                  newNeededSize :: Int
newNeededSize = Int
neededSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastChunkLength
                  newChunks :: List ByteString
newChunks = ByteString -> List ByteString -> List ByteString
forall a. a -> List a -> List a
Cons ByteString
chunk List ByteString
chunks
                  loop :: Ptr Word8 -> Ptr Word8 -> IO (Status ByteString)
loop = Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
newNeededSize List ByteString
newChunks
               in Status ByteString -> IO (Status ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read ByteString -> Status ByteString
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status ByteString))
-> Read ByteString
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status ByteString)
loop))

byteStringWhile :: (Word8 -> Bool) -> Read ByteString
byteStringWhile :: (Word8 -> Bool) -> Read ByteString
byteStringWhile Word8 -> Bool
predicate =
  (Ptr Word8 -> Ptr Word8 -> IO (Status ByteString))
-> Read ByteString
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
0 List ByteString
forall a. List a
Nil)
  where
    collectChunks :: Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
totalLength List ByteString
chunks Ptr Word8
startPtr Ptr Word8
endPtr =
      Ptr Word8 -> IO (Status ByteString)
populateChunk Ptr Word8
startPtr
      where
        populateChunk :: Ptr Word8 -> IO (Status ByteString)
populateChunk Ptr Word8
curPtr =
          if Ptr Word8
curPtr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
endPtr
            then do
              Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
curPtr
              if Word8 -> Bool
predicate Word8
w
                then Ptr Word8 -> IO (Status ByteString)
populateChunk (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
curPtr Int
1)
                else
                  let chunkLength :: Int
chunkLength =
                        Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
curPtr Ptr Word8
startPtr
                      !chunk :: ByteString
chunk =
                        Int -> Ptr Word8 -> ByteString
ByteString.fromPtr Int
chunkLength Ptr Word8
startPtr
                      merged :: ByteString
merged =
                        ByteString -> Int -> List ByteString -> ByteString
ByteString.fromReverseStrictListWithHead ByteString
chunk Int
totalLength List ByteString
chunks
                   in Status ByteString -> IO (Status ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> ByteString -> Status ByteString
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
curPtr ByteString
merged)
            else
              let chunkLength :: Int
chunkLength =
                    Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
endPtr Ptr Word8
startPtr
                  !chunk :: ByteString
chunk =
                    Int -> Ptr Word8 -> ByteString
ByteString.fromPtr Int
chunkLength Ptr Word8
startPtr
                  newTotalLength :: Int
newTotalLength =
                    Int
totalLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chunkLength
                  newChunks :: List ByteString
newChunks =
                    ByteString -> List ByteString -> List ByteString
forall a. a -> List a -> List a
Cons ByteString
chunk List ByteString
chunks
               in Status ByteString -> IO (Status ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read ByteString -> Status ByteString
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status ByteString))
-> Read ByteString
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (Int
-> List ByteString
-> Ptr Word8
-> Ptr Word8
-> IO (Status ByteString)
collectChunks Int
newTotalLength List ByteString
newChunks)))

foldlWhile' :: (Word8 -> Bool) -> (acc -> Word8 -> acc) -> acc -> Read acc
foldlWhile' :: (Word8 -> Bool) -> (acc -> Word8 -> acc) -> acc -> Read acc
foldlWhile' Word8 -> Bool
predicate acc -> Word8 -> acc
step =
  (Ptr Word8 -> Ptr Word8 -> IO (Status acc)) -> Read acc
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read ((Ptr Word8 -> Ptr Word8 -> IO (Status acc)) -> Read acc)
-> (acc -> Ptr Word8 -> Ptr Word8 -> IO (Status acc))
-> acc
-> Read acc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. acc -> Ptr Word8 -> Ptr Word8 -> IO (Status acc)
loop
  where
    loop :: acc -> Ptr Word8 -> Ptr Word8 -> IO (Status acc)
loop !acc
acc Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
post Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then do
          Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start
          if Word8 -> Bool
predicate Word8
w
            then acc -> Ptr Word8 -> Ptr Word8 -> IO (Status acc)
loop (acc -> Word8 -> acc
step acc
acc Word8
w) Ptr Word8
post Ptr Word8
end
            else Status acc -> IO (Status acc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> acc -> Status acc
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
start acc
acc)
        else Status acc -> IO (Status acc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read acc -> Status acc
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status acc)) -> Read acc
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (acc -> Ptr Word8 -> Ptr Word8 -> IO (Status acc)
loop acc
acc)))
      where
        post :: Ptr Word8
post = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1

-------------------------

word8 :: Read Word8
word8 :: Read Word8
word8 =
  (Ptr Word8 -> Ptr Word8 -> IO (Status Word8)) -> Read Word8
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read ((Ptr Word8 -> Ptr Word8 -> IO (Status Word8)) -> Read Word8)
-> (Ptr Word8 -> Ptr Word8 -> IO (Status Word8)) -> Read Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
start Ptr Word8
end ->
    if Ptr Word8
end Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr Word8
start
      then Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start IO Word8 -> (Word8 -> Status Word8) -> IO (Status Word8)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Ptr Word8 -> Word8 -> Status Word8
forall a. Ptr Word8 -> a -> Status a
FinishedStatus (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1)
      else Status Word8 -> IO (Status Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read Word8 -> Status Word8
forall a. Read a -> Status a
UnfinishedStatus Read Word8
word8)

int16InBe :: Read Int16
int16InBe :: Read Int16
int16InBe =
  (Ptr Word8 -> Ptr Word8 -> IO (Status Int16)) -> Read Int16
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status Int16)
inWhole
  where
    inWhole :: Ptr Word8 -> Ptr Word8 -> IO (Status Int16)
inWhole Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
inWholePost Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then Ptr Word8 -> IO Int16
IO.peekBEInt16 Ptr Word8
start IO Int16 -> (Int16 -> Status Int16) -> IO (Status Int16)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Ptr Word8 -> Int16 -> Status Int16
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
inWholePost
        else Integer -> Int16 -> Ptr Word8 -> Ptr Word8 -> IO (Status Int16)
forall a t.
(Bits a, Ord t, Num a, Num t, Enum t) =>
t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely Integer
2 Int16
0 Ptr Word8
start Ptr Word8
end
      where
        inWholePost :: Ptr Word8
inWholePost = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
2
    bytely :: t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely !t
needed !a
acc Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
start Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end
        then do
          Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start
          let newAcc :: a
newAcc = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
acc Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
              newStart :: Ptr Word8
newStart = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1
           in if t
needed t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
1
                then t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely (t -> t
forall a. Enum a => a -> a
pred t
needed) a
newAcc Ptr Word8
newStart Ptr Word8
end
                else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> a -> Status a
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
newStart a
newAcc)
        else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read a -> Status a
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely t
needed a
acc)))

int32InBe :: Read Int32
int32InBe :: Read Int32
int32InBe =
  (Ptr Word8 -> Ptr Word8 -> IO (Status Int32)) -> Read Int32
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status Int32)
inWhole
  where
    inWhole :: Ptr Word8 -> Ptr Word8 -> IO (Status Int32)
inWhole Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
inWholePost Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then Ptr Word8 -> IO Int32
IO.peekBEInt32 Ptr Word8
start IO Int32 -> (Int32 -> Status Int32) -> IO (Status Int32)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Ptr Word8 -> Int32 -> Status Int32
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
inWholePost
        else Integer -> Int32 -> Ptr Word8 -> Ptr Word8 -> IO (Status Int32)
forall a t.
(Bits a, Ord t, Num a, Num t, Enum t) =>
t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely Integer
4 Int32
0 Ptr Word8
start Ptr Word8
end
      where
        inWholePost :: Ptr Word8
inWholePost = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
4
    bytely :: t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely !t
needed !a
acc Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
start Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end
        then do
          Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start
          let newAcc :: a
newAcc = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
acc Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
              newStart :: Ptr Word8
newStart = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1
           in if t
needed t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
1
                then t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely (t -> t
forall a. Enum a => a -> a
pred t
needed) a
newAcc Ptr Word8
newStart Ptr Word8
end
                else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> a -> Status a
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
newStart a
newAcc)
        else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read a -> Status a
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely t
needed a
acc)))

int64InBe :: Read Int64
int64InBe :: Read Int64
int64InBe =
  (Ptr Word8 -> Ptr Word8 -> IO (Status Int64)) -> Read Int64
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read Ptr Word8 -> Ptr Word8 -> IO (Status Int64)
inWhole
  where
    inWhole :: Ptr Word8 -> Ptr Word8 -> IO (Status Int64)
inWhole Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
inWholePost Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
end
        then Ptr Word8 -> IO Int64
IO.peekBEInt64 Ptr Word8
start IO Int64 -> (Int64 -> Status Int64) -> IO (Status Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Ptr Word8 -> Int64 -> Status Int64
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
inWholePost
        else Integer -> Int64 -> Ptr Word8 -> Ptr Word8 -> IO (Status Int64)
forall a t.
(Bits a, Ord t, Num a, Num t, Enum t) =>
t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely Integer
8 Int64
0 Ptr Word8
start Ptr Word8
end
      where
        inWholePost :: Ptr Word8
inWholePost = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
8
    bytely :: t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely !t
needed !a
acc Ptr Word8
start Ptr Word8
end =
      if Ptr Word8
start Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end
        then do
          Word8
w <- Ptr Word8 -> IO Word8
IO.peekWord8 Ptr Word8
start
          let newAcc :: a
newAcc = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
acc Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
              newStart :: Ptr Word8
newStart = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
start Int
1
           in if t
needed t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
1
                then t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely (t -> t
forall a. Enum a => a -> a
pred t
needed) a
newAcc Ptr Word8
newStart Ptr Word8
end
                else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> a -> Status a
forall a. Ptr Word8 -> a -> Status a
FinishedStatus Ptr Word8
newStart a
newAcc)
        else Status a -> IO (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Read a -> Status a
forall a. Read a -> Status a
UnfinishedStatus ((Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
forall a. (Ptr Word8 -> Ptr Word8 -> IO (Status a)) -> Read a
Read (t -> a -> Ptr Word8 -> Ptr Word8 -> IO (Status a)
bytely t
needed a
acc)))

nullTerminatedByteString :: Read ByteString
nullTerminatedByteString :: Read ByteString
nullTerminatedByteString =
  (Word8 -> Bool) -> Read ByteString
byteStringWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Read ByteString -> Read () -> Read ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Read ()
skip Int
1

-- |
-- Integral number encoded in ASCII.
asciiIntegral :: Integral a => Read a
asciiIntegral :: Read a
asciiIntegral =
  (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Read a
forall acc.
(Word8 -> Bool) -> (acc -> Word8 -> acc) -> acc -> Read acc
foldlWhile' Word8 -> Bool
Word8Predicates.asciiDigit a -> Word8 -> a
forall a a. (Integral a, Num a) => a -> a -> a
step a
0
  where
    step :: a -> a -> a
step a
acc a
byte =
      a
acc 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