[Pkg-haskell-commits] darcs: haskell-uuid-types: Initial check-in
Joachim Breitner
mail at joachim-breitner.de
Fri Apr 17 11:30:54 UTC 2015
Fri Apr 17 11:30:45 UTC 2015 Joachim Breitner <mail at joachim-breitner.de>
* Initial check-in
A ./CHANGES
A ./CONTRIBUTORS
A ./Data/
A ./Data/UUID/
A ./Data/UUID/Types/
A ./Data/UUID/Types.hs
A ./Data/UUID/Types/Internal/
A ./Data/UUID/Types/Internal.hs
A ./Data/UUID/Types/Internal/Builder.hs
A ./LICENSE
A ./Setup.hs
A ./debian/
A ./debian/changelog
A ./debian/compat
A ./debian/control
A ./debian/copyright
A ./debian/rules
A ./debian/source/
A ./debian/source/format
A ./debian/watch
A ./tests/
A ./tests/BenchUUID.hs
A ./tests/TestUUID.hs
A ./uuid-types.cabal
Fri Apr 17 11:30:45 UTC 2015 Joachim Breitner <mail at joachim-breitner.de>
* Initial check-in
diff -rN -u old-haskell-uuid-types/CHANGES new-haskell-uuid-types/CHANGES
--- old-haskell-uuid-types/CHANGES 1970-01-01 00:00:00.000000000 +0000
+++ new-haskell-uuid-types/CHANGES 2015-04-17 11:30:54.454778528 +0000
@@ -0,0 +1,7 @@
+1.0.1
+
+- Update dependencies in tests and benchmarks.
+
+1.0.0
+
+- Initial split from "uuid-1.3.8"
diff -rN -u old-haskell-uuid-types/CONTRIBUTORS new-haskell-uuid-types/CONTRIBUTORS
--- old-haskell-uuid-types/CONTRIBUTORS 1970-01-01 00:00:00.000000000 +0000
+++ new-haskell-uuid-types/CONTRIBUTORS 2015-04-17 11:30:54.454778528 +0000
@@ -0,0 +1,13 @@
+In order of appearance:
+
+Antoine Latter
+Jason Dusek
+Tim Newsham
+Mark Lentczner
+Neil Mitchell
+Bas van Dijk
+Sergei Trofimovich
+davean
+Francesco Mazzoli
+Michael Snoyman
+Bardur Arantsson
diff -rN -u old-haskell-uuid-types/Data/UUID/Types/Internal/Builder.hs new-haskell-uuid-types/Data/UUID/Types/Internal/Builder.hs
--- old-haskell-uuid-types/Data/UUID/Types/Internal/Builder.hs 1970-01-01 00:00:00.000000000 +0000
+++ new-haskell-uuid-types/Data/UUID/Types/Internal/Builder.hs 2015-04-17 11:30:54.454778528 +0000
@@ -0,0 +1,89 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-- Module : Data.UUID.Types.Internal.Builder
+-- Copyright : (c) 2009 Mark Lentczner
+--
+-- License : BSD-style
+--
+-- Maintainer : markl at glyphic.com
+-- Stability : experimental
+-- Portability : portable
+--
+-- This module provides a system that can call a function that takes
+-- a sequence of some number of Word8 arguments.
+--
+-- The twist is that the Word8 arguments can be supplied directly
+-- from Word8s, or from other sources that may provide more than
+-- one Word8 apiece. Examples are Word16 and Word32 that supply
+-- two and four Word8s respectively. Other ByteSource instances
+-- can be defined.
+--
+-- This module is admittedly overkill. There are only three places
+-- in the uuid package that need to call buildFromBytes with 16
+-- Word8 values, but each place uses Words of different lengths:
+-- version 1 uuids: 32-16-16-16-8-8-8-8-8-8
+-- version 4 uuids: 24-24-32-24-24
+-- version 5 uuids: 32-32-32-32
+-- Originally, these three constructions were hand coded but the
+-- code was ungainly. Using this module makes the code very
+-- concise, and turns out to optimize to just as fast, or faster!
+
+module Data.UUID.Types.Internal.Builder
+ (ByteSource(..)
+ ,ByteSink
+ ,Takes1Byte
+ ,Takes2Bytes
+ ,Takes3Bytes
+ ,Takes4Bytes
+ ) where
+
+import Data.Bits
+import Data.Word
+
+
+
+type Takes1Byte g = Word8 -> g
+type Takes2Bytes g = Word8 -> Word8 -> g
+type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g
+type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g
+
+-- | Type of function that a given ByteSource needs.
+-- This function must take as many Word8 arguments as the ByteSource provides
+type family ByteSink w g
+type instance ByteSink Word8 g = Takes1Byte g
+type instance ByteSink Word16 g = Takes2Bytes g
+type instance ByteSink Word32 g = Takes4Bytes g
+type instance ByteSink Int g = Takes4Bytes g
+
+
+-- | Class of types that can add Word8s to a Builder.
+-- Instances for Word8, Word16, Word32 and Int provide 1, 2, 4 and 4 bytes,
+-- respectively, into a ByteSink
+class ByteSource w where
+ -- | Apply the source's bytes to the sink
+ (/-/) :: ByteSink w g -> w -> g
+
+infixl 6 /-/
+
+instance ByteSource Word8 where
+ f /-/ w = f w
+
+instance ByteSource Word16 where
+ f /-/ w = f b1 b2
+ where b1 = fromIntegral (w `shiftR` 8)
+ b2 = fromIntegral w
+
+instance ByteSource Word32 where
+ f /-/ w = f b1 b2 b3 b4
+ where b1 = fromIntegral (w `shiftR` 24)
+ b2 = fromIntegral (w `shiftR` 16)
+ b3 = fromIntegral (w `shiftR` 8)
+ b4 = fromIntegral w
+
+instance ByteSource Int where
+ f /-/ w = f b1 b2 b3 b4
+ where b1 = fromIntegral (w `shiftR` 24)
+ b2 = fromIntegral (w `shiftR` 16)
+ b3 = fromIntegral (w `shiftR` 8)
+ b4 = fromIntegral w
diff -rN -u old-haskell-uuid-types/Data/UUID/Types/Internal.hs new-haskell-uuid-types/Data/UUID/Types/Internal.hs
--- old-haskell-uuid-types/Data/UUID/Types/Internal.hs 1970-01-01 00:00:00.000000000 +0000
+++ new-haskell-uuid-types/Data/UUID/Types/Internal.hs 2015-04-17 11:30:54.458778525 +0000
@@ -0,0 +1,537 @@
+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-- |
+-- Module : Data.UUID.Types.Internal
+-- Copyright : (c) 2008-2009, 2012 Antoine Latter
+-- (c) 2009 Mark Lentczner
+--
+-- License : BSD-style
+--
+-- Maintainer : aslatter at gmail.com
+-- Stability : experimental
+-- Portability : portable
+
+module Data.UUID.Types.Internal
+ (UUID(..)
+ ,null
+ ,nil
+ ,fromByteString
+ ,toByteString
+ ,fromString
+ ,toString
+ ,fromWords
+ ,toWords
+ ,toList
+ ,buildFromBytes
+ ,buildFromWords
+ ,fromASCIIBytes
+ ,toASCIIBytes
+ ,fromLazyASCIIBytes
+ ,toLazyASCIIBytes
+ ,UnpackedUUID(..)
+ ,pack
+ ,unpack
+ ) where
+
+import Prelude hiding (null)
+
+import Control.Applicative ((<*>))
+import Control.DeepSeq (NFData(..))
+import Control.Monad (liftM4, guard)
+import Data.Functor ((<$>))
+import Data.Char
+import Data.Bits
+import Data.Hashable
+import Data.List (elemIndices)
+import Foreign.Ptr (Ptr)
+
+#if MIN_VERSION_base(4,0,0)
+import Data.Data
+#else
+import Data.Generics.Basics
+#endif
+
+import Foreign.Storable
+
+import Data.Binary
+import Data.Binary.Put
+import Data.Binary.Get
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Unsafe as BU
+
+import Data.UUID.Types.Internal.Builder
+
+import System.Random
+
+
+-- |The UUID type. A 'Random' instance is provided which produces
+-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and
+-- 'Binary' instances are compatible with RFC 4122, storing the fields
+-- in network order as 16 bytes.
+data UUID
+ = UUID
+ {-# UNPACK #-} !Word32
+ {-# UNPACK #-} !Word32
+ {-# UNPACK #-} !Word32
+ {-# UNPACK #-} !Word32
+ deriving (Eq, Ord, Typeable)
+{-
+ Other representations that we tried are:
+ Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
+ !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
+ Sixteen bytes: !Word8 ... (x 16)
+ Simple list of bytes: [Word8]
+ ByteString (strict) ByteString
+ Immutable array: UArray Int Word8
+ Vector: UArr Word8
+ None was as fast, overall, as the representation used here.
+-}
+
+-- | Covert a 'UUID' into a sequence of 'Word32' values.
+-- Useful for when you need to serialize a UUID and
+-- neither 'Storable' nor 'Binary' are appropriate.
+-- Introduced in version 1.2.2.
+toWords :: UUID -> (Word32, Word32, Word32, Word32)
+toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
+
+-- | Create a 'UUID' from a sequence of 'Word32'. The
+-- opposite of 'toWords'. Useful when you need a total
+-- function for constructing 'UUID' values.
+-- Introduced in version 1.2.2.
+fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
+fromWords = UUID
+
+data UnpackedUUID =
+ UnpackedUUID {
+ time_low :: Word32 -- 0-3
+ , time_mid :: Word16 -- 4-5
+ , time_hi_and_version :: Word16 -- 6-7
+ , clock_seq_hi_res :: Word8 -- 8
+ , clock_seq_low :: Word8 -- 9
+ , node_0 :: Word8
+ , node_1 :: Word8
+ , node_2 :: Word8
+ , node_3 :: Word8
+ , node_4 :: Word8
+ , node_5 :: Word8
+ }
+ deriving (Read, Show, Eq, Ord)
+
+unpack :: UUID -> UnpackedUUID
+unpack (UUID w0 w1 w2 w3) =
+ build /-/ w0 /-/ w1 /-/ w2 /-/ w3
+
+ where
+ build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
+ UnpackedUUID {
+ time_low = word x0 x1 x2 x3
+ , time_mid = w8to16 x4 x5
+ , time_hi_and_version = w8to16 x6 x7
+ , clock_seq_hi_res = x8
+ , clock_seq_low = x9
+ , node_0 = xA
+ , node_1 = xB
+ , node_2 = xC
+ , node_3 = xD
+ , node_4 = xE
+ , node_5 = xF
+ }
+
+pack :: UnpackedUUID -> UUID
+pack unpacked =
+ makeFromBytes /-/ (time_low unpacked)
+ /-/ (time_mid unpacked)
+ /-/ (time_hi_and_version unpacked)
+ /-/ (clock_seq_hi_res unpacked)
+ /-/ (clock_seq_low unpacked)
+ /-/ (node_0 unpacked) /-/ (node_1 unpacked)
+ /-/ (node_2 unpacked) /-/ (node_3 unpacked)
+ /-/ (node_4 unpacked) /-/ (node_5 unpacked)
+
+
+--
+-- UTILITIES
+--
+
+-- |Build a Word32 from four Word8 values, presented in big-endian order
+word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
+word a b c d = (fromIntegral a `shiftL` 24)
+ .|. (fromIntegral b `shiftL` 16)
+ .|. (fromIntegral c `shiftL` 8)
+ .|. (fromIntegral d )
+
+-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
+byte :: Int -> Word32 -> Word8
+byte i w = fromIntegral (w `shiftR` (i * 8))
+
+-- |Build a Word16 from two Word8 values, presented in big-endian order.
+w8to16 :: Word8 -> Word8 -> Word16
+w8to16 w0s w1s =
+ (w0 `shiftL` 8) .|. w1
+ where
+ w0 = fromIntegral w0s
+ w1 = fromIntegral w1s
+
+
+-- |Make a UUID from sixteen Word8 values
+makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> UUID
+makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
+ = UUID w0 w1 w2 w3
+ where w0 = word b0 b1 b2 b3
+ w1 = word b4 b5 b6 b7
+ w2 = word b8 b9 ba bb
+ w3 = word bc bd be bf
+
+-- |Make a UUID from four Word32 values
+makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
+makeFromWords = UUID
+
+-- |A Builder for constructing a UUID of a given version.
+buildFromBytes :: Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> Word8 -> Word8 -> Word8 -> Word8
+ -> UUID
+buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
+ makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf
+ where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
+ b8' = b8 .&. 0x3f .|. 0x80
+
+-- |Build a UUID of a given version from Word32 values.
+buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
+buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3
+ where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
+ w2' = w2 .&. 0x3fffffff .|. 0x80000000
+
+
+-- |Return the bytes that make up the UUID
+toList :: UUID -> [Word8]
+toList (UUID w0 w1 w2 w3) =
+ [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
+ byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
+ byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
+
+-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
+-- exactly sixteen bytes long
+fromList :: [Word8] -> Maybe UUID
+fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
+ Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
+fromList _ = Nothing
+
+
+--
+-- UUID API
+--
+
+-- |Returns true if the passed-in UUID is the 'nil' UUID.
+null :: UUID -> Bool
+null = (== nil)
+ -- Note: This actually faster than:
+ -- null (UUID 0 0 0 0) = True
+ -- null _ = False
+
+-- |The nil UUID, as defined in RFC 4122.
+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
+nil :: UUID
+nil = UUID 0 0 0 0
+
+-- |Extract a UUID from a 'ByteString' in network byte order.
+-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
+fromByteString :: BL.ByteString -> Maybe UUID
+fromByteString = fromList . BL.unpack
+
+-- |Encode a UUID into a 'ByteString' in network order.
+toByteString :: UUID -> BL.ByteString
+toByteString = BL.pack . toList
+
+-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
+-- The hyphens may not be omitted.
+-- Example:
+--
+-- @
+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
+-- @
+--
+-- Hex digits may be upper or lower-case.
+fromString :: String -> Maybe UUID
+fromString xs | validFmt = fromString' xs
+ | otherwise = Nothing
+ where validFmt = elemIndices '-' xs == [8,13,18,23]
+
+fromString' :: String -> Maybe UUID
+fromString' s0 = do
+ (w0, s1) <- hexWord s0
+ (w1, s2) <- hexWord s1
+ (w2, s3) <- hexWord s2
+ (w3, s4) <- hexWord s3
+ if s4 /= "" then Nothing
+ else Just $ UUID w0 w1 w2 w3
+ where hexWord :: String -> Maybe (Word32, String)
+ hexWord s = Just (0, s) >>= hexByte >>= hexByte
+ >>= hexByte >>= hexByte
+
+ hexByte :: (Word32, String) -> Maybe (Word32, String)
+ hexByte (w, '-':ds) = hexByte (w, ds)
+ hexByte (w, hi:lo:ds)
+ | bothHex = Just ((w `shiftL` 8) .|. octet, ds)
+ | otherwise = Nothing
+ where bothHex = isHexDigit hi && isHexDigit lo
+ octet = fromIntegral (16 * digitToInt hi + digitToInt lo)
+ hexByte _ = Nothing
+
+-- | Convert a UUID into a hypenated string using lower-case letters.
+-- Example:
+--
+-- @
+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
+-- @
+toString :: UUID -> String
+toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
+ where hexw :: Word32 -> String -> String
+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
+
+ hexw' :: Word32 -> String -> String
+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
+
+ hexn :: Word32 -> Int -> Char
+ hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
+
+-- | Convert a UUID into a hyphentated string using lower-case letters, packed
+-- as ASCII bytes into `B.ByteString`.
+--
+-- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
+toASCIIBytes :: UUID -> B.ByteString
+toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
+
+-- | Helper function for `toASCIIBytes`
+pokeASCII :: UUID -> Ptr Word8 -> IO ()
+pokeASCII uuid ptr = do
+ pokeDash 8
+ pokeDash 13
+ pokeDash 18
+ pokeDash 23
+ pokeSingle 0 w0
+ pokeDouble 9 w1
+ pokeDouble 19 w2
+ pokeSingle 28 w3
+ where
+ (w0, w1, w2, w3) = toWords uuid
+
+ -- ord '-' ==> 45
+ pokeDash ix = pokeElemOff ptr ix 45
+
+ pokeSingle ix w = do
+ pokeWord ix w 28
+ pokeWord (ix + 1) w 24
+ pokeWord (ix + 2) w 20
+ pokeWord (ix + 3) w 16
+ pokeWord (ix + 4) w 12
+ pokeWord (ix + 5) w 8
+ pokeWord (ix + 6) w 4
+ pokeWord (ix + 7) w 0
+
+ -- We skip the dash in the middle
+ pokeDouble ix w = do
+ pokeWord ix w 28
+ pokeWord (ix + 1) w 24
+ pokeWord (ix + 2) w 20
+ pokeWord (ix + 3) w 16
+ pokeWord (ix + 5) w 12
+ pokeWord (ix + 6) w 8
+ pokeWord (ix + 7) w 4
+ pokeWord (ix + 8) w 0
+
+ pokeWord ix w r =
+ pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
+
+ toDigit :: Word32 -> Word32
+ toDigit w = if w < 10 then 48 + w else 97 + w - 10
+
+-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
+-- a `UUID`, it will be. The hyphens may not be omitted.
+--
+-- This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.
+fromASCIIBytes :: B.ByteString -> Maybe UUID
+fromASCIIBytes bs = do
+ guard wellFormed
+ fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
+ where
+ -- ord '-' ==> 45
+ dashIx bs' ix = BU.unsafeIndex bs' ix == 45
+
+ -- Important: check the length first, given the `unsafeIndex` later.
+ wellFormed =
+ B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
+ dashIx bs 18 && dashIx bs 23
+
+ single ix = combine <$> octet ix <*> octet (ix + 2)
+ <*> octet (ix + 4) <*> octet (ix + 6)
+ double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
+ <*> octet ix1 <*> octet (ix1 + 2)
+
+ combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
+
+ octet ix = do
+ hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
+ lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
+ return (16 * hi + lo)
+
+ toDigit :: Word8 -> Maybe Word8
+ toDigit w
+ -- Digit
+ | w >= 48 && w <= 57 = Just (w - 48)
+ -- Uppercase
+ | w >= 65 && w <= 70 = Just (10 + w - 65)
+ -- Lowercase
+ | w >= 97 && w <= 102 = Just (10 + w - 97)
+ | otherwise = Nothing
+
+-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
+toLazyASCIIBytes :: UUID -> BL.ByteString
+toLazyASCIIBytes =
+#if MIN_VERSION_bytestring(0,10,0)
+ BL.fromStrict
+#else
+ BL.fromChunks . return
+#endif
+ . toASCIIBytes
+
+-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
+fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
+fromLazyASCIIBytes bs =
+ if BL.length bs == 36 then fromASCIIBytes (
+#if MIN_VERSION_bytestring(0,10,0)
+ BL.toStrict bs
+#else
+ B.concat $ BL.toChunks bs
+#endif
+ ) else Nothing
+
+--
+-- Class Instances
+--
+
+instance Random UUID where
+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)
+ where (w0, g0) = next g
+ (w1, g1) = next g0
+ (w2, g2) = next g1
+ (w3, g3) = next g2
+ (w4, g4) = next g3
+ randomR _ = random -- range is ignored
+
+-- |Build a UUID from the results of five calls to next on a StdGen.
+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
+-- randomness. This code relies on at last 28 bits of randomness in the
+-- and optimizes its use so as to make only five random values, not six.
+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
+fromGenNext w0 w1 w2 w3 w4 =
+ buildFromBytes 4 /-/ (ThreeByte w0)
+ /-/ (ThreeByte w1)
+ /-/ w2 -- use all 4 bytes because we know the version
+ -- field will "cover" the upper, non-random bits
+ /-/ (ThreeByte w3)
+ /-/ (ThreeByte w4)
+
+-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
+-- only returns 31 bits of randomness.
+type instance ByteSink ThreeByte g = Takes3Bytes g
+newtype ThreeByte = ThreeByte Int
+instance ByteSource ThreeByte where
+ f /-/ (ThreeByte w) = f b1 b2 b3
+ where b1 = fromIntegral (w `shiftR` 16)
+ b2 = fromIntegral (w `shiftR` 8)
+ b3 = fromIntegral w
+
+instance NFData UUID where
+ rnf = rnf . toWords
+
+instance Hashable UUID where
+ hash (UUID w0 w1 w2 w3) =
+ hash w0 `hashWithSalt` w1
+ `hashWithSalt` w2
+ `hashWithSalt` w3
+ hashWithSalt s (UUID w0 w1 w2 w3) =
+ s `hashWithSalt` w0
+ `hashWithSalt` w1
+ `hashWithSalt` w2
+ `hashWithSalt` w3
+
+instance Show UUID where
+ show = toString
+
+instance Read UUID where
+ readsPrec _ str =
+ let noSpaces = dropWhile isSpace str[...incomplete...]
More information about the Pkg-haskell-commits
mailing list