{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
module System.ByteOrder
(
ByteOrder (..)
, Fixed (..)
, Bytes
, FixedOrdering
, toBigEndian
, toLittleEndian
, fromBigEndian
, fromLittleEndian
, targetByteOrder
) where
import Data.Kind (Type)
import Data.Primitive.ByteArray.Unaligned (PrimUnaligned)
import Data.Primitive.Types (Prim)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable)
import GHC.ByteOrder (ByteOrder (..), targetByteOrder)
import System.ByteOrder.Class (Bytes (..), FixedOrdering, toFixedEndian)
import qualified Data.Primitive.ByteArray.Unaligned as PMU
import qualified Data.Primitive.Types as PM
import qualified Foreign.Storable as FS
fromBigEndian :: (Bytes a) => a -> a
fromBigEndian :: forall a. Bytes a => a -> a
fromBigEndian = a -> a
forall a. Bytes a => a -> a
toBigEndian
fromLittleEndian :: (Bytes a) => a -> a
fromLittleEndian :: forall a. Bytes a => a -> a
fromLittleEndian = a -> a
forall a. Bytes a => a -> a
toLittleEndian
newtype Fixed :: ByteOrder -> Type -> Type where
Fixed :: forall (b :: ByteOrder) (a :: Type). {forall (b :: ByteOrder) a. Fixed b a -> a
getFixed :: a} -> Fixed b a
type role Fixed phantom representational
deriving newtype instance (Num a) => Num (Fixed b a)
deriving newtype instance (Real a) => Real (Fixed b a)
deriving newtype instance (Integral a) => Integral (Fixed b a)
deriving newtype instance (Ord a) => Ord (Fixed b a)
deriving newtype instance (Enum a) => Enum (Fixed b a)
deriving newtype instance (Eq a) => Eq (Fixed b a)
instance (FixedOrdering b, Prim a, Bytes a) => Prim (Fixed b a) where
{-# INLINE sizeOf# #-}
{-# INLINE alignment# #-}
{-# INLINE indexByteArray# #-}
{-# INLINE readByteArray# #-}
{-# INLINE writeByteArray# #-}
{-# INLINE setByteArray# #-}
{-# INLINE indexOffAddr# #-}
{-# INLINE readOffAddr# #-}
{-# INLINE writeOffAddr# #-}
{-# INLINE setOffAddr# #-}
sizeOf# :: Fixed b a -> Int#
sizeOf# Fixed b a
_ = a -> Int#
forall a. Prim a => a -> Int#
PM.sizeOf# (a
forall a. HasCallStack => a
undefined :: a)
alignment# :: Fixed b a -> Int#
alignment# Fixed b a
_ = a -> Int#
forall a. Prim a => a -> Int#
PM.alignment# (a
forall a. HasCallStack => a
undefined :: a)
indexByteArray# :: ByteArray# -> Int# -> Fixed b a
indexByteArray# ByteArray#
a Int#
i = a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b (ByteArray# -> Int# -> a
forall a. Prim a => ByteArray# -> Int# -> a
PM.indexByteArray# ByteArray#
a Int#
i))
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Fixed b a #)
readByteArray# MutableByteArray# s
a Int#
i State# s
s0 = case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
PM.readByteArray# MutableByteArray# s
a Int#
i State# s
s0 of
(# State# s
s1, a
x #) -> (# State# s
s1, a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x) #)
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s
writeByteArray# MutableByteArray# s
a Int#
i (Fixed a
x) = MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
PM.writeByteArray# MutableByteArray# s
a Int#
i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Fixed b a -> State# s -> State# s
setByteArray# MutableByteArray# s
a Int#
i Int#
n (Fixed a
x) = MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
PM.setByteArray# MutableByteArray# s
a Int#
i Int#
n (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
indexOffAddr# :: Addr# -> Int# -> Fixed b a
indexOffAddr# Addr#
a Int#
i = a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b (Addr# -> Int# -> a
forall a. Prim a => Addr# -> Int# -> a
PM.indexOffAddr# Addr#
a Int#
i))
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Fixed b a #)
readOffAddr# Addr#
a Int#
i State# s
s0 = case Addr# -> Int# -> State# s -> (# State# s, a #)
forall s. Addr# -> Int# -> State# s -> (# State# s, a #)
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
PM.readOffAddr# Addr#
a Int#
i State# s
s0 of
(# State# s
s1, a
x #) -> (# State# s
s1, a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x) #)
writeOffAddr# :: forall s. Addr# -> Int# -> Fixed b a -> State# s -> State# s
writeOffAddr# Addr#
a Int#
i (Fixed a
x) = Addr# -> Int# -> a -> State# s -> State# s
forall s. Addr# -> Int# -> a -> State# s -> State# s
forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
PM.writeOffAddr# Addr#
a Int#
i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> Fixed b a -> State# s -> State# s
setOffAddr# Addr#
a Int#
i Int#
n (Fixed a
x) = Addr# -> Int# -> Int# -> a -> State# s -> State# s
forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
PM.setOffAddr# Addr#
a Int#
i Int#
n (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
instance (FixedOrdering b, PrimUnaligned a, Bytes a) => PrimUnaligned (Fixed b a) where
{-# INLINE indexUnalignedByteArray# #-}
{-# INLINE readUnalignedByteArray# #-}
{-# INLINE writeUnalignedByteArray# #-}
indexUnalignedByteArray# :: ByteArray# -> Int# -> Fixed b a
indexUnalignedByteArray# ByteArray#
a Int#
i = a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b (ByteArray# -> Int# -> a
forall a. PrimUnaligned a => ByteArray# -> Int# -> a
PMU.indexUnalignedByteArray# ByteArray#
a Int#
i))
readUnalignedByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Fixed b a #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 = case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
PrimUnaligned a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
PMU.readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 of
(# State# s
s1, a
x #) -> (# State# s
s1, a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x) #)
writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (Fixed a
x) = MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
PrimUnaligned a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
PMU.writeUnalignedByteArray# MutableByteArray# s
a Int#
i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
instance (FixedOrdering b, Storable a, Bytes a) => Storable (Fixed b a) where
{-# INLINE sizeOf #-}
{-# INLINE alignment #-}
{-# INLINE peekElemOff #-}
{-# INLINE pokeElemOff #-}
{-# INLINE peekByteOff #-}
{-# INLINE pokeByteOff #-}
{-# INLINE peek #-}
{-# INLINE poke #-}
sizeOf :: Fixed b a -> Int
sizeOf Fixed b a
_ = a -> Int
forall a. Storable a => a -> Int
FS.sizeOf (a
forall a. HasCallStack => a
undefined :: a)
alignment :: Fixed b a -> Int
alignment Fixed b a
_ = a -> Int
forall a. Storable a => a -> Int
FS.alignment (a
forall a. HasCallStack => a
undefined :: a)
peekElemOff :: Ptr (Fixed b a) -> Int -> IO (Fixed b a)
peekElemOff Ptr (Fixed b a)
p Int
i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b) (Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
FS.peekElemOff (Ptr (Fixed b a) -> Ptr a
forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
fromFixedPtr Ptr (Fixed b a)
p) Int
i)
pokeElemOff :: Ptr (Fixed b a) -> Int -> Fixed b a -> IO ()
pokeElemOff Ptr (Fixed b a)
p Int
i (Fixed a
x) = Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
FS.pokeElemOff (Ptr (Fixed b a) -> Ptr a
forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
fromFixedPtr Ptr (Fixed b a)
p) Int
i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
peekByteOff :: forall b. Ptr b -> Int -> IO (Fixed b a)
peekByteOff Ptr b
p Int
i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b) (Ptr b -> Int -> IO a
forall b. Ptr b -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
FS.peekByteOff Ptr b
p Int
i)
pokeByteOff :: forall b. Ptr b -> Int -> Fixed b a -> IO ()
pokeByteOff Ptr b
p Int
i (Fixed a
x) = Ptr b -> Int -> a -> IO ()
forall b. Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
FS.pokeByteOff Ptr b
p Int
i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
peek :: Ptr (Fixed b a) -> IO (Fixed b a)
peek Ptr (Fixed b a)
p = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b) (Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
FS.peek (Ptr (Fixed b a) -> Ptr a
forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
fromFixedPtr Ptr (Fixed b a)
p))
poke :: Ptr (Fixed b a) -> Fixed b a -> IO ()
poke Ptr (Fixed b a)
p (Fixed a
x) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
FS.poke (Ptr (Fixed b a) -> Ptr a
forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
fromFixedPtr Ptr (Fixed b a)
p) (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
fromFixedPtr :: Ptr (Fixed b a) -> Ptr a
{-# INLINE fromFixedPtr #-}
fromFixedPtr :: forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
fromFixedPtr = Ptr (Fixed b a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr