@@ -0,0 +1,575 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE ViewPatterns #-}
5+{-# LANGUAGE Unsafe #-}
6+{-# LANGUAGE DeriveLift #-}
7+{-# LANGUAGE StandaloneDeriving #-}
8+{-# OPTIONS_HADDOCK hide #-}
9+
10+-- |
11+-- Module : Data.UUID.Types.Internal
12+-- Copyright : (c) 2017-2018 Herbert Valerio Riedel
13+-- (c) 2008-2009, 2012 Antoine Latter
14+-- (c) 2009 Mark Lentczner
15+--
16+-- License : BSD-style
17+--
18+-- Maintainer : hvr@gnu.org
19+-- Portability : portable
20+
21+module Data.UUID.Types.Internal
22+ ( UUID(..)
23+ , null
24+ , nil
25+ , fromByteString
26+ , toByteString
27+ , fromString
28+ , toString
29+ , fromText
30+ , toText
31+ , fromWords
32+ , toWords
33+ , fromWords64
34+ , toWords64
35+ , toList
36+ , buildFromBytes
37+ , buildFromWords
38+ , fromASCIIBytes
39+ , toASCIIBytes
40+ , fromLazyASCIIBytes
41+ , toLazyASCIIBytes
42+ , UnpackedUUID(..)
43+ , pack
44+ , unpack
45+ ) where
46+
47+import Prelude hiding (null)
48+
49+import Control.DeepSeq (NFData (..))
50+import Control.Monad (guard, liftM2)
51+import Data.Bits
52+import Data.Char
53+import Data.Data
54+import Data.Hashable
55+import Data.List (elemIndices)
56+import Foreign.Ptr (Ptr)
57+
58+import Foreign.Storable
59+
60+import Data.Binary
61+import Data.Binary.Get
62+import Data.Binary.Put
63+import qualified Data.ByteString as B
64+import qualified Data.ByteString.Internal as BI
65+import qualified Data.ByteString.Lazy as BL
66+import qualified Data.ByteString.Unsafe as BU
67+import Data.Text (Text)
68+import qualified Data.Text.Encoding as T
69+
70+import Data.UUID.Types.Internal.Builder
71+
72+import System.Random (Random (..), uniform)
73+import System.Random.Stateful (Uniform (..), uniformWord64)
74+
75+import Language.Haskell.TH.Syntax (Lift)
76+
77+-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
78+-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
79+data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80+ deriving (Eq, Ord)
81+{-
82+ Prior to uuid-types-1.0.4:
83+ !Word32 !Word32 !Word32 !Word32
84+ Other representations that we tried are:
85+ Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
86+ !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
87+ Sixteen bytes: !Word8 ... (x 16)
88+ Simple list of bytes: [Word8]
89+ ByteString (strict) ByteString
90+ Immutable array: UArray Int Word8
91+ Vector: UArr Word8
92+ None was as fast, overall, as the representation used here.
93+-}
94+
95+-- | Convert a 'UUID' into a sequence of 'Word32' values.
96+-- Useful for when you need to serialize a UUID and
97+-- neither 'Storable' nor 'Binary' are appropriate.
98+--
99+-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
100+-- Just (1427014656,3801825748,2803254374,1430519808)
101+--
102+-- See also 'toWords64'.
103+--
104+-- /Since: @uuid-1.2.2@/
105+--
106+-- @since 1.0.0
107+toWords :: UUID -> (Word32, Word32, Word32, Word32)
108+toWords (UUID w12 w34) = (w1, w2, w3, w4)
109+ where
110+ w1 = fromIntegral (w12 `unsafeShiftR` 32)
111+ w2 = fromIntegral w12
112+ w3 = fromIntegral (w34 `unsafeShiftR` 32)
113+ w4 = fromIntegral w34
114+
115+-- | Create a 'UUID' from a sequence of 'Word32'. The
116+-- inverse of 'toWords'. Useful when you need a total
117+-- function for constructing 'UUID' values.
118+--
119+-- See also 'fromWords64'.
120+--
121+-- /Since: @uuid-1.2.2@/
122+--
123+-- @since 1.0.0
124+fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
125+fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
126+
127+-- | Convert a 'UUID' into a pair of 'Word64's.
128+--
129+-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
130+-- Just (6128981282234515924,12039885860129472512)
131+--
132+-- See also 'toWords'.
133+--
134+-- @since 1.0.4
135+toWords64 :: UUID -> (Word64, Word64)
136+toWords64 (UUID w12 w34) = (w12,w34)
137+
138+-- | Create a 'UUID' from a pair of 'Word64's.
139+--
140+-- Inverse of 'toWords64'. See also 'fromWords'.
141+--
142+-- @since 1.0.4
143+fromWords64 :: Word64 -> Word64 -> UUID
144+fromWords64 = UUID
145+
146+data UnpackedUUID =
147+ UnpackedUUID {
148+ time_low :: Word32 -- 0-3
149+ , time_mid :: Word16 -- 4-5
150+ , time_hi_and_version :: Word16 -- 6-7
151+ , clock_seq_hi_res :: Word8 -- 8
152+ , clock_seq_low :: Word8 -- 9
153+ , node_0 :: Word8
154+ , node_1 :: Word8
155+ , node_2 :: Word8
156+ , node_3 :: Word8
157+ , node_4 :: Word8
158+ , node_5 :: Word8
159+ }
160+ deriving (Read, Show, Eq, Ord)
161+
162+unpack :: UUID -> UnpackedUUID
163+unpack (UUID w0 w1) = build /-/ w0 /-/ w1
164+ where
165+ build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
166+ UnpackedUUID {
167+ time_low = word x0 x1 x2 x3
168+ , time_mid = w8to16 x4 x5
169+ , time_hi_and_version = w8to16 x6 x7
170+ , clock_seq_hi_res = x8
171+ , clock_seq_low = x9
172+ , node_0 = xA
173+ , node_1 = xB
174+ , node_2 = xC
175+ , node_3 = xD
176+ , node_4 = xE
177+ , node_5 = xF
178+ }
179+
180+pack :: UnpackedUUID -> UUID
181+pack unpacked =
182+ makeFromBytes /-/ (time_low unpacked)
183+ /-/ (time_mid unpacked)
184+ /-/ (time_hi_and_version unpacked)
185+ /-/ (clock_seq_hi_res unpacked)
186+ /-/ (clock_seq_low unpacked)
187+ /-/ (node_0 unpacked) /-/ (node_1 unpacked)
188+ /-/ (node_2 unpacked) /-/ (node_3 unpacked)
189+ /-/ (node_4 unpacked) /-/ (node_5 unpacked)
190+
191+
192+--
193+-- UTILITIES
194+--
195+
196+-- |Build a Word32 from four Word8 values, presented in big-endian order
197+word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
198+word a b c d = (fromIntegral a `unsafeShiftL` 24)
199+ .|. (fromIntegral b `unsafeShiftL` 16)
200+ .|. (fromIntegral c `unsafeShiftL` 8)
201+ .|. (fromIntegral d )
202+
203+-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
204+byte :: Int -> Word64 -> Word8
205+byte i w = fromIntegral (w `shiftR` (i * 8))
206+
207+-- |Build a Word16 from two Word8 values, presented in big-endian order.
208+w8to16 :: Word8 -> Word8 -> Word16
209+w8to16 w0s w1s =
210+ (w0 `unsafeShiftL` 8) .|. w1
211+ where
212+ w0 = fromIntegral w0s
213+ w1 = fromIntegral w1s
214+
215+-- | Construct 'Word64' from low/high 'Word32's
216+w32to64 :: Word32 -> Word32 -> Word64
217+w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)
218+
219+-- |Make a UUID from sixteen Word8 values
220+makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
221+ -> Word8 -> Word8 -> Word8 -> Word8
222+ -> Word8 -> Word8 -> Word8 -> Word8
223+ -> Word8 -> Word8 -> Word8 -> Word8
224+ -> UUID
225+makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
226+ = fromWords w0 w1 w2 w3
227+ where w0 = word b0 b1 b2 b3
228+ w1 = word b4 b5 b6 b7
229+ w2 = word b8 b9 ba bb
230+ w3 = word bc bd be bf
231+
232+-- |A Builder for constructing a UUID of a given version.
233+buildFromBytes :: Word8
234+ -> Word8 -> Word8 -> Word8 -> Word8
235+ -> Word8 -> Word8 -> Word8 -> Word8
236+ -> Word8 -> Word8 -> Word8 -> Word8
237+ -> Word8 -> Word8 -> Word8 -> Word8
238+ -> UUID
239+buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
240+ makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf
241+ where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
242+ b8' = b8 .&. 0x3f .|. 0x80
243+
244+-- |Build a UUID of a given version from 'Word32' values.
245+buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
246+buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
247+ where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
248+ w2' = w2 .&. 0x3fffffff .|. 0x80000000
249+
250+
251+-- |Return the bytes that make up the UUID
252+toList :: UUID -> [Word8]
253+toList (UUID w0 w1) =
254+ [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
255+ byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
256+ byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
257+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
258+
259+-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
260+-- exactly sixteen bytes long
261+fromList :: [Word8] -> Maybe UUID
262+fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
263+ Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
264+fromList _ = Nothing
265+
266+
267+--
268+-- UUID API
269+--
270+
271+-- |Returns true if the passed-in UUID is the 'nil' UUID.
272+null :: UUID -> Bool
273+null = (== nil)
274+ -- Note: This actually faster than:
275+ -- null (UUID 0 0 0 0) = True
276+ -- null _ = False
277+
278+-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
279+-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
280+nil :: UUID
281+nil = UUID 0 0
282+
283+-- |Extract a UUID from a 'ByteString' in network byte order.
284+-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
285+fromByteString :: BL.ByteString -> Maybe UUID
286+fromByteString = fromList . BL.unpack
287+
288+-- |Encode a UUID into a 'ByteString' in network order.
289+--
290+-- This uses the same encoding as the 'Binary' instance.
291+toByteString :: UUID -> BL.ByteString
292+toByteString = BL.pack . toList
293+
294+-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
295+-- The hyphens may not be omitted.
296+-- Example:
297+--
298+-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
299+-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
300+--
301+-- Hex digits may be upper or lower-case.
302+fromString :: String -> Maybe UUID
303+fromString xs | validFmt = fromString' xs
304+ | otherwise = Nothing
305+ where validFmt = elemIndices '-' xs == [8,13,18,23]
306+
307+fromString' :: String -> Maybe UUID
308+fromString' s0 = do
309+ (w0, s1) <- hexWord s0
310+ (w1, s2) <- hexWord s1
311+ (w2, s3) <- hexWord s2
312+ (w3, s4) <- hexWord s3
313+ if s4 /= "" then Nothing
314+ else Just $ fromWords w0 w1 w2 w3
315+ where hexWord :: String -> Maybe (Word32, String)
316+ hexWord s = Just (0, s) >>= hexByte >>= hexByte
317+ >>= hexByte >>= hexByte
318+
319+ hexByte :: (Word32, String) -> Maybe (Word32, String)
320+ hexByte (w, '-':ds) = hexByte (w, ds)
321+ hexByte (w, hi:lo:ds)
322+ | bothHex = Just ((w `shiftL` 8) .|. octet, ds)
323+ | otherwise = Nothing
324+ where bothHex = isHexDigit hi && isHexDigit lo
325+ octet = fromIntegral (16 * digitToInt hi + digitToInt lo)
326+ hexByte _ = Nothing
327+
328+-- | Convert a UUID into a hypenated string using lower-case letters.
329+-- Example:
330+--
331+-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
332+-- Just "550e8400-e29b-41d4-a716-446655440000"
333+--
334+--
335+toString :: UUID -> String
336+toString uuid = hexw0 w0 $ hexw1 w1 ""
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
340+ : '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
341+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
342+ : s
343+
344+ hexw1 :: Word64 -> String -> String
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
348+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
349+ : s
350+
351+ hexn :: Word64 -> Int -> Char
352+ hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
353+
354+ (w0,w1) = toWords64 uuid
355+
356+-- | If the passed in `Text` can be parsed as an ASCII representation of
357+-- a `UUID`, it will be. The hyphens may not be omitted.
358+fromText :: Text -> Maybe UUID
359+fromText = fromASCIIBytes . T.encodeUtf8
360+
361+-- | Convert a UUID into a hyphentated string using lower-case letters.
362+toText :: UUID -> Text
363+toText = T.decodeLatin1 . toASCIIBytes
364+
365+-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366+-- as ASCII bytes into `B.ByteString`.
367+--
368+-- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
369+toASCIIBytes :: UUID -> B.ByteString
370+toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
371+
372+-- | Helper function for `toASCIIBytes`
373+pokeASCII :: UUID -> Ptr Word8 -> IO ()
374+pokeASCII uuid ptr = do
375+ pokeDash 8
376+ pokeDash 13
377+ pokeDash 18
378+ pokeDash 23
379+ pokeSingle 0 w0
380+ pokeDouble 9 w1
381+ pokeDouble 19 w2
382+ pokeSingle 28 w3
383+ where
384+ (w0, w1, w2, w3) = toWords uuid
385+
386+ -- ord '-' ==> 45
387+ pokeDash ix = pokeElemOff ptr ix 45
388+
389+ pokeSingle ix w = do
390+ pokeWord ix w 28
391+ pokeWord (ix + 1) w 24
392+ pokeWord (ix + 2) w 20
393+ pokeWord (ix + 3) w 16
394+ pokeWord (ix + 4) w 12
395+ pokeWord (ix + 5) w 8
396+ pokeWord (ix + 6) w 4
397+ pokeWord (ix + 7) w 0
398+
399+ -- We skip the dash in the middle
400+ pokeDouble ix w = do
401+ pokeWord ix w 28
402+ pokeWord (ix + 1) w 24
403+ pokeWord (ix + 2) w 20
404+ pokeWord (ix + 3) w 16
405+ pokeWord (ix + 5) w 12
406+ pokeWord (ix + 6) w 8
407+ pokeWord (ix + 7) w 4
408+ pokeWord (ix + 8) w 0
409+
410+ pokeWord ix w r =
411+ pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
412+
413+ toDigit :: Word32 -> Word32
414+ toDigit w = if w < 10 then 48 + w else 97 + w - 10
415+
416+-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
417+-- a `UUID`, it will be. The hyphens may not be omitted.
418+--
419+-- This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.
420+fromASCIIBytes :: B.ByteString -> Maybe UUID
421+fromASCIIBytes bs = do
422+ guard wellFormed
423+ fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
424+ where
425+ -- ord '-' ==> 45
426+ dashIx bs' ix = BU.unsafeIndex bs' ix == 45
427+
428+ -- Important: check the length first, given the `unsafeIndex` later.
429+ wellFormed =
430+ B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
431+ dashIx bs 18 && dashIx bs 23
432+
433+ single ix = combine <$> octet ix <*> octet (ix + 2)
434+ <*> octet (ix + 4) <*> octet (ix + 6)
435+ double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
436+ <*> octet ix1 <*> octet (ix1 + 2)
437+
438+ combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
439+
440+ octet ix = do
441+ hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
442+ lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
443+ return (16 * hi + lo)
444+
445+ toDigit :: Word8 -> Maybe Word8
446+ toDigit w
447+ -- Digit
448+ | w >= 48 && w <= 57 = Just (w - 48)
449+ -- Uppercase
450+ | w >= 65 && w <= 70 = Just (10 + w - 65)
451+ -- Lowercase
452+ | w >= 97 && w <= 102 = Just (10 + w - 97)
453+ | otherwise = Nothing
454+
455+-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456+toLazyASCIIBytes :: UUID -> BL.ByteString
457+toLazyASCIIBytes =
458+ BL.fromStrict
459+ . toASCIIBytes
460+
461+-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462+fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
463+fromLazyASCIIBytes bs =
464+ if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
465+
466+--
467+-- Class Instances
468+--
469+
470+-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471+-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472+instance Random UUID where
473+ random = uniform
474+ randomR _ = random -- range is ignored
475+
476+-- @since 1.0.4
477+instance Uniform UUID where
478+ uniformM gen = do
479+ w0 <- uniformWord64 gen
480+ w1 <- uniformWord64 gen
481+ pure $ buildFromBytes 4 /-/ w0 /-/ w1
482+
483+-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484+-- only returns 31 bits of randomness.
485+type instance ByteSink ThreeByte g = Takes3Bytes g
486+newtype ThreeByte = ThreeByte Int
487+instance ByteSource ThreeByte where
488+ f /-/ (ThreeByte w) = f b1 b2 b3
489+ where b1 = fromIntegral (w `unsafeShiftR` 16)
490+ b2 = fromIntegral (w `unsafeShiftR` 8)
491+ b3 = fromIntegral w
492+
493+instance NFData UUID where
494+ rnf = flip seq ()
495+
496+instance Hashable UUID where
497+ hash (toWords -> (w0,w1,w2,w3)) =
498+ hash w0 `hashWithSalt` w1
499+ `hashWithSalt` w2
500+ `hashWithSalt` w3
501+ hashWithSalt s (toWords -> (w0,w1,w2,w3)) =
502+ s `hashWithSalt` w0
503+ `hashWithSalt` w1
504+ `hashWithSalt` w2
505+ `hashWithSalt` w3
506+
507+-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
508+--
509+-- >>> show nil
510+-- "00000000-0000-0000-0000-000000000000"
511+--
512+instance Show UUID where
513+ show = toString
514+
515+instance Read UUID where
516+ readsPrec _ str =
517+ let noSpaces = dropWhile isSpace str
518+ in case fromString (take 36 noSpaces) of
519+ Nothing -> []
520+ Just u -> [(u,drop 36 noSpaces)]
521+
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__.
523+instance Storable UUID where
524+ sizeOf _ = 16
525+ alignment _ = 4
526+
527+ peekByteOff p off =
528+ pack <$>
529+ (UnpackedUUID
530+ <$> peekByteOff p off -- Word32
531+ <*> peekByteOff p (off+4) -- Word16
532+ <*> peekByteOff p (off+6) -- Word16
533+ <*> peekByteOff p (off+8) -- Word8
534+ <*> peekByteOff p (off+9) -- Word8
535+ <*> peekByteOff p (off+10) -- Word8
536+ <*> peekByteOff p (off+11) -- Word8
537+ <*> peekByteOff p (off+12) -- Word8
538+ <*> peekByteOff p (off+13) -- Word8
539+ <*> peekByteOff p (off+14) -- Word8
540+ <*> peekByteOff p (off+15) -- Word8
541+ )
542+
543+ pokeByteOff p off u =
544+ case unpack u of
545+ (UnpackedUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) ->
546+ do
547+ pokeByteOff p off x0
548+ pokeByteOff p (off+4) x1
549+ pokeByteOff p (off+6) x2
550+ pokeByteOff p (off+8) x3
551+ pokeByteOff p (off+9) x4
552+ pokeByteOff p (off+10) x5
553+ pokeByteOff p (off+11) x6
554+ pokeByteOff p (off+12) x7
555+ pokeByteOff p (off+13) x8
556+ pokeByteOff p (off+14) x9
557+ pokeByteOff p (off+15) x10
558+
559+-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
560+instance Binary UUID where
561+ put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
562+ get = liftM2 UUID getWord64be getWord64be
563+
564+
565+-- My goal with this instance was to make it work just enough to do what
566+-- I want when used with the HStringTemplate library.
567+instance Data UUID where
568+ toConstr uu = mkConstr uuidType (show uu) [] (error "fixity")
569+ gunfold _ _ = error "gunfold"
570+ dataTypeOf _ = uuidType
571+
572+uuidType :: DataType
573+uuidType = mkNoRepType "Data.UUID.Types.UUID"
574+
575+deriving instance Lift UUID