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

License : MIT

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

module Data.UUID.LittleEndian
    (
    -- * Codec functions
      toByteString
    , fromByteString
    , toWords
    , fromWords

    -- * Re-exported entities from @uuid@
    -- | /Nota bene:/ the 'Storable' and 'Binary' instances of 'UUID' use
    --   the encoding specified in RFC 4122, rather than the little-endian-ish
    --   encoding.
    , YD.UUID
    , YD.toString
    , YD.fromString
    , YD.toASCIIBytes
    , YD.fromASCIIBytes
    , YD.toLazyASCIIBytes
    , YD.fromLazyASCIIBytes
    , YD.null
    , YD.nil

    -- * 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

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