@@ -24,16 +24,24 @@ module Data.UUID.Internal
2424 ,toList
2525 ,buildFromBytes
2626 ,buildFromWords
27+ ,fromASCIIBytes
28+ ,toASCIIBytes
29+ ,fromLazyASCIIBytes
30+ ,toLazyASCIIBytes
2731 ) where
2832
2933import Prelude hiding (null)
3034
31−import Control.Monad (liftM4)
35+import Control.Applicative ((<*>))
36+import Control.DeepSeq (NFData(..))
37+import Control.Monad (liftM4, guard)
38+import Data.Functor ((<$>))
3239import Data.Char
3340import Data.Bits
3441import Data.Hashable
3542import Data.Maybe
3643import Data.List (elemIndices)
44+import Foreign.Ptr (Ptr)
3745
3846#if MIN_VERSION_base(4,0,0)
3947import Data.Data
@@ -46,7 +54,10 @@ import Foreign.Storable
4654import Data.Binary
4755import Data.Binary.Put
4856import Data.Binary.Get
49−import qualified Data.ByteString.Lazy as Lazy
57+import qualified Data.ByteString as B
58+import qualified Data.ByteString.Internal as BI
59+import qualified Data.ByteString.Lazy as BL
60+import qualified Data.ByteString.Unsafe as BU
5061
5162import Data.UUID.Builder
5263
@@ -176,12 +187,12 @@ nil = UUID 0 0 0 0
176187
177188-- |Extract a UUID from a 'ByteString' in network byte order.
178189-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
179−fromByteString :: Lazy.ByteString -> Maybe UUID
180−fromByteString = fromList . Lazy.unpack
190+fromByteString :: BL.ByteString -> Maybe UUID
191+fromByteString = fromList . BL.unpack
181192
182193-- |Encode a UUID into a 'ByteString' in network order.
183−toByteString :: UUID -> Lazy.ByteString
184−toByteString = Lazy.pack . toList
194+toByteString :: UUID -> BL.ByteString
195+toByteString = BL.pack . toList
185196
186197-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
187198-- The hyphens may not be omitted.
@@ -328,3 +339,93 @@ mkNoRepType :: String -> DataType
328339mkNoRepType = mkNorepType
329340#endif
330341
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