{-# LANGUAGE UndecidableInstances #-}

module Dahdit.LiftedPrim
  ( LiftedPrim (..)
  , indexArrayLiftedInElems
  , writeArrayLiftedInElems
  , indexPtrLiftedInElems
  , writePtrLiftedInElems
  , setByteArrayLifted
  )
where

import Control.Monad.Primitive (PrimMonad (..))
import Dahdit.Internal
  ( EndianPair (..)
  , ViaEndianPair (..)
  , ViaFromIntegral (..)
  , mkDoubleLE
  , mkFloatLE
  , mkWord16LE
  , mkWord24LE
  , mkWord32LE
  , mkWord64LE
  , unMkDoubleLE
  , unMkFloatLE
  , unMkWord16LE
  , unMkWord24LE
  , unMkWord32LE
  , unMkWord64LE
  )
import Dahdit.Nums
  ( DoubleBE
  , DoubleLE (..)
  , FloatBE
  , FloatLE (..)
  , Int16BE
  , Int16LE (..)
  , Int24BE
  , Int24LE (..)
  , Int32BE
  , Int32LE (..)
  , Int64BE
  , Int64LE (..)
  , Word16BE
  , Word16LE (..)
  , Word24BE
  , Word24LE (..)
  , Word32BE
  , Word32LE (..)
  , Word64BE
  , Word64LE (..)
  )
import Dahdit.Proxy (proxyFor)
import Dahdit.Sizes (ByteCount (..), ElemCount (..), StaticByteSized (..))
import Data.Coerce (coerce)
import Data.Foldable (for_)
import Data.Int (Int8)
import Data.Primitive.ByteArray
  ( ByteArray
  , MutableByteArray
  , indexByteArray
  , writeByteArray
  )
import Data.Primitive.Ptr (indexOffPtr, writeOffPtr)
import Data.Proxy (Proxy (..))
import Data.Word (Word8)
import Foreign.Ptr (Ptr)

-- | This is a stripped-down version of 'Prim' that is possible for a human to implement.
-- It's all about reading and writing structures from lifted byte arrays and pointers.
class (StaticByteSized a) => LiftedPrim a where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> a
  writeArrayLiftedInBytes :: (PrimMonad m) => MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> a
  writePtrLiftedInBytes :: (PrimMonad m) => Ptr Word8 -> ByteCount -> a -> m ()

indexArrayLiftedInElems :: (LiftedPrim a) => Proxy a -> ByteArray -> ElemCount -> a
indexArrayLiftedInElems :: forall a. LiftedPrim a => Proxy a -> ByteArray -> ElemCount -> a
indexArrayLiftedInElems Proxy a
prox ByteArray
arr ElemCount
pos =
  forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
pos forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy a
prox)

writeArrayLiftedInElems :: (PrimMonad m, LiftedPrim a) => MutableByteArray (PrimState m) -> ElemCount -> a -> m ()
writeArrayLiftedInElems :: forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
MutableByteArray (PrimState m) -> ElemCount -> a -> m ()
writeArrayLiftedInElems MutableByteArray (PrimState m)
arr ElemCount
pos a
val =
  forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
pos forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall a. a -> Proxy a
proxyFor a
val)) a
val

indexPtrLiftedInElems :: (LiftedPrim a) => Proxy a -> Ptr Word8 -> ElemCount -> a
indexPtrLiftedInElems :: forall a. LiftedPrim a => Proxy a -> Ptr Word8 -> ElemCount -> a
indexPtrLiftedInElems Proxy a
prox Ptr Word8
ptr ElemCount
pos =
  forall a. LiftedPrim a => Ptr Word8 -> ByteCount -> a
indexPtrLiftedInBytes Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
pos forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy a
prox)

writePtrLiftedInElems :: (PrimMonad m, LiftedPrim a) => Ptr Word8 -> ElemCount -> a -> m ()
writePtrLiftedInElems :: forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
Ptr Word8 -> ElemCount -> a -> m ()
writePtrLiftedInElems Ptr Word8
ptr ElemCount
pos a
val =
  forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
Ptr Word8 -> ByteCount -> a -> m ()
writePtrLiftedInBytes Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
pos forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall a. a -> Proxy a
proxyFor a
val)) a
val

instance LiftedPrim Word8 where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Word8
indexArrayLiftedInBytes ByteArray
arr = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Word8 -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
marr = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
marr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Word8
indexPtrLiftedInBytes Ptr Word8
ptr = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Word8 -> m ()
writePtrLiftedInBytes Ptr Word8
ptr = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

instance LiftedPrim Int8 where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Int8
indexArrayLiftedInBytes ByteArray
arr = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Int8 -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
marr = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
marr forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Int8
indexPtrLiftedInBytes Ptr Word8
ptr = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr Word8
ptr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Int8 -> m ()
writePtrLiftedInBytes Ptr Word8
ptr = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr (coerce :: forall a b. Coercible a b => a -> b
coerce Ptr Word8
ptr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

-- | NOTE: Relies on same byte width of both types!
instance (Integral x, LiftedPrim x, Integral y, n ~ StaticSize x) => LiftedPrim (ViaFromIntegral n x y) where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> ViaFromIntegral n x y
indexArrayLiftedInBytes ByteArray
arr ByteCount
off = forall (n :: Nat) x y. y -> ViaFromIntegral n x y
ViaFromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr ByteCount
off :: x))
  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> ByteCount -> ViaFromIntegral n x y -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off ViaFromIntegral n x y
val = let x :: x
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) x y. ViaFromIntegral n x y -> y
unViaFromIntegral ViaFromIntegral n x y
val) :: x in forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off x
x
  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> ViaFromIntegral n x y
indexPtrLiftedInBytes Ptr Word8
ptr = forall (n :: Nat) x y. y -> ViaFromIntegral n x y
ViaFromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @x @y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LiftedPrim a => Ptr Word8 -> ByteCount -> a
indexPtrLiftedInBytes Ptr Word8
ptr
  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> ViaFromIntegral n x y -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off (ViaFromIntegral y
y) = forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
Ptr Word8 -> ByteCount -> a -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral y
y :: x)

instance LiftedPrim Word16LE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Word16LE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
    in  Word16 -> Word16LE
Word16LE (Word8 -> Word8 -> Word16
mkWord16LE Word8
b0 Word8
b1)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Word16LE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off Word16LE
w =
    let (!Word8
b0, !Word8
b1) = Word16 -> (Word8, Word8)
unMkWord16LE (Word16LE -> Word16
unWord16LE Word16LE
w)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Word16LE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
    in  Word16 -> Word16LE
Word16LE (Word8 -> Word8 -> Word16
mkWord16LE Word8
b0 Word8
b1)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Word16LE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off Word16LE
w =
    let (!Word8
b0, !Word8
b1) = Word16 -> (Word8, Word8)
unMkWord16LE (Word16LE -> Word16
unWord16LE Word16LE
w)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1

instance LiftedPrim Word24LE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Word24LE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
    in  Word24 -> Word24LE
Word24LE (Word8 -> Word8 -> Word8 -> Word24
mkWord24LE Word8
b0 Word8
b1 Word8
b2)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Word24LE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off Word24LE
w = do
    let (!Word8
b0, !Word8
b1, !Word8
b2) = Word24 -> (Word8, Word8, Word8)
unMkWord24LE (Word24LE -> Word24
unWord24LE Word24LE
w)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Word24LE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
    in  Word24 -> Word24LE
Word24LE (Word8 -> Word8 -> Word8 -> Word24
mkWord24LE Word8
b0 Word8
b1 Word8
b2)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Word24LE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off Word24LE
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2) = Word24 -> (Word8, Word8, Word8)
unMkWord24LE (Word24LE -> Word24
unWord24LE Word24LE
w)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2

instance LiftedPrim Word32LE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Word32LE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
    in  Word32 -> Word32LE
Word32LE (Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b0 Word8
b1 Word8
b2 Word8
b3)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Word32LE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off Word32LE
w = do
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE (Word32LE -> Word32
unWord32LE Word32LE
w)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Word32LE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
    in  Word32 -> Word32LE
Word32LE (Word8 -> Word8 -> Word8 -> Word8 -> Word32
mkWord32LE Word8
b0 Word8
b1 Word8
b2 Word8
b3)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Word32LE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off Word32LE
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Word32 -> (Word8, Word8, Word8, Word8)
unMkWord32LE (Word32LE -> Word32
unWord32LE Word32LE
w)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3

