module Data.UUID
( UUID()
, asWord64s
, asWord32s
) where
import Data.Word
import Data.Char
import Data.Binary
import Data.Binary.Put
import Data.Binary.Get
import Data.Bits
import qualified Data.ByteString.Lazy
import Data.Digest.Murmur32
import Data.Digest.Murmur64
import Data.String
import Data.Typeable
import Foreign.C
import Foreign.ForeignPtr
import Foreign
import Control.Monad
import Control.Applicative
import Numeric
import Text.ParserCombinators.ReadPrec (lift)
import Text.ParserCombinators.ReadP
import Text.Read hiding (pfail)
import Data.List
import Text.Printf
data UUID = UUID
!Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
!Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
deriving (Eq, Ord, Typeable)
instance Show UUID where
show (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)
= printf formatUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF
where
formatUUID = intercalate "-" $ map b [ 2, 1, 1, 1, 3 ]
b = concat . (`replicate` "%02.2x%02.2x")
instance Read UUID where
readPrec = lift $ do
skipSpaces
[x0,x1,x2,x3] <- count 4 byte
char '-'
[x4,x5] <- count 2 byte
char '-'
[x6,x7] <- count 2 byte
char '-'
[x8,x9] <- count 2 byte
char '-'
[xA,xB,xC,xD,xE,xF] <- count 6 byte
return $ UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF
where
byte = do
s <- sequence $ replicate 2 $ satisfy isHexDigit
case readHex s of
[(b, _)] -> return b
_ -> pfail
instance IsString UUID where
fromString = read
instance Storable UUID where
sizeOf _ = 16
alignment _ = 4
peek p = do
bytes <- peekArray 16 $ castPtr p
return $ fromList bytes
poke p uuid = pokeArray (castPtr p) $ listOfBytes uuid
instance Bounded UUID where
minBound = UUID 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
maxBound = UUID 0xff 0xff 0xff 0xff 0xff 0xff 0xff 0xff
0xff 0xff 0xff 0xff 0xff 0xff 0xff 0xff
instance Binary UUID where
put = mapM_ putWord8 . listOfBytes
get = fromList <$> sequence (replicate 16 getWord8)
instance Hashable32 UUID where
hash32Add = hash32Add . asWord32s
instance Hashable64 UUID where
hash64Add = hash64Add . asWord64s
listOfBytes (UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF)
= [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF ]
fromList [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, xA, xB, xC, xD, xE, xF ]
= UUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF
fromList _ = minBound
asWord64s :: UUID -> (Word64, Word64)
asWord64s uuid = (decode front, decode back)
where
(front, back) = Data.ByteString.Lazy.splitAt 8 $ encode uuid
asWord32s :: UUID -> (Word32, Word32, Word32, Word32)
asWord32s uuid = (decode front', decode front'', decode back', decode back'')
where
(front, back) = Data.ByteString.Lazy.splitAt 8 $ encode uuid
(front', front'') = Data.ByteString.Lazy.splitAt 4 front
(back', back'') = Data.ByteString.Lazy.splitAt 4 back