{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}

module Data.Bytes.Encode.BigEndian
  ( word16
  , word32
  , word64
  , int16
  , int32
  , int64
  ) where

import Control.Monad.ST.Run (runByteArrayST)
import Data.Bits (unsafeShiftR)
import Data.Bytes.Types (Bytes)
import Data.Int (Int16, Int32, Int64)
import Data.Primitive (ByteArray)
import Data.Word (Word16, Word32, Word64, Word8)

import qualified Data.Bytes.Pure as Pure
import qualified Data.Primitive as PM

-- | Encode a 32-bit signed integer as 4 bytes.
int32 :: Int32 -> Bytes
{-# INLINE int32 #-}
int32 :: Int32 -> Bytes
int32 = Word32 -> Bytes
word32 (Word32 -> Bytes) -> (Int32 -> Word32) -> Int32 -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32

-- | Encode a 32-bit unsigned integer as 4 bytes.
word32 :: Word32 -> Bytes
word32 :: Word32 -> Bytes
word32 !Word32
w = ByteArray -> Bytes
Pure.fromByteArray (Word32 -> ByteArray
word32U Word32
w)

word32U :: Word32 -> ByteArray
word32U :: Word32 -> ByteArray
word32U !Word32
w = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
4
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word8 (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
24))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word8 (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
16))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word8 (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
8))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word8 Word32
w)
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr

-- | Encode a 16-bit signed integer as 4 bytes.
int16 :: Int16 -> Bytes
{-# INLINE int16 #-}
int16 :: Int16 -> Bytes
int16 = Word16 -> Bytes
word16 (Word16 -> Bytes) -> (Int16 -> Word16) -> Int16 -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16

-- | Encode a 16-bit unsigned integer as 4 bytes.
word16 :: Word16 -> Bytes
word16 :: Word16 -> Bytes
word16 !Word16
w = ByteArray -> Bytes
Pure.fromByteArray (Word16 -> ByteArray
word16U Word16
w)

word16U :: Word16 -> ByteArray
word16U :: Word16 -> ByteArray
word16U !Word16
w = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
2
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word8 (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
w Int
8))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word8 Word16
w)
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr

-- | Encode a 16-bit signed integer as 4 bytes.
int64 :: Int64 -> Bytes
{-# INLINE int64 #-}
int64 :: Int64 -> Bytes
int64 = Word64 -> Bytes
word64 (Word64 -> Bytes) -> (Int64 -> Word64) -> Int64 -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64

-- | Encode a 16-bit unsigned integer as 4 bytes.
word64 :: Word64 -> Bytes
word64 :: Word64 -> Bytes
word64 !Word64
w = ByteArray -> Bytes
Pure.fromByteArray (Word64 -> ByteArray
word64U Word64
w)

word64U :: Word64 -> ByteArray
word64U :: Word64 -> ByteArray
word64U !Word64
w = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
8
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
56))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
48))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
40))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
32))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
24))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
5 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
16))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
6 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
8))
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
7 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 Word64
w)
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr