@@ -1,88 +1,86 @@
1−{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE ViewPatterns #-}
5+{-# LANGUAGE Unsafe #-}
6+{-# LANGUAGE DeriveLift #-}
7+{-# LANGUAGE StandaloneDeriving #-}
2{-# OPTIONS_HADDOCK hide #-}
8{-# OPTIONS_HADDOCK hide #-}
5-- Module : Data.UUID.Types.Internal
11-- Module : Data.UUID.Types.Internal
12+-- Copyright : (c) 2017-2018 Herbert Valerio Riedel
6−-- Copyright : (c) 2008-2009, 2012 Antoine Latter
13+-- (c) 2008-2009, 2012 Antoine Latter
7-- (c) 2009 Mark Lentczner
14-- (c) 2009 Mark Lentczner
9-- License : BSD-style
16-- License : BSD-style
11−-- Maintainer : aslatter@gmail.com
18+-- Maintainer : hvr@gnu.org
12−-- Stability : experimental
13-- Portability : portable
19-- Portability : portable
15module Data.UUID.Types.Internal
21module Data.UUID.Types.Internal
16− (UUID(..)
22+ ( UUID(..)
19− ,fromByteString
25+ , fromByteString
20− ,toByteString
26+ , toByteString
21− ,fromString
27+ , fromString
22− ,toString
28+ , toString
23− ,fromText
29+ , fromText
25− ,fromWords
31+ , fromWords
26− ,toWords
32+ , toWords
28− ,buildFromBytes
36+ , buildFromBytes
29− ,buildFromWords
37+ , buildFromWords
30− ,fromASCIIBytes
38+ , fromASCIIBytes
31− ,toASCIIBytes
39+ , toASCIIBytes
32− ,fromLazyASCIIBytes
40+ , fromLazyASCIIBytes
33− ,toLazyASCIIBytes
41+ , toLazyASCIIBytes
34− ,UnpackedUUID(..)
42+ , UnpackedUUID(..)
39−import Prelude hiding (null)
47+import Prelude hiding (null)
41−import Control.Applicative ((<*>))
42−import Control.DeepSeq (NFData(..))
49+import Control.DeepSeq (NFData (..))
43−import Control.Monad (liftM4, guard)
50+import Control.Monad (guard, liftM2)
44−import Data.Functor ((<$>))
51+import Data.Bits
45−import Data.Char
52+import Data.Char
46−import Data.Bits
53+import Data.Data
47−import Data.Hashable
54+import Data.Hashable
48−import Data.List (elemIndices)
55+import Data.List (elemIndices)
49−import Foreign.Ptr (Ptr)
56+import Foreign.Ptr (Ptr)
51−#if MIN_VERSION_base(4,0,0)
54−import Data.Generics.Basics
57−import Foreign.Storable
58+import Foreign.Storable
59−import Data.Binary
60+import Data.Binary
60−import Data.Binary.Put
61−import Data.Binary.Get
61+import Data.Binary.Get
62+import Data.Binary.Put
62−import qualified Data.ByteString as B
63+import qualified Data.ByteString as B
63−import qualified Data.ByteString.Internal as BI
64+import qualified Data.ByteString.Internal as BI
64−import qualified Data.ByteString.Lazy as BL
65+import qualified Data.ByteString.Lazy as BL
65−import qualified Data.ByteString.Unsafe as BU
66+import qualified Data.ByteString.Unsafe as BU
66−import Data.Text (Text)
67+import Data.Text (Text)
67−import qualified Data.Text as T
68+import qualified Data.Text.Encoding as T
69−import Data.UUID.Types.Internal.Builder
70+import Data.UUID.Types.Internal.Builder
71−import System.Random
72+import System.Random (Random (..), uniform)
72−
73+import System.Random.Stateful (Uniform (..), uniformWord64)
74−-- |The UUID type. A 'Random' instance is provided which produces
75+import Language.Haskell.TH.Syntax (Lift)
75−-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and
76+
76−-- 'Binary' instances are compatible with RFC 4122, storing the fields
77+-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
77−-- in network order as 16 bytes.
78+-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
78−data UUID
79+data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80− {-# UNPACK #-} !Word32
81− {-# UNPACK #-} !Word32
82− {-# UNPACK #-} !Word32
83− {-# UNPACK #-} !Word32
84− deriving (Eq, Ord, Typeable)
80+ deriving (Eq, Ord)
82+ Prior to uuid-types-1.0.4:
83+ !Word32 !Word32 !Word32 !Word32
86 Other representations that we tried are:
84 Other representations that we tried are:
87 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
85 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
88 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
86 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
@@ -94,40 +92,75 @@ data UUID
94 None was as fast, overall, as the representation used here.
92 None was as fast, overall, as the representation used here.
97−-- | Covert a 'UUID' into a sequence of 'Word32' values.
95+-- | Convert a 'UUID' into a sequence of 'Word32' values.
98-- Useful for when you need to serialize a UUID and
96-- Useful for when you need to serialize a UUID and
99-- neither 'Storable' nor 'Binary' are appropriate.
97-- neither 'Storable' nor 'Binary' are appropriate.
100−-- Introduced in version 1.2.2.
98+--
99+-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
100+-- Just (1427014656,3801825748,2803254374,1430519808)
102+-- See also 'toWords64'.
104+-- /Since: @uuid-1.2.2@/
101toWords :: UUID -> (Word32, Word32, Word32, Word32)
107toWords :: UUID -> (Word32, Word32, Word32, Word32)
102−toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
108+toWords (UUID w12 w34) = (w1, w2, w3, w4)
110+ w1 = fromIntegral (w12 `unsafeShiftR` 32)
111+ w2 = fromIntegral w12
112+ w3 = fromIntegral (w34 `unsafeShiftR` 32)
113+ w4 = fromIntegral w34
104-- | Create a 'UUID' from a sequence of 'Word32'. The
115-- | Create a 'UUID' from a sequence of 'Word32'. The
105−-- opposite of 'toWords'. Useful when you need a total
116+-- inverse of 'toWords'. Useful when you need a total
106-- function for constructing 'UUID' values.
117-- function for constructing 'UUID' values.
107−-- Introduced in version 1.2.2.
118+--
119+-- See also 'fromWords64'.
121+-- /Since: @uuid-1.2.2@/
108fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
124fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
109−fromWords = UUID
125+fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
127+-- | Convert a 'UUID' into a pair of 'Word64's.
129+-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
130+-- Just (6128981282234515924,12039885860129472512)
132+-- See also 'toWords'.
135+toWords64 :: UUID -> (Word64, Word64)
136+toWords64 (UUID w12 w34) = (w12,w34)
138+-- | Create a 'UUID' from a pair of 'Word64's.
140+-- Inverse of 'toWords64'. See also 'fromWords'.
143+fromWords64 :: Word64 -> Word64 -> UUID
111data UnpackedUUID =
146data UnpackedUUID =
112 UnpackedUUID {
147 UnpackedUUID {
113− time_low :: Word32 -- 0-3
148+ time_low :: Word32 -- 0-3
114− , time_mid :: Word16 -- 4-5
149+ , time_mid :: Word16 -- 4-5
115 , time_hi_and_version :: Word16 -- 6-7
150 , time_hi_and_version :: Word16 -- 6-7
116− , clock_seq_hi_res :: Word8 -- 8
151+ , clock_seq_hi_res :: Word8 -- 8
117− , clock_seq_low :: Word8 -- 9
152+ , clock_seq_low :: Word8 -- 9
118− , node_0 :: Word8
153+ , node_0 :: Word8
119− , node_1 :: Word8
154+ , node_1 :: Word8
120− , node_2 :: Word8
155+ , node_2 :: Word8
121− , node_3 :: Word8
156+ , node_3 :: Word8
122− , node_4 :: Word8
157+ , node_4 :: Word8
123− , node_5 :: Word8
158+ , node_5 :: Word8
125 deriving (Read, Show, Eq, Ord)
160 deriving (Read, Show, Eq, Ord)
127unpack :: UUID -> UnpackedUUID
162unpack :: UUID -> UnpackedUUID
128−unpack (UUID w0 w1 w2 w3) =
163+unpack (UUID w0 w1) = build /-/ w0 /-/ w1
129− build /-/ w0 /-/ w1 /-/ w2 /-/ w3
132 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
165 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
133 UnpackedUUID {
166 UnpackedUUID {
@@ -162,23 +195,26 @@ pack unpacked =
163-- |Build a Word32 from four Word8 values, presented in big-endian order
196-- |Build a Word32 from four Word8 values, presented in big-endian order
164word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
197word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
165−word a b c d = (fromIntegral a `shiftL` 24)
198+word a b c d = (fromIntegral a `unsafeShiftL` 24)
166− .|. (fromIntegral b `shiftL` 16)
199+ .|. (fromIntegral b `unsafeShiftL` 16)
167− .|. (fromIntegral c `shiftL` 8)
200+ .|. (fromIntegral c `unsafeShiftL` 8)
168− .|. (fromIntegral d )
201+ .|. (fromIntegral d )
170−-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
203+-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
171−byte :: Int -> Word32 -> Word8
204+byte :: Int -> Word64 -> Word8
172byte i w = fromIntegral (w `shiftR` (i * 8))
205byte i w = fromIntegral (w `shiftR` (i * 8))
174-- |Build a Word16 from two Word8 values, presented in big-endian order.
207-- |Build a Word16 from two Word8 values, presented in big-endian order.
175w8to16 :: Word8 -> Word8 -> Word16
208w8to16 :: Word8 -> Word8 -> Word16
176w8to16 w0s w1s =
209w8to16 w0s w1s =
177− (w0 `shiftL` 8) .|. w1
210+ (w0 `unsafeShiftL` 8) .|. w1
179 w0 = fromIntegral w0s
212 w0 = fromIntegral w0s
180 w1 = fromIntegral w1s
213 w1 = fromIntegral w1s
215+-- | Construct 'Word64' from low/high 'Word32's
216+w32to64 :: Word32 -> Word32 -> Word64
217+w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)
183-- |Make a UUID from sixteen Word8 values
219-- |Make a UUID from sixteen Word8 values
184makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
220makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
@@ -187,16 +223,12 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
187 -> Word8 -> Word8 -> Word8 -> Word8
223 -> Word8 -> Word8 -> Word8 -> Word8
189makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
225makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
190− = UUID w0 w1 w2 w3
226+ = fromWords w0 w1 w2 w3
191 where w0 = word b0 b1 b2 b3
227 where w0 = word b0 b1 b2 b3
192 w1 = word b4 b5 b6 b7
228 w1 = word b4 b5 b6 b7
193 w2 = word b8 b9 ba bb
229 w2 = word b8 b9 ba bb
194 w3 = word bc bd be bf
230 w3 = word bc bd be bf
196−-- |Make a UUID from four Word32 values
197−makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
200-- |A Builder for constructing a UUID of a given version.
232-- |A Builder for constructing a UUID of a given version.
201buildFromBytes :: Word8
233buildFromBytes :: Word8
202 -> Word8 -> Word8 -> Word8 -> Word8
234 -> Word8 -> Word8 -> Word8 -> Word8
@@ -209,20 +241,20 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
209 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
241 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
210 b8' = b8 .&. 0x3f .|. 0x80
242 b8' = b8 .&. 0x3f .|. 0x80
212−-- |Build a UUID of a given version from Word32 values.
244+-- |Build a UUID of a given version from 'Word32' values.
213buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
245buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
214−buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3
246+buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
215 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
247 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
216 w2' = w2 .&. 0x3fffffff .|. 0x80000000
248 w2' = w2 .&. 0x3fffffff .|. 0x80000000
219-- |Return the bytes that make up the UUID
251-- |Return the bytes that make up the UUID
220toList :: UUID -> [Word8]
252toList :: UUID -> [Word8]
221−toList (UUID w0 w1 w2 w3) =
253+toList (UUID w0 w1) =
222− [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
254+ [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
223− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
255+ byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
224− byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
256+ byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
225− byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
257+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
227-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
259-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
228-- exactly sixteen bytes long
260-- exactly sixteen bytes long
@@ -243,10 +275,10 @@ null = (== nil)
243 -- null (UUID 0 0 0 0) = True
275 -- null (UUID 0 0 0 0) = True
244 -- null _ = False
276 -- null _ = False
246−-- |The nil UUID, as defined in RFC 4122.
278+-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
247−-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
279+-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
248nil :: UUID
280nil :: UUID
249−nil = UUID 0 0 0 0
281+nil = UUID 0 0
251-- |Extract a UUID from a 'ByteString' in network byte order.
283-- |Extract a UUID from a 'ByteString' in network byte order.
252-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
284-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
@@ -254,6 +286,8 @@ fromByteString :: BL.ByteString -> Maybe UUID
254fromByteString = fromList . BL.unpack
286fromByteString = fromList . BL.unpack
256-- |Encode a UUID into a 'ByteString' in network order.
288-- |Encode a UUID into a 'ByteString' in network order.
290+-- This uses the same encoding as the 'Binary' instance.
257toByteString :: UUID -> BL.ByteString
291toByteString :: UUID -> BL.ByteString
258toByteString = BL.pack . toList
292toByteString = BL.pack . toList
@@ -261,9 +295,8 @@ toByteString = BL.pack . toList
261-- The hyphens may not be omitted.
295-- The hyphens may not be omitted.
262-- Example:
296-- Example:
265−-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
298+-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
266−-- @
299+-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
268-- Hex digits may be upper or lower-case.
301-- Hex digits may be upper or lower-case.
269fromString :: String -> Maybe UUID
302fromString :: String -> Maybe UUID
@@ -278,7 +311,7 @@ fromString' s0 = do
278 (w2, s3) <- hexWord s2
311 (w2, s3) <- hexWord s2
279 (w3, s4) <- hexWord s3
312 (w3, s4) <- hexWord s3
280 if s4 /= "" then Nothing
313 if s4 /= "" then Nothing
281− else Just $ UUID w0 w1 w2 w3
314+ else Just $ fromWords w0 w1 w2 w3
282 where hexWord :: String -> Maybe (Word32, String)
315 where hexWord :: String -> Maybe (Word32, String)
283 hexWord s = Just (0, s) >>= hexByte >>= hexByte
316 hexWord s = Just (0, s) >>= hexByte >>= hexByte
284 >>= hexByte >>= hexByte
317 >>= hexByte >>= hexByte
@@ -295,30 +328,39 @@ fromString' s0 = do
295-- | Convert a UUID into a hypenated string using lower-case letters.
328-- | Convert a UUID into a hypenated string using lower-case letters.
296-- Example:
329-- Example:
299−-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
331+-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
300−-- @
332+-- Just "550e8400-e29b-41d4-a716-446655440000"
301toString :: UUID -> String
335toString :: UUID -> String
302−toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
336+toString uuid = hexw0 w0 $ hexw1 w1 ""
303− where hexw :: Word32 -> String -> String
337+ where hexw0 :: Word64 -> String -> String
338+ hexw0 w s = hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
339+ : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
304− hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
340+ : '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
305− : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
341+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
307− hexw' :: Word32 -> String -> String
344+ hexw1 :: Word64 -> String -> String
308− hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
345+ hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
346+ : '-' : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
347+ : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
309− : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
348+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
311− hexn :: Word32 -> Int -> Char
351+ hexn :: Word64 -> Int -> Char
312 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
352 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
354+ (w0,w1) = toWords64 uuid
314-- | If the passed in `Text` can be parsed as an ASCII representation of
356-- | If the passed in `Text` can be parsed as an ASCII representation of
315-- a `UUID`, it will be. The hyphens may not be omitted.
357-- a `UUID`, it will be. The hyphens may not be omitted.
316fromText :: Text -> Maybe UUID
358fromText :: Text -> Maybe UUID
317−fromText = fromString . T.unpack
359+fromText = fromASCIIBytes . T.encodeUtf8
319-- | Convert a UUID into a hyphentated string using lower-case letters.
361-- | Convert a UUID into a hyphentated string using lower-case letters.
320toText :: UUID -> Text
362toText :: UUID -> Text
321−toText = T.pack . toString
363+toText = T.decodeLatin1 . toASCIIBytes
323-- | Convert a UUID into a hyphentated string using lower-case letters, packed
365-- | Convert a UUID into a hyphentated string using lower-case letters, packed
324-- as ASCII bytes into `B.ByteString`.
366-- as ASCII bytes into `B.ByteString`.
@@ -413,49 +455,30 @@ fromASCIIBytes bs = do
413-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
455-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
414toLazyASCIIBytes :: UUID -> BL.ByteString
456toLazyASCIIBytes :: UUID -> BL.ByteString
415toLazyASCIIBytes =
457toLazyASCIIBytes =
416−#if MIN_VERSION_bytestring(0,10,0)
417 BL.fromStrict
458 BL.fromStrict
419− BL.fromChunks . return
421 . toASCIIBytes
459 . toASCIIBytes
423-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
461-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
424fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
425fromLazyASCIIBytes bs =
463fromLazyASCIIBytes bs =
426− if BL.length bs == 36 then fromASCIIBytes (
464+ if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
427−#if MIN_VERSION_bytestring(0,10,0)
430− B.concat $ BL.toChunks bs
435-- Class Instances
467-- Class Instances
470+-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471+-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
438instance Random UUID where
472instance Random UUID where
439− random g = (fromGenNext w0 w1 w2 w3 w4, g4)
473+ random = uniform
440− where (w0, g0) = next g
445 randomR _ = random -- range is ignored
474 randomR _ = random -- range is ignored
447−-- |Build a UUID from the results of five calls to next on a StdGen.
476+-- @since 1.0.4
448−-- While next on StdGet returns an Int, it doesn't provide 32 bits of
477+instance Uniform UUID where
449−-- randomness. This code relies on at last 28 bits of randomness in the
478+ uniformM gen = do
450−-- and optimizes its use so as to make only five random values, not six.
479+ w0 <- uniformWord64 gen
451−fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
480+ w1 <- uniformWord64 gen
452−fromGenNext w0 w1 w2 w3 w4 =
453− buildFromBytes 4 /-/ (ThreeByte w0)
481+ pure $ buildFromBytes 4 /-/ w0 /-/ w1
455− /-/ w2 -- use all 4 bytes because we know the version
456− -- field will "cover" the upper, non-random bits
460-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
483-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
461-- only returns 31 bits of randomness.
484-- only returns 31 bits of randomness.
@@ -463,24 +486,29 @@ type instance ByteSink ThreeByte g = Takes3Bytes g
463newtype ThreeByte = ThreeByte Int
486newtype ThreeByte = ThreeByte Int
464instance ByteSource ThreeByte where
487instance ByteSource ThreeByte where
465 f /-/ (ThreeByte w) = f b1 b2 b3
488 f /-/ (ThreeByte w) = f b1 b2 b3
466− where b1 = fromIntegral (w `shiftR` 16)
489+ where b1 = fromIntegral (w `unsafeShiftR` 16)
467− b2 = fromIntegral (w `shiftR` 8)
490+ b2 = fromIntegral (w `unsafeShiftR` 8)
468 b3 = fromIntegral w
491 b3 = fromIntegral w
470instance NFData UUID where
493instance NFData UUID where
471− rnf = rnf . toWords
494+ rnf = flip seq ()
473instance Hashable UUID where
496instance Hashable UUID where
474− hash (UUID w0 w1 w2 w3) =
497+ hash (toWords -> (w0,w1,w2,w3)) =
475 hash w0 `hashWithSalt` w1
498 hash w0 `hashWithSalt` w1
476 `hashWithSalt` w2
499 `hashWithSalt` w2
477 `hashWithSalt` w3
500 `hashWithSalt` w3
478− hashWithSalt s (UUID w0 w1 w2 w3) =
501+ hashWithSalt s (toWords -> (w0,w1,w2,w3)) =
479 s `hashWithSalt` w0
502 s `hashWithSalt` w0
480 `hashWithSalt` w1
503 `hashWithSalt` w1
481 `hashWithSalt` w2
504 `hashWithSalt` w2
482 `hashWithSalt` w3
505 `hashWithSalt` w3
507+-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
510+-- "00000000-0000-0000-0000-000000000000"
484instance Show UUID where
512instance Show UUID where
485 show = toString
513 show = toString
@@ -491,7 +519,7 @@ instance Read UUID where
491 Nothing -> []
519 Nothing -> []
492 Just u -> [(u,drop 36 noSpaces)]
520 Just u -> [(u,drop 36 noSpaces)]
494−
522+-- | This 'Storable' instance uses the memory layout as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>, but in contrast to the 'Binary' instance, __the fields are stored in host byte order__.
495instance Storable UUID where
523instance Storable UUID where
496 sizeOf _ = 16
524 sizeOf _ = 16
497 alignment _ = 4
525 alignment _ = 4
@@ -528,10 +556,10 @@ instance Storable UUID where
528 pokeByteOff p (off+14) x9
556 pokeByteOff p (off+14) x9
529 pokeByteOff p (off+15) x10
557 pokeByteOff p (off+15) x10
559+-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
531instance Binary UUID where
560instance Binary UUID where
532− put (UUID w0 w1 w2 w3) =
561+ put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
533− putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3
562+ get = liftM2 UUID getWord64be getWord64be
534− get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be
537-- My goal with this instance was to make it work just enough to do what
565-- My goal with this instance was to make it work just enough to do what
@@ -544,7 +572,4 @@ instance Data UUID where
544uuidType :: DataType
572uuidType :: DataType
545uuidType = mkNoRepType "Data.UUID.Types.UUID"
573uuidType = mkNoRepType "Data.UUID.Types.UUID"
547−#if !(MIN_VERSION_base(4,2,0))
575+deriving instance Lift UUID
548−mkNoRepType :: String -> DataType
549−mkNoRepType = mkNorepType