@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP, ViewPatterns #-}
22{-# OPTIONS_HADDOCK hide #-}
33
44-- |
@@ -40,7 +40,7 @@ import Prelude hiding (null)
4040
4141import Control.Applicative ((<*>))
4242import Control.DeepSeq (NFData(..))
43−import Control.Monad (liftM4, guard)
43+import Control.Monad (liftM2, guard)
4444import Data.Functor ((<$>))
4545import Data.Char
4646import Data.Bits
@@ -77,12 +77,12 @@ import System.Random
7777-- network order as 16 bytes.
7878data UUID
7979 = UUID
80− {-# UNPACK #-} !Word32
81− {-# UNPACK #-} !Word32
82− {-# UNPACK #-} !Word32
83− {-# UNPACK #-} !Word32
80+ {-# UNPACK #-} !Word64
81+ {-# UNPACK #-} !Word64
8482 deriving (Eq, Ord, Typeable)
8583{-
84+ Prior to uuid-types-1.0.4:
85+ !Word32 !Word32 !Word32 !Word32
8686 Other representations that we tried are:
8787 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
8888 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
@@ -99,14 +99,19 @@ data UUID
9999-- neither 'Storable' nor 'Binary' are appropriate.
100100-- Introduced in version 1.2.2.
101101toWords :: UUID -> (Word32, Word32, Word32, Word32)
102−toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
102+toWords (UUID w12 w34) = (w1, w2, w3, w4)
103+ where
104+ w1 = fromIntegral (w12 `unsafeShiftR` 32)
105+ w2 = fromIntegral w12
106+ w3 = fromIntegral (w34 `unsafeShiftR` 32)
107+ w4 = fromIntegral w34
103108
104109-- | Create a 'UUID' from a sequence of 'Word32'. The
105110-- opposite of 'toWords'. Useful when you need a total
106111-- function for constructing 'UUID' values.
107112-- Introduced in version 1.2.2.
108113fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
109−fromWords = UUID
114+fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
110115
111116data UnpackedUUID =
112117 UnpackedUUID {
@@ -125,9 +130,7 @@ data UnpackedUUID =
125130 deriving (Read, Show, Eq, Ord)
126131
127132unpack :: UUID -> UnpackedUUID
128−unpack (UUID w0 w1 w2 w3) =
129− build /-/ w0 /-/ w1 /-/ w2 /-/ w3
130−
133+unpack (UUID w0 w1) = build /-/ w0 /-/ w1
131134 where
132135 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
133136 UnpackedUUID {
@@ -167,8 +170,8 @@ word a b c d = (fromIntegral a `shiftL` 24)
167170 .|. (fromIntegral c `shiftL` 8)
168171 .|. (fromIntegral d )
169172
170−-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
171−byte :: Int -> Word32 -> Word8
173+-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
174+byte :: Int -> Word64 -> Word8
172175byte i w = fromIntegral (w `shiftR` (i * 8))
173176
174177-- |Build a Word16 from two Word8 values, presented in big-endian order.
@@ -179,6 +182,9 @@ w8to16 w0s w1s =
179182 w0 = fromIntegral w0s
180183 w1 = fromIntegral w1s
181184
185+-- | Construct 'Word64' from low/high 'Word32's
186+w32to64 :: Word32 -> Word32 -> Word64
187+w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)
182188
183189-- |Make a UUID from sixteen Word8 values
184190makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
@@ -187,16 +193,12 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
187193 -> Word8 -> Word8 -> Word8 -> Word8
188194 -> UUID
189195makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
190− = UUID w0 w1 w2 w3
196+ = fromWords w0 w1 w2 w3
191197 where w0 = word b0 b1 b2 b3
192198 w1 = word b4 b5 b6 b7
193199 w2 = word b8 b9 ba bb
194200 w3 = word bc bd be bf
195201
196−-- |Make a UUID from four Word32 values
197−makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
198−makeFromWords = UUID
199−
200202-- |A Builder for constructing a UUID of a given version.
201203buildFromBytes :: Word8
202204 -> Word8 -> Word8 -> Word8 -> Word8
@@ -211,18 +213,18 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
211213
212214-- |Build a UUID of a given version from Word32 values.
213215buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
214−buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3
216+buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
215217 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
216218 w2' = w2 .&. 0x3fffffff .|. 0x80000000
217219
218220
219221-- |Return the bytes that make up the UUID
220222toList :: UUID -> [Word8]
221−toList (UUID w0 w1 w2 w3) =
222− [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
223− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
224− byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
225− byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
223+toList (UUID w0 w1) =
224+ [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
225+ byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
226+ byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
227+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
226228
227229-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
228230-- exactly sixteen bytes long
@@ -246,7 +248,7 @@ null = (== nil)
246248-- |The nil UUID, as defined in RFC 4122.
247249-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
248250nil :: UUID
249−nil = UUID 0 0 0 0
251+nil = UUID 0 0
250252
251253-- |Extract a UUID from a 'ByteString' in network byte order.
252254-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
@@ -278,7 +280,7 @@ fromString' s0 = do
278280 (w2, s3) <- hexWord s2
279281 (w3, s4) <- hexWord s3
280282 if s4 /= "" then Nothing
281− else Just $ UUID w0 w1 w2 w3
283+ else Just $ fromWords w0 w1 w2 w3
282284 where hexWord :: String -> Maybe (Word32, String)
283285 hexWord s = Just (0, s) >>= hexByte >>= hexByte
284286 >>= hexByte >>= hexByte
@@ -299,7 +301,7 @@ fromString' s0 = do
299301-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
300302-- @
301303toString :: UUID -> String
302−toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
304+toString uuid = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
303305 where hexw :: Word32 -> String -> String
304306 hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
305307 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
@@ -311,6 +313,8 @@ toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
311313 hexn :: Word32 -> Int -> Char
312314 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
313315
316+ (w0,w1,w2,w3) = toWords uuid
317+
314318-- | If the passed in `Text` can be parsed as an ASCII representation of
315319-- a `UUID`, it will be. The hyphens may not be omitted.
316320fromText :: Text -> Maybe UUID
@@ -468,14 +472,14 @@ instance ByteSource ThreeByte where
468472 b3 = fromIntegral w
469473
470474instance NFData UUID where
471− rnf = rnf . toWords
475+ rnf = flip seq ()
472476
473477instance Hashable UUID where
474− hash (UUID w0 w1 w2 w3) =
478+ hash (toWords -> (w0,w1,w2,w3)) =
475479 hash w0 `hashWithSalt` w1
476480 `hashWithSalt` w2
477481 `hashWithSalt` w3
478− hashWithSalt s (UUID w0 w1 w2 w3) =
482+ hashWithSalt s (toWords -> (w0,w1,w2,w3)) =
479483 s `hashWithSalt` w0
480484 `hashWithSalt` w1
481485 `hashWithSalt` w2
@@ -529,9 +533,8 @@ instance Storable UUID where
529533 pokeByteOff p (off+15) x10
530534
531535instance Binary UUID where
532− put (UUID w0 w1 w2 w3) =
533− putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3
534− get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be
536+ put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
537+ get = liftM2 UUID getWord64be getWord64be
535538
536539
537540-- My goal with this instance was to make it work just enough to do what
@@ -548,3 +551,9 @@ uuidType = mkNoRepType "Data.UUID.Types.UUID"
548551mkNoRepType :: String -> DataType
549552mkNoRepType = mkNorepType
550553#endif
554+
555+#if !MIN_VERSION_base(4,5,0)
556+unsafeShiftR, unsafeShiftL :: Word64 -> Int -> Word64
557+unsafeShiftR = shiftR
558+unsafeShiftL = shiftL
559+#endif