{-

Module : System.ByteOrder
Copyright : (c) Antoine Latter 2009
License : BSD3

Maintainer : Antoine Latter <aslatter@gmail.com>

-}

{-# OPTIONS_GHC -fno-cse #-}

module System.ByteOrder(byteOrder, ByteOrder(..)) where

import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray)
import Foreign.Ptr (castPtr)
import Foreign.Storable (poke)
import Data.Word
import System.IO.Unsafe (unsafePerformIO)

-- |Indicates the byte-ordering for a 4-byte value, where '1'
-- indicates the most-significant byte and '4' indicates the
-- least significant byte.
--
-- In this format, big endian byte order would be represented as:
-- (1,2,3,4).
--
-- For convinience, the most common cases (BigEndian and LittleEndian)
-- are provided their own constructors.
data ByteOrder
    = BigEndian
    | LittleEndian
    | Mixed (Word8, Word8, Word8, Word8)
 deriving (ByteOrder -> ByteOrder -> Bool
(ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool) -> Eq ByteOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteOrder -> ByteOrder -> Bool
== :: ByteOrder -> ByteOrder -> Bool
$c/= :: ByteOrder -> ByteOrder -> Bool
/= :: ByteOrder -> ByteOrder -> Bool
Eq, Int -> ByteOrder -> ShowS
[ByteOrder] -> ShowS
ByteOrder -> String
(Int -> ByteOrder -> ShowS)
-> (ByteOrder -> String)
-> ([ByteOrder] -> ShowS)
-> Show ByteOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteOrder -> ShowS
showsPrec :: Int -> ByteOrder -> ShowS
$cshow :: ByteOrder -> String
show :: ByteOrder -> String
$cshowList :: [ByteOrder] -> ShowS
showList :: [ByteOrder] -> ShowS
Show, ReadPrec [ByteOrder]
ReadPrec ByteOrder
Int -> ReadS ByteOrder
ReadS [ByteOrder]
(Int -> ReadS ByteOrder)
-> ReadS [ByteOrder]
-> ReadPrec ByteOrder
-> ReadPrec [ByteOrder]
-> Read ByteOrder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ByteOrder
readsPrec :: Int -> ReadS ByteOrder
$creadList :: ReadS [ByteOrder]
readList :: ReadS [ByteOrder]
$creadPrec :: ReadPrec ByteOrder
readPrec :: ReadPrec ByteOrder
$creadListPrec :: ReadPrec [ByteOrder]
readListPrec :: ReadPrec [ByteOrder]
Read, Eq ByteOrder
Eq ByteOrder =>
(ByteOrder -> ByteOrder -> Ordering)
-> (ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> ByteOrder)
-> (ByteOrder -> ByteOrder -> ByteOrder)
-> Ord ByteOrder
ByteOrder -> ByteOrder -> Bool
ByteOrder -> ByteOrder -> Ordering
ByteOrder -> ByteOrder -> ByteOrder
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ByteOrder -> ByteOrder -> Ordering
compare :: ByteOrder -> ByteOrder -> Ordering
$c< :: ByteOrder -> ByteOrder -> Bool
< :: ByteOrder -> ByteOrder -> Bool
$c<= :: ByteOrder -> ByteOrder -> Bool
<= :: ByteOrder -> ByteOrder -> Bool
$c> :: ByteOrder -> ByteOrder -> Bool
> :: ByteOrder -> ByteOrder -> Bool
$c>= :: ByteOrder -> ByteOrder -> Bool
>= :: ByteOrder -> ByteOrder -> Bool
$cmax :: ByteOrder -> ByteOrder -> ByteOrder
max :: ByteOrder -> ByteOrder -> ByteOrder
$cmin :: ByteOrder -> ByteOrder -> ByteOrder
min :: ByteOrder -> ByteOrder -> ByteOrder
Ord)

input :: Word32
input :: Word32
input = Word32
0x01020304

-- |Returns the native byte ordering of the system.
byteOrder :: ByteOrder
byteOrder :: ByteOrder
byteOrder = IO ByteOrder -> ByteOrder
forall a. IO a -> a
unsafePerformIO IO ByteOrder
byteOrderIO
{-# NOINLINE byteOrder #-}

byteOrderIO :: IO ByteOrder
byteOrderIO :: IO ByteOrder
byteOrderIO = (Word8, Word8, Word8, Word8) -> ByteOrder
bytesToByteOrder ((Word8, Word8, Word8, Word8) -> ByteOrder)
-> IO (Word8, Word8, Word8, Word8) -> IO ByteOrder
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Word32 -> IO (Word8, Word8, Word8, Word8)
wordToBytes Word32
input

wordToBytes :: Word32 -> IO (Word8,Word8,Word8,Word8)
wordToBytes :: Word32 -> IO (Word8, Word8, Word8, Word8)
wordToBytes Word32
word = (Ptr Word32 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr Word32 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word32
wordPtr -> do
         Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
wordPtr Word32
word
         [Word8
x1,Word8
x2,Word8
x3,Word8
x4] <- Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 (Ptr Word32 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word32
wordPtr)
         (Word8, Word8, Word8, Word8) -> IO (Word8, Word8, Word8, Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x1,Word8
x2,Word8
x3,Word8
x4)

bytesToByteOrder :: (Word8,Word8,Word8,Word8) -> ByteOrder
bytesToByteOrder :: (Word8, Word8, Word8, Word8) -> ByteOrder
bytesToByteOrder (Word8
1, Word8
2, Word8
3, Word8
4)     = ByteOrder
BigEndian
bytesToByteOrder (Word8
4, Word8
3, Word8
2, Word8
1)     = ByteOrder
LittleEndian
bytesToByteOrder (Word8
x1, Word8
x2, Word8
x3, Word8
x4) = (Word8, Word8, Word8, Word8) -> ByteOrder
Mixed (Word8
x1,Word8
x2,Word8
x3,Word8
x4)