{- |
Module : Data.UUID.LittleEndian
Copyright : (c) 2013, Stijn van Drongelen

License : MIT

Maintainer : rhymoid@gmail.com
Stability : experimental
Portability : portable


This library is an extension of the uuid library, allowing one to read and
write 'little endian' encoded UUIDs. Some systems, for instance UEFI, chose
to defy the simple format of RFC 4122 and use this format.
-}

module Data.UUID.LittleEndian
    (
    -- * Modified functions
      toByteString
    , fromByteString
    , toWords
    , fromWords
    -- * Endianity tools
    , swapTupleEndianity
    , swapListEndianity
    ) where

import Control.Arrow
import Data.Bits
import qualified Data.ByteString.Lazy as BL
import Data.UUID (UUID)
import qualified Data.UUID as YD
import Data.Tuple
import Data.Word

-- | Encode a UUID into a 'BL.ByteString' in little-endian-ish byte order.
toByteString :: UUID -> BL.ByteString
toByteString = BL.pack . swapListEndianity . BL.unpack . YD.toByteString

-- | Extract a UUID from a 'BL.ByteString' in little-endian-ish byte order.
--   The argument must be 16 bytes long, otherwise 'Nothing' is returned.
fromByteString :: BL.ByteString -> Maybe UUID
fromByteString = YD.fromByteString . BL.pack . swapListEndianity . BL.unpack

-- | Covert a UUID into a sequence of 'Word32' values. When stored in network
--   byte order, this tuple encodes the UUID in little-endian-ish byte order.
toWords :: UUID -> (Word32, Word32, Word32, Word32)
toWords = swapTupleEndianity . YD.toWords

-- | Create a UUID from a sequence of 'Word32' values. The opposite of 'toWords'.
fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords x y z w
    = (\(a, b, c, d) -> YD.fromWords a b c d)
    . swapTupleEndianity $ (x, y, z, w)

-- | Swaps the endianity of a UUID 'Word32' tuple.
swapTupleEndianity :: (Word32, Word32, Word32, Word32) -> (Word32, Word32, Word32, Word32)
swapTupleEndianity (d1, d2, d3, d4) = (d1', d2', d3, d4)
  where
    d1' = swapWord32 d1
    d2' = mergeWord32 . (swapWord16 *** swapWord16) . splitWord32 $ d2

-- | Swaps the endianity of a UUID byte list, if the list is at least eight
--   bytes long. Otherwise, it returns the original list.
swapListEndianity :: [Word8] -> [Word8]
swapListEndianity (b0:b1:b2:b3 : b4:b5 : b6:b7 : moar)
                = (b3:b2:b1:b0 : b5:b4 : b7:b6 : moar)
swapListEndianity xs = xs

--- Endianity tools

swapWord16 :: Word16 -> Word16
swapWord16 w = w `rotateL` 8

swapWord32 :: Word32 -> Word32
swapWord32 = mergeWord32 . swap . (swapWord16 *** swapWord16) . splitWord32

splitWord32 :: Word32 -> (Word16, Word16)
splitWord32 w = (fromIntegral w1, fromIntegral w2)
  where
    w1 = w `shiftR` 16
    w2 = w .&. 0xFFFF

mergeWord32 :: (Word16, Word16) -> Word32
mergeWord32 (w1, w2) = (fromIntegral w1 `shiftL` 16) .|. fromIntegral w2