module Ptr.Peek
where

import Ptr.Prelude hiding (take)
import qualified Ptr.PokeAndPeek as B
import qualified Ptr.Parse as C
import qualified Ptr.ParseUnbound as D
import qualified Ptr.IO as A


data Peek output =
  Peek {-# UNPACK #-} !Int !(Ptr Word8 -> IO output)

instance Functor Peek where
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> Peek a -> Peek b
fmap a -> b
fn (Peek Int
size Ptr Word8 -> IO a
io) =
    Int -> (Ptr Word8 -> IO b) -> Peek b
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
size ((a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn (IO a -> IO b) -> (Ptr Word8 -> IO a) -> Ptr Word8 -> IO b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word8 -> IO a
io)

instance Applicative Peek where
  {-# INLINE pure #-}
  pure :: a -> Peek a
pure a
x =
    Int -> (Ptr Word8 -> IO a) -> Peek a
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
0 (IO a -> Ptr Word8 -> IO a
forall a b. a -> b -> a
const (a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
  {-# INLINE (<*>) #-}
  <*> :: Peek (a -> b) -> Peek a -> Peek b
(<*>) (Peek Int
leftSize Ptr Word8 -> IO (a -> b)
leftIO) (Peek Int
rightSize Ptr Word8 -> IO a
rightIO) =
    Int -> (Ptr Word8 -> IO b) -> Peek b
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek (Int
leftSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightSize) Ptr Word8 -> IO b
io
    where
      io :: Ptr Word8 -> IO b
io Ptr Word8
ptr =
        Ptr Word8 -> IO (a -> b)
leftIO Ptr Word8
ptr IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO a
rightIO (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
leftSize)


{-# INLINE word8 #-}
word8 :: Peek Word8
word8 :: Peek Word8
word8 =
  {-# SCC "word8" #-} 
  Int -> (Ptr Word8 -> IO Word8) -> Peek Word8
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
1 Ptr Word8 -> IO Word8
A.peekWord8

{-# INLINE beWord16 #-}
beWord16 :: Peek Word16
beWord16 :: Peek Word16
beWord16 =
  {-# SCC "beWord16" #-} 
  Int -> (Ptr Word8 -> IO Word16) -> Peek Word16
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
2 Ptr Word8 -> IO Word16
A.peekBEWord16

{-# INLINE beWord32 #-}
beWord32 :: Peek Word32
beWord32 :: Peek Word32
beWord32 =
  {-# SCC "beWord32" #-} 
  Int -> (Ptr Word8 -> IO Word32) -> Peek Word32
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
4 Ptr Word8 -> IO Word32
A.peekBEWord32

{-# INLINE beWord64 #-}
beWord64 :: Peek Word64
beWord64 :: Peek Word64
beWord64 =
  {-# SCC "beWord64" #-} 
  Int -> (Ptr Word8 -> IO Word64) -> Peek Word64
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
8 Ptr Word8 -> IO Word64
A.peekBEWord64

{-# INLINE bytes #-}
bytes :: Int -> Peek ByteString
bytes :: Int -> Peek ByteString
bytes !Int
amount =
  {-# SCC "bytes" #-} 
  Int -> (Ptr Word8 -> IO ByteString) -> Peek ByteString
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
amount (\ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ByteString
A.peekBytes Ptr Word8
ptr Int
amount)

{-# INLINE shortByteString #-}
shortByteString :: Int -> Peek ShortByteString
shortByteString :: Int -> Peek ShortByteString
shortByteString !Int
amount =
  {-# SCC "shortByteString" #-} 
  Int -> (Ptr Word8 -> IO ShortByteString) -> Peek ShortByteString
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
amount (\ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ShortByteString
A.peekShortByteString Ptr Word8
ptr Int
amount)

{-# INLINE pokeAndPeek #-}
pokeAndPeek :: B.PokeAndPeek input output -> Peek output
pokeAndPeek :: PokeAndPeek input output -> Peek output
pokeAndPeek (B.PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
_ Ptr Word8 -> IO output
io) =
  {-# SCC "pokeAndPeek" #-} 
  Int -> (Ptr Word8 -> IO output) -> Peek output
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
size Ptr Word8 -> IO output
io

{-|
Given the length of the data and a specification of its sequential consumption,
produces Peek, which results in Just the successfully taken value,
or Nothing, if the specified length of data wasn't enough.
-}
{-# INLINE parse #-}
parse :: Int -> C.Parse a -> (Int -> a) -> (Text -> a) -> Peek a
parse :: Int -> Parse a -> (Int -> a) -> (Text -> a) -> Peek a
parse Int
amount (C.Parse Int
-> Ptr Word8
-> forall result.
   (Int -> IO result)
   -> (Text -> IO result)
   -> (a -> Int -> Ptr Word8 -> IO result)
   -> IO result
parseIO) Int -> a
eoi Text -> a
error =
  {-# SCC "parse" #-} 
  Int -> (Ptr Word8 -> IO a) -> Peek a
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
amount ((Ptr Word8 -> IO a) -> Peek a) -> (Ptr Word8 -> IO a) -> Peek a
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr ->
  Int
-> Ptr Word8
-> (Int -> IO a)
-> (Text -> IO a)
-> (a -> Int -> Ptr Word8 -> IO a)
-> IO a
Int
-> Ptr Word8
-> forall result.
   (Int -> IO result)
   -> (Text -> IO result)
   -> (a -> Int -> Ptr Word8 -> IO result)
   -> IO result
parseIO Int
amount Ptr Word8
ptr (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Int -> a) -> Int -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a
eoi) (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Text -> a) -> Text -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> a
error) (\a
result Int
_ Ptr Word8
_ -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result)

{-|
Given the length of the data and a specification of its sequential consumption,
produces Peek, which results in Just the successfully taken value,
or Nothing, if the specified length of data wasn't enough.
-}
{-# INLINE parseUnbound #-}
parseUnbound :: Int -> D.ParseUnbound a -> (Int -> a) -> (Text -> a) -> Peek a
parseUnbound :: Int -> ParseUnbound a -> (Int -> a) -> (Text -> a) -> Peek a
parseUnbound Int
sizeBound (D.ParseUnbound Ptr Word8
-> forall result.
   (Text -> IO result) -> (a -> Int -> IO result) -> IO result
parseIO) Int -> a
eoi Text -> a
error =
  {-# SCC "parse" #-} 
  Int -> (Ptr Word8 -> IO a) -> Peek a
forall output. Int -> (Ptr Word8 -> IO output) -> Peek output
Peek Int
sizeBound ((Ptr Word8 -> IO a) -> Peek a) -> (Ptr Word8 -> IO a) -> Peek a
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr ->
  Ptr Word8 -> (Text -> IO a) -> (a -> Int -> IO a) -> IO a
Ptr Word8
-> forall result.
   (Text -> IO result) -> (a -> Int -> IO result) -> IO result
parseIO Ptr Word8
ptr (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Text -> a) -> Text -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> a
error)
    (\ a
result Int
size -> if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sizeBound
      then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
eoi (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeBound))
      else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result)

{-|
A standard idiom, where a header specifies the length of the body.

Produces Peek, which itself produces another Peek, which is the same as the result of the 'parse' function.
-}
{-# INLINE peekAmountAndParse #-}
peekAmountAndParse :: Peek Int -> C.Parse a -> (Int -> a) -> (Text -> a) -> Peek (Peek a)
peekAmountAndParse :: Peek Int -> Parse a -> (Int -> a) -> (Text -> a) -> Peek (Peek a)
peekAmountAndParse Peek Int
peekAmount Parse a
parse_ Int -> a
eoi Text -> a
error =
  {-# SCC "peekAmountAndParse" #-} 
  ((Int -> Peek a) -> Peek Int -> Peek (Peek a))
-> Peek Int -> (Int -> Peek a) -> Peek (Peek a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Peek a) -> Peek Int -> Peek (Peek a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Peek Int
peekAmount ((Int -> Peek a) -> Peek (Peek a))
-> (Int -> Peek a) -> Peek (Peek a)
forall a b. (a -> b) -> a -> b
$ \Int
amount ->
  Int -> Parse a -> (Int -> a) -> (Text -> a) -> Peek a
forall a. Int -> Parse a -> (Int -> a) -> (Text -> a) -> Peek a
parse Int
amount Parse a
parse_ Int -> a
eoi Text -> a
error