instance LiftedPrim Word64LE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> Word64LE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
1)
        !b2 :: Word8
b2 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
2)
        !b3 :: Word8
b3 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
3)
        !b4 :: Word8
b4 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
4)
        !b5 :: Word8
b5 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
5)
        !b6 :: Word8
b6 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
6)
        !b7 :: Word8
b7 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
7)
    in  Word64 -> Word64LE
Word64LE (Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word64
mkWord64LE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> Word64LE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off Word64LE
w = do
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE (Word64LE -> Word64
unWord64LE Word64LE
w)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4) Word8
b4
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5) Word8
b5
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6) Word8
b6
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7) Word8
b7

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> Word64LE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
        !b4 :: Word8
b4 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4)
        !b5 :: Word8
b5 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5)
        !b6 :: Word8
b6 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6)
        !b7 :: Word8
b7 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7)
    in  Word64 -> Word64LE
Word64LE (Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word64
mkWord64LE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> Word64LE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off Word64LE
w =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkWord64LE (Word64LE -> Word64
unWord64LE Word64LE
w)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4) Word8
b4
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5) Word8
b5
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6) Word8
b6
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7) Word8
b7

instance LiftedPrim FloatLE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> FloatLE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
    in  Float -> FloatLE
FloatLE (Word8 -> Word8 -> Word8 -> Word8 -> Float
mkFloatLE Word8
b0 Word8
b1 Word8
b2 Word8
b3)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> FloatLE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off FloatLE
f = do
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Float -> (Word8, Word8, Word8, Word8)
unMkFloatLE (FloatLE -> Float
unFloatLE FloatLE
f)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> FloatLE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
    in  Float -> FloatLE
FloatLE (Word8 -> Word8 -> Word8 -> Word8 -> Float
mkFloatLE Word8
b0 Word8
b1 Word8
b2 Word8
b3)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> FloatLE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off FloatLE
f =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3) = Float -> (Word8, Word8, Word8, Word8)
unMkFloatLE (FloatLE -> Float
unFloatLE FloatLE
f)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3

instance LiftedPrim DoubleLE where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> DoubleLE
indexArrayLiftedInBytes ByteArray
arr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
1)
        !b2 :: Word8
b2 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
2)
        !b3 :: Word8
b3 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
3)
        !b4 :: Word8
b4 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
4)
        !b5 :: Word8
b5 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
5)
        !b6 :: Word8
b6 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
6)
        !b7 :: Word8
b7 = forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
7)
    in  Double -> DoubleLE
DoubleLE (Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Double
mkDoubleLE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7)

  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> ByteCount -> DoubleLE -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off DoubleLE
f = do
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkDoubleLE (DoubleLE -> Double
unDoubleLE DoubleLE
f)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4) Word8
b4
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5) Word8
b5
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6) Word8
b6
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7) Word8
b7

  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> DoubleLE
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off =
    let !b0 :: Word8
b0 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off)
        !b1 :: Word8
b1 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1)
        !b2 :: Word8
b2 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2)
        !b3 :: Word8
b3 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3)
        !b4 :: Word8
b4 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4)
        !b5 :: Word8
b5 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5)
        !b6 :: Word8
b6 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6)
        !b7 :: Word8
b7 = forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7)
    in  Double -> DoubleLE
DoubleLE (Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Double
mkDoubleLE Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7)

  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> DoubleLE -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off DoubleLE
f =
    let (!Word8
b0, !Word8
b1, !Word8
b2, !Word8
b3, !Word8
b4, !Word8
b5, !Word8
b6, !Word8
b7) = Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
unMkDoubleLE (DoubleLE -> Double
unDoubleLE DoubleLE
f)
    in  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off) Word8
b0
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
1) Word8
b1
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
2) Word8
b2
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
3) Word8
b3
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
4) Word8
b4
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
5) Word8
b5
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
6) Word8
b6
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> a -> m ()
writeOffPtr Ptr Word8
ptr (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
off forall a. Num a => a -> a -> a
+ Int
7) Word8
b7

