{-# language DataKinds #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language UnboxedTuples #-}
module System.ByteOrder
(
ByteOrder(..)
, Fixed(..)
, Bytes
, FixedOrdering
, toBigEndian
, toLittleEndian
, fromBigEndian
, fromLittleEndian
, targetByteOrder
) where
import Data.Kind (Type)
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.Types as PM
import qualified Foreign.Storable as FS
fromBigEndian :: Bytes a => a -> a
fromBigEndian :: a -> a
fromBigEndian = a -> a
forall a. Bytes a => a -> a
toBigEndian
fromLittleEndian :: Bytes a => a -> a
fromLittleEndian :: a -> a
fromLittleEndian = a -> a
forall a. Bytes a => a -> a
toLittleEndian
newtype Fixed :: ByteOrder -> Type -> Type where
Fixed :: forall (b :: ByteOrder) (a :: Type). { Fixed b a -> a
getFixed :: a } -> Fixed b a
type role Fixed phantom representational
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# _ = a -> Int#
forall a. Prim a => a -> Int#
PM.sizeOf# (a
forall a. HasCallStack => a
undefined :: a)
alignment# :: Fixed b a -> Int#
alignment# _ = a -> Int#
forall a. Prim a => a -> Int#
PM.alignment# (a
forall a. HasCallStack => a
undefined :: a)
indexByteArray# :: ByteArray# -> Int# -> Fixed b a
indexByteArray# a :: ByteArray#
a i :: Int#
i = a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> a
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# :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, Fixed b a #)
readByteArray# a :: MutableByteArray# s
a i :: Int#
i s0 :: State# s
s0 = case 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
(# s1 :: State# s
s1, x :: a
x #) -> (# State# s
s1, a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x) #)
writeByteArray# :: MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s
writeByteArray# a :: MutableByteArray# s
a i :: Int#
i (Fixed x :: a
x) = 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 (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
setByteArray# :: MutableByteArray# s
-> Int# -> Int# -> Fixed b a -> State# s -> State# s
setByteArray# a :: MutableByteArray# s
a i :: Int#
i n :: Int#
n (Fixed x :: a
x) = 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 (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
indexOffAddr# :: Addr# -> Int# -> Fixed b a
indexOffAddr# a :: Addr#
a i :: Int#
i = a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> a
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# :: Addr# -> Int# -> State# s -> (# State# s, Fixed b a #)
readOffAddr# a :: Addr#
a i :: Int#
i s0 :: State# s
s0 = case 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
(# s1 :: State# s
s1, x :: a
x #) -> (# State# s
s1, a -> Fixed b a
forall (b :: ByteOrder) a. a -> Fixed b a
Fixed (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x) #)
writeOffAddr# :: Addr# -> Int# -> Fixed b a -> State# s -> State# s
writeOffAddr# a :: Addr#
a i :: Int#
i (Fixed x :: a
x) = 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 (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
setOffAddr# :: Addr# -> Int# -> Int# -> Fixed b a -> State# s -> State# s
setOffAddr# a :: Addr#
a i :: Int#
i n :: Int#
n (Fixed x :: a
x) = 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 (a -> a
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 _ = a -> Int
forall a. Storable a => a -> Int
FS.sizeOf (a
forall a. HasCallStack => a
undefined :: a)
alignment :: Fixed b a -> Int
alignment _ = 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 p :: Ptr (Fixed b a)
p i :: Int
i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
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 a. (FixedOrdering b, Bytes a) => a -> a
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 p :: Ptr (Fixed b a)
p i :: Int
i (Fixed x :: 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 (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
peekByteOff :: Ptr b -> Int -> IO (Fixed b a)
peekByteOff p :: Ptr b
p i :: Int
i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
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 a. (FixedOrdering b, Bytes a) => a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b) (Ptr b -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
FS.peekByteOff Ptr b
p Int
i)
pokeByteOff :: Ptr b -> Int -> Fixed b a -> IO ()
pokeByteOff p :: Ptr b
p i :: Int
i (Fixed x :: a
x) = Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
FS.pokeByteOff Ptr b
p Int
i (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
peek :: Ptr (Fixed b a) -> IO (Fixed b a)
peek p :: Ptr (Fixed b a)
p = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
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 a. (FixedOrdering b, Bytes a) => a -> a
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 p :: Ptr (Fixed b a)
p (Fixed x :: 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) (a -> a
forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
toFixedEndian @b a
x)
fromFixedPtr :: Ptr (Fixed b a) -> Ptr a
{-# inline fromFixedPtr #-}
fromFixedPtr :: Ptr (Fixed b a) -> Ptr a
fromFixedPtr = Ptr (Fixed b a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr