module Ptr.Receive.Core
where

import Ptr.Prelude
import qualified Data.ByteString.Internal as A


write :: (Ptr Word8 -> Int -> IO (Either Text Int)) -> ForeignPtr Word8 -> IORef (Int, Int) -> Int -> Int -> Ptr Word8 -> IO (Either Text ())
write :: (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
write Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize Int
howMany Ptr Word8
destination =
  do
    (Int
offset, Int
end) <- IORef (Int, Int) -> IO (Int, Int)
forall a. IORef a -> IO a
readIORef IORef (Int, Int)
bufferStateRef
    if Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset
      then
        -- Buffer is empty, we need to fetch right away
        (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize Int
howMany Ptr Word8
destination
      else
        -- We still have something in the buffer, so we'll read from it first
        ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bufferFP ((Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ()))
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufferPtr ->
        let
          amountInBuffer :: Int
amountInBuffer = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
          in if Int
amountInBuffer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
howMany
            then
              -- Buffer contains all we need, so we don't need to fetch at all
              do
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
destination (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bufferPtr Int
offset) Int
howMany
                IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
bufferStateRef (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
howMany, Int
end)
                Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())
            else
              do
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
destination (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bufferPtr Int
offset) Int
amountInBuffer
                (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize (Int
howMany Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amountInBuffer) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
destination Int
amountInBuffer)

fetchMany :: (Ptr Word8 -> Int -> IO (Either Text Int)) -> ForeignPtr Word8 -> IORef (Int, Int) -> Int -> Int -> Ptr Word8 -> IO (Either Text ())
fetchMany :: (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize Int
remaining Ptr Word8
destination =
  if Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
chunkSize
    then
      -- Circumvent the buffer and write to destination directly
      Ptr Word8
-> Int -> (Int -> IO (Either Text ())) -> IO (Either Text ())
fetchingSome Ptr Word8
destination Int
chunkSize ((Int -> IO (Either Text ())) -> IO (Either Text ()))
-> (Int -> IO (Either Text ())) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ \Int
amountFetched ->
      if Int
amountFetched Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
remaining
        then
          -- We've fetched all we've wanted, time to stop
          do
            IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
bufferStateRef (Int
0, Int
0)
            Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())
        else
          -- Go on and get some more
          (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amountFetched) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
destination Int
amountFetched)
    else
      -- Write to buffer first and then stream a part of it to the destination
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bufferFP ((Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ()))
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufferPtr ->
      Ptr Word8
-> Int -> (Int -> IO (Either Text ())) -> IO (Either Text ())
fetchingSome Ptr Word8
bufferPtr Int
chunkSize ((Int -> IO (Either Text ())) -> IO (Either Text ()))
-> (Int -> IO (Either Text ())) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ \Int
amountFetched ->
      do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
destination Ptr Word8
bufferPtr Int
remaining
        IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
bufferStateRef (Int
remaining, Int
amountFetched)
        Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())
  where
    fetchingSome :: Ptr Word8
-> Int -> (Int -> IO (Either Text ())) -> IO (Either Text ())
fetchingSome Ptr Word8
destination Int
amount Int -> IO (Either Text ())
handle =
      do
        Either Text Int
fetchResult <- Ptr Word8 -> Int -> IO (Either Text Int)
fetch Ptr Word8
destination Int
amount
        case Either Text Int
fetchResult of
          Left Text
msg -> Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ()
forall a b. a -> Either a b
Left Text
msg)
          Right Int
amountFetched ->
            if Int
amountFetched Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
              then Either Text () -> IO (Either Text ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"End of input")
              else Int -> IO (Either Text ())
handle Int
amountFetched

peek :: (Ptr Word8 -> Int -> IO (Either Text Int)) -> ForeignPtr Word8 -> IORef (Int, Int) -> Int -> Int -> (Ptr Word8 -> IO peekd) -> IO (Either Text peekd)
peek :: (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> (Ptr Word8 -> IO peekd)
-> IO (Either Text peekd)
peek Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize Int
howMany Ptr Word8 -> IO peekd
peek =
  do
    (Int
offset, Int
end) <- IORef (Int, Int) -> IO (Int, Int)
forall a. IORef a -> IO a
readIORef IORef (Int, Int)
bufferStateRef
    let
      amountInBuffer :: Int
amountInBuffer = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
      in if Int
amountInBuffer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
howMany
        then
          -- We have enough bytes in the buffer, so need not to allocate anything and can directly decode from the buffer
          ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bufferFP ((Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd))
-> (Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufferPtr ->
          do
            peekd
peekd <- Ptr Word8 -> IO peekd
peek Ptr Word8
bufferPtr
            IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
bufferStateRef (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
howMany, Int
end)
            Either Text peekd -> IO (Either Text peekd)
forall (m :: * -> *) a. Monad m => a -> m a
return (peekd -> Either Text peekd
forall a b. b -> Either a b
Right peekd
peekd)
        else
          -- We have to allocate a temporary space to prefetch the data into
          Int
-> (Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
howMany ((Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd))
-> (Ptr Word8 -> IO (Either Text peekd)) -> IO (Either Text peekd)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tmpPtr ->
          do
            Either Text ()
writeResult <-
              if Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset
                then
                  -- Buffer is empty, we need to fetch right away
                  (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize Int
howMany Ptr Word8
tmpPtr
                else
                  -- We still have something in the buffer, so we'll read from it first
                  ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bufferFP ((Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ()))
-> (Ptr Word8 -> IO (Either Text ())) -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufferPtr ->
                  do
                    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
A.memcpy Ptr Word8
tmpPtr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
bufferPtr Int
offset) Int
amountInBuffer
                    (Ptr Word8 -> Int -> IO (Either Text Int))
-> ForeignPtr Word8
-> IORef (Int, Int)
-> Int
-> Int
-> Ptr Word8
-> IO (Either Text ())
fetchMany Ptr Word8 -> Int -> IO (Either Text Int)
fetch ForeignPtr Word8
bufferFP IORef (Int, Int)
bufferStateRef Int
chunkSize (Int
howMany Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amountInBuffer) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
tmpPtr Int
amountInBuffer)
            case Either Text ()
writeResult of
              Right () -> do
                peekd
peekd <- Ptr Word8 -> IO peekd
peek Ptr Word8
tmpPtr
                Either Text peekd -> IO (Either Text peekd)
forall (m :: * -> *) a. Monad m => a -> m a
return (peekd -> Either Text peekd
forall a b. b -> Either a b
Right peekd
peekd)
              Left Text
msg -> Either Text peekd -> IO (Either Text peekd)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text peekd
forall a b. a -> Either a b
Left Text
msg)