instance (LiftedPrim le, EndianPair n le be, n ~ StaticSize le) => LiftedPrim (ViaEndianPair n le be) where
  indexArrayLiftedInBytes :: ByteArray -> ByteCount -> ViaEndianPair n le be
indexArrayLiftedInBytes ByteArray
arr ByteCount
off = forall (n :: Nat) le be. be -> ViaEndianPair n le be
ViaEndianPair (forall (n :: Nat) le be. EndianPair n le be => le -> be
toBigEndian (forall a. LiftedPrim a => ByteArray -> ByteCount -> a
indexArrayLiftedInBytes ByteArray
arr ByteCount
off))
  writeArrayLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> ByteCount -> ViaEndianPair n le be -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off = forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr ByteCount
off forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) le be. EndianPair n le be => be -> le
toLittleEndian forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) le be. ViaEndianPair n le be -> be
unViaEndianPair
  indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> ViaEndianPair n le be
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off = forall (n :: Nat) le be. be -> ViaEndianPair n le be
ViaEndianPair (forall (n :: Nat) le be. EndianPair n le be => le -> be
toBigEndian (forall a. LiftedPrim a => Ptr Word8 -> ByteCount -> a
indexPtrLiftedInBytes Ptr Word8
ptr ByteCount
off))
  writePtrLiftedInBytes :: forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteCount -> ViaEndianPair n le be -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off = forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
Ptr Word8 -> ByteCount -> a -> m ()
writePtrLiftedInBytes Ptr Word8
ptr ByteCount
off forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) le be. EndianPair n le be => be -> le
toLittleEndian forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) le be. ViaEndianPair n le be -> be
unViaEndianPair

deriving via (ViaFromIntegral 2 Word16LE Int16LE) instance LiftedPrim Int16LE

deriving via (ViaFromIntegral 3 Word24LE Int24LE) instance LiftedPrim Int24LE

deriving via (ViaFromIntegral 4 Word32LE Int32LE) instance LiftedPrim Int32LE

deriving via (ViaFromIntegral 8 Word64LE Int64LE) instance LiftedPrim Int64LE

deriving via (ViaEndianPair 2 Word16LE Word16BE) instance LiftedPrim Word16BE

deriving via (ViaEndianPair 2 Int16LE Int16BE) instance LiftedPrim Int16BE

deriving via (ViaEndianPair 3 Word24LE Word24BE) instance LiftedPrim Word24BE

deriving via (ViaEndianPair 3 Int24LE Int24BE) instance LiftedPrim Int24BE

deriving via (ViaEndianPair 4 Word32LE Word32BE) instance LiftedPrim Word32BE

deriving via (ViaEndianPair 4 Int32LE Int32BE) instance LiftedPrim Int32BE

deriving via (ViaEndianPair 8 Word64LE Word64BE) instance LiftedPrim Word64BE

deriving via (ViaEndianPair 8 Int64LE Int64BE) instance LiftedPrim Int64BE

deriving via (ViaEndianPair 4 FloatLE FloatBE) instance LiftedPrim FloatBE

deriving via (ViaEndianPair 8 DoubleLE DoubleBE) instance LiftedPrim DoubleBE

-- | Fill a byte array with the given value
setByteArrayLifted
  :: (PrimMonad m, LiftedPrim a) => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> a -> m ()
setByteArrayLifted :: forall (m :: * -> *) a.
(PrimMonad m, LiftedPrim a) =>
MutableByteArray (PrimState m)
-> ByteCount -> ByteCount -> a -> m ()
setByteArrayLifted MutableByteArray (PrimState m)
arr ByteCount
off ByteCount
len a
val = do
  let elemSize :: ByteCount
elemSize = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall a. a -> Proxy a
proxyFor a
val)
      elemLen :: ByteCount
elemLen = forall a. Integral a => a -> a -> a
div (coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
len) ByteCount
elemSize
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteCount
0 .. ByteCount
elemLen forall a. Num a => a -> a -> a
- ByteCount
1] forall a b. (a -> b) -> a -> b
$ \ByteCount
pos ->
    forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> ByteCount -> a -> m ()
writeArrayLiftedInBytes MutableByteArray (PrimState m)
arr (ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
pos forall a. Num a => a -> a -> a
* ByteCount
elemSize) a
val