module Bytezap.Poke.Derived.Endian where

import Bytezap.Poke

import Data.Word
import Data.Int
import Raehik.Compat.Data.Int.ByteSwap
import GHC.ByteOrder ( ByteOrder(BigEndian, LittleEndian), targetByteOrder )

w16le, w16be :: Word16 -> Poke s
w16le :: forall s. Word16 -> Poke s
w16le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word16 -> Poke s) -> (Word16 -> Word16) -> Word16 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16
w16be :: forall s. Word16 -> Poke s
w16be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word16 -> Poke s) -> (Word16 -> Word16) -> Word16 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16
                                ByteOrder
BigEndian    -> Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim

w32le, w32be :: Word32 -> Poke s
w32le :: forall s. Word32 -> Poke s
w32le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Word32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word32 -> Poke s) -> (Word32 -> Word32) -> Word32 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32
w32be :: forall s. Word32 -> Poke s
w32be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word32 -> Poke s) -> (Word32 -> Word32) -> Word32 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32
                                ByteOrder
BigEndian    -> Word32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim

w64le, w64be :: Word64 -> Poke s
w64le :: forall s. Word64 -> Poke s
w64le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Word64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word64 -> Poke s) -> (Word64 -> Word64) -> Word64 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64
w64be :: forall s. Word64 -> Poke s
w64be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Word64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Word64 -> Poke s) -> (Word64 -> Word64) -> Word64 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64
                                ByteOrder
BigEndian    -> Word64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim

i16le, i16be ::  Int16 -> Poke s
i16le :: forall s. Int16 -> Poke s
i16le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Int16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int16 -> Poke s) -> (Int16 -> Int16) -> Int16 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int16
byteSwapI16
i16be :: forall s. Int16 -> Poke s
i16be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int16 -> Poke s) -> (Int16 -> Int16) -> Int16 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int16
byteSwapI16
                                ByteOrder
BigEndian    -> Int16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim

i32le, i32be ::  Int32 -> Poke s
i32le :: forall s. Int32 -> Poke s
i32le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Int32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int32 -> Poke s) -> (Int32 -> Int32) -> Int32 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
byteSwapI32
i32be :: forall s. Int32 -> Poke s
i32be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int32 -> Poke s) -> (Int32 -> Int32) -> Int32 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
byteSwapI32
                                ByteOrder
BigEndian    -> Int32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim

i64le, i64be ::  Int64 -> Poke s
i64le :: forall s. Int64 -> Poke s
i64le = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim
                                ByteOrder
BigEndian    -> Int64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int64 -> Poke s) -> (Int64 -> Int64) -> Int64 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
byteSwapI64
i64be :: forall s. Int64 -> Poke s
i64be = case ByteOrder
targetByteOrder of ByteOrder
LittleEndian -> Int64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (Int64 -> Poke s) -> (Int64 -> Int64) -> Int64 -> Poke s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
byteSwapI64
                                ByteOrder
BigEndian    -> Int64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim