{-# LANGUAGE Trustworthy #-}

{-# LANGUAGE TypeApplications #-}

-- | Copyright   : (c) 2010-2011 Simon Meier
-- License       : BSD3-style (see LICENSE)
--
-- Maintainer    : Simon Meier <iridcode@gmail.com>
-- Portability   : GHC
--
module Data.ByteString.Builder.Prim.Binary (

  -- ** Binary encodings
    int8
  , word8

  -- *** Big-endian
  , int16BE
  , int32BE
  , int64BE

  , word16BE
  , word32BE
  , word64BE

  , floatBE
  , doubleBE

  -- *** Little-endian
  , int16LE
  , int32LE
  , int64LE

  , word16LE
  , word32LE
  , word64LE

  , floatLE
  , doubleLE

  -- *** Non-portable, host-dependent
  , intHost
  , int16Host
  , int32Host
  , int64Host

  , wordHost
  , word16Host
  , word32Host
  , word64Host

  , floatHost
  , doubleHost

  ) where

import Data.ByteString.Builder.Prim.Internal
import Data.ByteString.Builder.Prim.Internal.Floating
import Data.ByteString.Utils.ByteOrder
import Data.ByteString.Utils.UnalignedAccess

import Foreign

------------------------------------------------------------------------------
-- Binary encoding
------------------------------------------------------------------------------

-- Word encodings
-----------------

-- | Encoding single unsigned bytes as-is.
--
{-# INLINE word8 #-}
word8 :: FixedPrim Word8
word8 :: FixedPrim Word8
word8 = Int -> (Word8 -> Ptr Word8 -> IO ()) -> FixedPrim Word8
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim Int
1 ((Ptr Word8 -> Word8 -> IO ()) -> Word8 -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke) -- Word8 is always aligned

--
-- We rely on the fromIntegral to do the right masking for us.
-- The inlining here is critical, and can be worth 4x performance
--

-- | Encoding 'Word16's in big endian format.
{-# INLINE word16BE #-}
word16BE :: FixedPrim Word16
word16BE :: FixedPrim Word16
word16BE = (Word16 -> Word16) -> Word16 -> Word16
forall a. (a -> a) -> a -> a
whenLittleEndian Word16 -> Word16
byteSwap16 (Word16 -> Word16) -> FixedPrim Word16 -> FixedPrim Word16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
word16Host

-- | Encoding 'Word16's in little endian format.
{-# INLINE word16LE #-}
word16LE :: FixedPrim Word16
word16LE :: FixedPrim Word16
word16LE = (Word16 -> Word16) -> Word16 -> Word16
forall a. (a -> a) -> a -> a
whenBigEndian Word16 -> Word16
byteSwap16 (Word16 -> Word16) -> FixedPrim Word16 -> FixedPrim Word16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
word16Host

-- | Encoding 'Word32's in big endian format.
{-# INLINE word32BE #-}
word32BE :: FixedPrim Word32
word32BE :: FixedPrim Word32
word32BE = (Word32 -> Word32) -> Word32 -> Word32
forall a. (a -> a) -> a -> a
whenLittleEndian Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> FixedPrim Word32 -> FixedPrim Word32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32Host

-- | Encoding 'Word32's in little endian format.
{-# INLINE word32LE #-}
word32LE :: FixedPrim Word32
word32LE :: FixedPrim Word32
word32LE = (Word32 -> Word32) -> Word32 -> Word32
forall a. (a -> a) -> a -> a
whenBigEndian Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> FixedPrim Word32 -> FixedPrim Word32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32Host

-- on a little endian machine:
-- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32)

-- | Encoding 'Word64's in big endian format.
{-# INLINE word64BE #-}
word64BE :: FixedPrim Word64
word64BE :: FixedPrim Word64
word64BE = (Word64 -> Word64) -> Word64 -> Word64
forall a. (a -> a) -> a -> a
whenLittleEndian Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> FixedPrim Word64 -> FixedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64Host

-- | Encoding 'Word64's in little endian format.
{-# INLINE word64LE #-}
word64LE :: FixedPrim Word64
word64LE :: FixedPrim Word64
word64LE = (Word64 -> Word64) -> Word64 -> Word64
forall a. (a -> a) -> a -> a
whenBigEndian Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> FixedPrim Word64 -> FixedPrim Word64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64Host


-- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,
-- host endian form, for the machine you are on. On a 64 bit machine the 'Word'
-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way
-- are not portable to different endian or word sized machines, without
-- conversion.
--
{-# INLINE wordHost #-}
wordHost :: FixedPrim Word
wordHost :: FixedPrim Word
wordHost = case Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) of
  Int
32 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Word32 (Word -> Word32) -> FixedPrim Word32 -> FixedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32Host
  Int
64 -> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Word64 (Word -> Word64) -> FixedPrim Word64 -> FixedPrim Word
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64Host
  Int
_ -> [Char] -> FixedPrim Word
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ByteString.Builder.Prim.Binary.wordHost: unexpected word size"

-- | Encoding 'Word16's in native host order and host endianness.
{-# INLINE word16Host #-}
word16Host :: FixedPrim Word16
word16Host :: FixedPrim Word16
word16Host = Int -> (Word16 -> Ptr Word8 -> IO ()) -> FixedPrim Word16
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim Int
2 Word16 -> Ptr Word8 -> IO ()
unalignedWriteU16

-- | Encoding 'Word32's in native host order and host endianness.
{-# INLINE word32Host #-}
word32Host :: FixedPrim Word32
word32Host :: FixedPrim Word32
word32Host = Int -> (Word32 -> Ptr Word8 -> IO ()) -> FixedPrim Word32
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim Int
4 Word32 -> Ptr Word8 -> IO ()
unalignedWriteU32

-- | Encoding 'Word64's in native host order and host endianness.
{-# INLINE word64Host #-}
word64Host :: FixedPrim Word64
word64Host :: FixedPrim Word64
word64Host = Int -> (Word64 -> Ptr Word8 -> IO ()) -> FixedPrim Word64
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim Int
8 Word64 -> Ptr Word8 -> IO ()
unalignedWriteU64

------------------------------------------------------------------------------
-- Int encodings
------------------------------------------------------------------------------
--
-- We rely on 'fromIntegral' to do a loss-less conversion to the corresponding
-- 'Word' type
--
------------------------------------------------------------------------------

-- | Encoding single signed bytes as-is.
--
{-# INLINE int8 #-}
int8 :: FixedPrim Int8
int8 :: FixedPrim Int8
int8 = Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Word8) -> FixedPrim Word8 -> FixedPrim Int8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
word8

-- | Encoding 'Int16's in big endian format.
{-# INLINE int16BE #-}
int16BE :: FixedPrim Int16
int16BE :: FixedPrim Int16
int16BE = Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Word16) -> FixedPrim Word16 -> FixedPrim Int16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
word16BE

-- | Encoding 'Int16's in little endian format.
{-# INLINE int16LE #-}
int16LE :: FixedPrim Int16
int16LE :: FixedPrim Int16
int16LE = Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Word16) -> FixedPrim Word16 -> FixedPrim Int16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
word16LE

-- | Encoding 'Int32's in big endian format.
{-# INLINE int32BE #-}
int32BE :: FixedPrim Int32
int32BE :: FixedPrim Int32
int32BE = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word32) -> FixedPrim Word32 -> FixedPrim Int32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32BE

-- | Encoding 'Int32's in little endian format.
{-# INLINE int32LE #-}
int32LE :: FixedPrim Int32
int32LE :: FixedPrim Int32
int32LE = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word32) -> FixedPrim Word32 -> FixedPrim Int32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32LE

-- | Encoding 'Int64's in big endian format.
{-# INLINE int64BE #-}
int64BE :: FixedPrim Int64
int64BE :: FixedPrim Int64
int64BE = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> FixedPrim Word64 -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64BE

-- | Encoding 'Int64's in little endian format.
{-# INLINE int64LE #-}
int64LE :: FixedPrim Int64
int64LE :: FixedPrim Int64
int64LE = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> FixedPrim Word64 -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64LE


-- | Encode a single native machine 'Int'. The 'Int's is encoded in host order,
-- host endian form, for the machine you are on. On a 64 bit machine the 'Int'
-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way
-- are not portable to different endian or integer sized machines, without
-- conversion.
--
{-# INLINE intHost #-}
intHost :: FixedPrim Int
intHost :: FixedPrim Int
intHost = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word (Int -> Word) -> FixedPrim Word -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word
wordHost

-- | Encoding 'Int16's in native host order and host endianness.
{-# INLINE int16Host #-}
int16Host :: FixedPrim Int16
int16Host :: FixedPrim Int16
int16Host = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16 (Int16 -> Word16) -> FixedPrim Word16 -> FixedPrim Int16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
word16Host

-- | Encoding 'Int32's in native host order and host endianness.
{-# INLINE int32Host #-}
int32Host :: FixedPrim Int32
int32Host :: FixedPrim Int32
int32Host = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32 (Int32 -> Word32) -> FixedPrim Word32 -> FixedPrim Int32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word32
word32Host

-- | Encoding 'Int64's in native host order and host endianness.
{-# INLINE int64Host #-}
int64Host :: FixedPrim Int64
int64Host :: FixedPrim Int64
int64Host = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64 (Int64 -> Word64) -> FixedPrim Word64 -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word64
word64Host

-- IEEE Floating Point Numbers
------------------------------

-- | Encode a 'Float' in big endian format.
{-# INLINE floatBE #-}
floatBE :: FixedPrim Float
floatBE :: FixedPrim Float
floatBE = FixedPrim Word32 -> FixedPrim Float
encodeFloatViaWord32F FixedPrim Word32
word32BE

-- | Encode a 'Float' in little endian format.
{-# INLINE floatLE #-}
floatLE :: FixedPrim Float
floatLE :: FixedPrim Float
floatLE = FixedPrim Word32 -> FixedPrim Float
encodeFloatViaWord32F FixedPrim Word32
word32LE

-- | Encode a 'Double' in big endian format.
{-# INLINE doubleBE #-}
doubleBE :: FixedPrim Double
doubleBE :: FixedPrim Double
doubleBE = FixedPrim Word64 -> FixedPrim Double
encodeDoubleViaWord64F FixedPrim Word64
word64BE

-- | Encode a 'Double' in little endian format.
{-# INLINE doubleLE #-}
doubleLE :: FixedPrim Double
doubleLE :: FixedPrim Double
doubleLE = FixedPrim Word64 -> FixedPrim Double
encodeDoubleViaWord64F FixedPrim Word64
word64LE


-- | Encode a 'Float' in native host order and host endianness. Values written
-- this way are not portable to different endian machines, without conversion.
--
{-# INLINE floatHost #-}
floatHost :: FixedPrim Float
floatHost :: FixedPrim Float
floatHost = Int -> (Float -> Ptr Word8 -> IO ()) -> FixedPrim Float
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (forall a. Storable a => a -> Int
sizeOf @Float Float
0) Float -> Ptr Word8 -> IO ()
unalignedWriteFloat

-- | Encode a 'Double' in native host order and host endianness.
{-# INLINE doubleHost #-}
doubleHost :: FixedPrim Double
doubleHost :: FixedPrim Double
doubleHost = Int -> (Double -> Ptr Word8 -> IO ()) -> FixedPrim Double
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (forall a. Storable a => a -> Int
sizeOf @Double Double
0) Double -> Ptr Word8 -> IO ()
unalignedWriteDouble