    {-

    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
             [x1,x2,x3,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)
             return (x1,x2,x3,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)