module Ptr.PokeAndPeek
where

import Ptr.Prelude
import qualified Ptr.IO as A


{-|
Encoder and decoder of the same binary representation.

You can compose both the covariant and contravariant parameters of PokeAndPeek
using Applicative and Profunctor. E.g.,

>word8AndWord32 :: PokeAndPeek (Word8, Word32) (Word8, Word32)
>word8AndWord32 =
>  (,) <$> lmap fst word8 <*> lmap snd beWord32
-}
data PokeAndPeek input output =
  PokeAndPeek !Int (Ptr Word8 -> input -> IO ()) (Ptr Word8 -> IO output)

{-|
A codec, which encodes and decodes the same type. E.g.,

>word8AndWord32 :: InvPokeAndPeek (Word8, Word32)
>word8AndWord32 =
>  (,) <$> lmap fst word8 <*> lmap snd beWord32
-}
type InvPokeAndPeek value =
  PokeAndPeek value value

instance Profunctor PokeAndPeek where
  {-# INLINE dimap #-}
  dimap :: (a -> b) -> (c -> d) -> PokeAndPeek b c -> PokeAndPeek a d
dimap a -> b
fn1 c -> d
fn2 (PokeAndPeek Int
size Ptr Word8 -> b -> IO ()
poke Ptr Word8 -> IO c
peek) =
    Int
-> (Ptr Word8 -> a -> IO ())
-> (Ptr Word8 -> IO d)
-> PokeAndPeek a d
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
size (\Ptr Word8
ptr -> Ptr Word8 -> b -> IO ()
poke Ptr Word8
ptr (b -> IO ()) -> (a -> b) -> a -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
fn1) (\Ptr Word8
ptr -> (c -> d) -> IO c -> IO d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
fn2 (Ptr Word8 -> IO c
peek Ptr Word8
ptr))

instance Functor (PokeAndPeek input) where
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> PokeAndPeek input a -> PokeAndPeek input b
fmap a -> b
fn (PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
poke Ptr Word8 -> IO a
peek) =
    Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO b)
-> PokeAndPeek input b
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
size Ptr Word8 -> input -> IO ()
poke ((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
peek)

instance Applicative (PokeAndPeek input) where
  {-# INLINE pure #-}
  pure :: a -> PokeAndPeek input a
pure a
x =
    Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO a)
-> PokeAndPeek input a
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
0 (\Ptr Word8
_ input
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\Ptr Word8
_ -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE (<*>) #-}
  <*> :: PokeAndPeek input (a -> b)
-> PokeAndPeek input a -> PokeAndPeek input b
(<*>) (PokeAndPeek Int
leftSize Ptr Word8 -> input -> IO ()
leftPoke Ptr Word8 -> IO (a -> b)
leftPeek) (PokeAndPeek Int
rightSize Ptr Word8 -> input -> IO ()
rightPoke Ptr Word8 -> IO a
rightPeek) =
    Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO b)
-> PokeAndPeek input b
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek (Int
leftSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightSize) Ptr Word8 -> input -> IO ()
poke Ptr Word8 -> IO b
peek
    where
      poke :: Ptr Word8 -> input -> IO ()
poke Ptr Word8
ptr input
input =
        Ptr Word8 -> input -> IO ()
leftPoke Ptr Word8
ptr input
input IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> input -> IO ()
rightPoke (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
leftSize) input
input
      peek :: Ptr Word8 -> IO b
peek Ptr Word8
ptr =
        Ptr Word8 -> IO (a -> b)
leftPeek 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
rightPeek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
leftSize)

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

{-# INLINE leWord16 #-}
leWord16 :: InvPokeAndPeek Word16
leWord16 :: InvPokeAndPeek Word16
leWord16 =
  {-# SCC "leWord16" #-} 
  Int
-> (Ptr Word8 -> Word16 -> IO ())
-> (Ptr Word8 -> IO Word16)
-> InvPokeAndPeek Word16
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
2 Ptr Word8 -> Word16 -> IO ()
A.pokeLEWord16 Ptr Word8 -> IO Word16
A.peekLEWord16

{-# INLINE leWord32 #-}
leWord32 :: InvPokeAndPeek Word32
leWord32 :: InvPokeAndPeek Word32
leWord32 =
  {-# SCC "leWord32" #-} 
  Int
-> (Ptr Word8 -> Word32 -> IO ())
-> (Ptr Word8 -> IO Word32)
-> InvPokeAndPeek Word32
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
4 Ptr Word8 -> Word32 -> IO ()
A.pokeLEWord32 Ptr Word8 -> IO Word32
A.peekLEWord32

{-# INLINE leWord64 #-}
leWord64 :: InvPokeAndPeek Word64
leWord64 :: InvPokeAndPeek Word64
leWord64 =
  {-# SCC "leWord64" #-} 
  Int
-> (Ptr Word8 -> Word64 -> IO ())
-> (Ptr Word8 -> IO Word64)
-> InvPokeAndPeek Word64
forall input output.
Int
-> (Ptr Word8 -> input -> IO ())
-> (Ptr Word8 -> IO output)
-> PokeAndPeek input output
PokeAndPeek Int
8 Ptr Word8 -> Word64 -> IO ()
A.pokeLEWord64 Ptr Word8 -> IO Word64
A.peekLEWord64

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

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

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

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