@@ -233,7 +233,7 @@ fromString' s0 = do
233233-- Example:
234234--
235235-- @
236−-- toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\"
236+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
237237-- @
238238toString :: UUID -> String
239239toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
@@ -248,6 +248,104 @@ toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
248248 hexn :: Word32 -> Int -> Char
249249 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
250250
251+-- | Convert a UUID into a hyphentated string using lower-case letters, packed
252+-- as ASCII bytes into `B.ByteString`.
253+--
254+-- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
255+toASCIIBytes :: UUID -> B.ByteString
256+toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
257+
258+-- | Helper function for `toASCIIBytes`
259+pokeASCII :: UUID -> Ptr Word8 -> IO ()
260+pokeASCII uuid ptr = do
261+ pokeDash 8
262+ pokeDash 13
263+ pokeDash 18
264+ pokeDash 23
265+ pokeSingle 0 w0
266+ pokeDouble 9 w1
267+ pokeDouble 19 w2
268+ pokeSingle 28 w3
269+ where
270+ (w0, w1, w2, w3) = toWords uuid
271+
272+ -- ord '-' ==> 45
273+ pokeDash ix = pokeElemOff ptr ix 45
274+
275+ pokeSingle ix w = do
276+ pokeWord ix w 28
277+ pokeWord (ix + 1) w 24
278+ pokeWord (ix + 2) w 20
279+ pokeWord (ix + 3) w 16
280+ pokeWord (ix + 4) w 12
281+ pokeWord (ix + 5) w 8
282+ pokeWord (ix + 6) w 4
283+ pokeWord (ix + 7) w 0
284+
285+ -- We skip the dash in the middle
286+ pokeDouble ix w = do
287+ pokeWord ix w 28
288+ pokeWord (ix + 1) w 24
289+ pokeWord (ix + 2) w 20
290+ pokeWord (ix + 3) w 16
291+ pokeWord (ix + 5) w 12
292+ pokeWord (ix + 6) w 8
293+ pokeWord (ix + 7) w 4
294+ pokeWord (ix + 8) w 0
295+
296+ pokeWord ix w r =
297+ pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
298+
299+ toDigit :: Word32 -> Word32
300+ toDigit w = if w < 10 then 48 + w else 97 + w - 10
301+
302+-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
303+-- a `UUID`, it will be. The hyphens may not be omitted.
304+--
305+-- This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.
306+fromASCIIBytes :: B.ByteString -> Maybe UUID
307+fromASCIIBytes bs = do
308+ guard wellFormed
309+ fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
310+ where
311+ -- ord '-' ==> 45
312+ dashIx bs' ix = BU.unsafeIndex bs' ix == 45
313+
314+ -- Important: check the length first, given the `unsafeIndex` later.
315+ wellFormed =
316+ B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
317+ dashIx bs 18 && dashIx bs 23
318+
319+ single ix = combine <$> octet ix <*> octet (ix + 2)
320+ <*> octet (ix + 4) <*> octet (ix + 6)
321+ double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
322+ <*> octet ix1 <*> octet (ix1 + 2)
323+
324+ combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
325+
326+ octet ix = do
327+ hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
328+ lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
329+ return (16 * hi + lo)
330+
331+ toDigit :: Word8 -> Maybe Word8
332+ toDigit w
333+ -- Digit
334+ | w >= 48 && w <= 57 = Just (w - 48)
335+ -- Uppercase
336+ | w >= 65 && w <= 70 = Just (10 + w - 65)
337+ -- Lowercase
338+ | w >= 97 && w <= 102 = Just (10 + w - 97)
339+ | otherwise = Nothing
340+
341+-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
342+toLazyASCIIBytes :: UUID -> BL.ByteString
343+toLazyASCIIBytes = BL.fromStrict . toASCIIBytes
344+
345+-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
346+fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
347+fromLazyASCIIBytes bs =
348+ if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
251349
252350--
253351-- Class Instances
@@ -285,6 +383,9 @@ instance ByteSource ThreeByte where
285383 b2 = fromIntegral (w `shiftR` 8)
286384 b3 = fromIntegral w
287385
386+instance NFData UUID where
387+ rnf = rnf . toWords
388+
288389instance Hashable UUID where
289390 hash (UUID w0 w1 w2 w3) =
290391 hash w0 `hashWithSalt` w1
@@ -339,93 +440,3 @@ mkNoRepType :: String -> DataType
339440mkNoRepType = mkNorepType
340441#endif
341442
342−fromASCIIBytes :: B.ByteString -> Maybe UUID
343−fromASCIIBytes bs = do
344− guard wellFormed
345− fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
346− where
347− -- ord '-' ==> 45
348− dashIx bs' ix = BU.unsafeIndex bs' ix == 45
349−
350− -- Important: check the length first, given the `unsafeIndex` later.
351− wellFormed =
352− B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
353− dashIx bs 18 && dashIx bs 23
354−
355− single ix = combine <$> octet ix <*> octet (ix + 2)
356− <*> octet (ix + 4) <*> octet (ix + 6)
357− double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
358− <*> octet ix1 <*> octet (ix1 + 2)
359−
360− combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
361−
362− octet ix = do
363− hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
364− lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
365− return (16 * hi + lo)
366−
367− toDigit :: Word8 -> Maybe Word8
368− toDigit w
369− -- Digit
370− | w >= 48 && w <= 57 = Just (w - 48)
371− -- Uppercase
372− | w >= 65 && w <= 70 = Just (10 + w - 65)
373− -- Lowercase
374− | w >= 97 && w <= 102 = Just (10 + w - 97)
375− | otherwise = Nothing
376−
377−toASCIIBytes :: UUID -> B.ByteString
378−toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
379−
380−pokeASCII :: UUID -> Ptr Word8 -> IO ()
381−pokeASCII uuid ptr = do
382− pokeDash 8
383− pokeDash 13
384− pokeDash 18
385− pokeDash 23
386− pokeSingle 0 w0
387− pokeDouble 9 w1
388− pokeDouble 19 w2
389− pokeSingle 28 w3
390− where
391− (w0, w1, w2, w3) = toWords uuid
392−
393− -- ord '-' ==> 45
394− pokeDash ix = pokeElemOff ptr ix 45
395−
396− pokeSingle ix w = do
397− pokeWord ix w 28
398− pokeWord (ix + 1) w 24
399− pokeWord (ix + 2) w 20
400− pokeWord (ix + 3) w 16
401− pokeWord (ix + 4) w 12
402− pokeWord (ix + 5) w 8
403− pokeWord (ix + 6) w 4
404− pokeWord (ix + 7) w 0
405−
406− -- We skip the dash in the middle
407− pokeDouble ix w = do
408− pokeWord ix w 28
409− pokeWord (ix + 1) w 24
410− pokeWord (ix + 2) w 20
411− pokeWord (ix + 3) w 16
412− pokeWord (ix + 5) w 12
413− pokeWord (ix + 6) w 8
414− pokeWord (ix + 7) w 4
415− pokeWord (ix + 8) w 0
416−
417− pokeWord ix w r =
418− pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
419−
420− toDigit :: Word32 -> Word32
421− toDigit w = if w < 10 then 48 + w else 97 + w - 10
422−
423−fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
424−fromLazyASCIIBytes bs =
425− if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
426−
427−toLazyASCIIBytes :: UUID -> BL.ByteString
428−toLazyASCIIBytes = BL.fromStrict . toASCIIBytes
429−
430−instance NFData UUID where
431− rnf = rnf . toWords