{-# 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 (Word8,Word16,Word32,Word64)

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

-- | Encode a 16-bit signed integer as 4 bytes.
int16 :: Int16 -> Bytes
{-# inline int16 #-}
int16 :: Int16 -> Bytes
int16 = Word16 -> Bytes
word16 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 a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
arr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
2
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
w Int
8))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word8 Word16
w)
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
arr

-- | Encode a 16-bit signed integer as 4 bytes.
int64 :: Int64 -> Bytes
{-# inline int64 #-}
int64 :: Int64 -> Bytes
int64 = Word64 -> Bytes
word64 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 a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
arr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
8
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
56))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
48))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
40))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
32))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
24))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
5 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
16))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
6 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w Int
8))
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
arr Int
7 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 Word64
w)
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
arr