@@ -2,9 +2,6 @@
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE ViewPatterns #-}
4{-# LANGUAGE ViewPatterns #-}
5−{-# LANGUAGE Unsafe #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE StandaloneDeriving #-}
8{-# OPTIONS_HADDOCK hide #-}
5{-# OPTIONS_HADDOCK hide #-}
@@ -46,11 +43,13 @@ module Data.UUID.Types.Internal
47import Prelude hiding (null)
44import Prelude hiding (null)
46+import Control.Applicative ((<*>))
49import Control.DeepSeq (NFData (..))
47import Control.DeepSeq (NFData (..))
50import Control.Monad (guard, liftM2)
48import Control.Monad (guard, liftM2)
51import Data.Bits
49import Data.Bits
52import Data.Char
50import Data.Char
53import Data.Data
51import Data.Data
52+import Data.Functor ((<$>))
54import Data.Hashable
53import Data.Hashable
55import Data.List (elemIndices)
54import Data.List (elemIndices)
56import Foreign.Ptr (Ptr)
55import Foreign.Ptr (Ptr)
@@ -65,19 +64,17 @@ import qualified Data.ByteString.Internal as BI
65import qualified Data.ByteString.Lazy as BL
64import qualified Data.ByteString.Lazy as BL
66import qualified Data.ByteString.Unsafe as BU
65import qualified Data.ByteString.Unsafe as BU
67import Data.Text (Text)
66import Data.Text (Text)
68−import qualified Data.Text.Encoding as T
67+import qualified Data.Text as T
70import Data.UUID.Types.Internal.Builder
69import Data.UUID.Types.Internal.Builder
72−import System.Random (Random (..), uniform)
71+import System.Random
73−import System.Random.Stateful (Uniform (..), uniformWord64)
75−import Language.Haskell.TH.Syntax (Lift)
77-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
74-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
78-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
75-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
79data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
76data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80− deriving (Eq, Ord)
77+ deriving (Eq, Ord, Typeable)
82 Prior to uuid-types-1.0.4:
79 Prior to uuid-types-1.0.4:
83 !Word32 !Word32 !Word32 !Word32
80 !Word32 !Word32 !Word32 !Word32
@@ -333,34 +330,28 @@ fromString' s0 = do
335toString :: UUID -> String
332toString :: UUID -> String
336−toString uuid = hexw0 w0 $ hexw1 w1 ""
333+toString uuid = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
337− where hexw0 :: Word64 -> String -> String
334+ where hexw :: Word32 -> 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
335+ hexw w s = 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
336+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
344− hexw1 :: Word64 -> String -> String
338+ hexw' :: Word32 -> String -> String
345− hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
339+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
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
340+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
351− hexn :: Word64 -> Int -> Char
342+ hexn :: Word32 -> Int -> Char
352 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
343 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
354− (w0,w1) = toWords64 uuid
345+ (w0,w1,w2,w3) = toWords uuid
356-- | If the passed in `Text` can be parsed as an ASCII representation of
347-- | 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.
348-- a `UUID`, it will be. The hyphens may not be omitted.
358fromText :: Text -> Maybe UUID
349fromText :: Text -> Maybe UUID
359−fromText = fromASCIIBytes . T.encodeUtf8
350+fromText = fromString . T.unpack
361-- | Convert a UUID into a hyphentated string using lower-case letters.
352-- | Convert a UUID into a hyphentated string using lower-case letters.
362toText :: UUID -> Text
353toText :: UUID -> Text
363−toText = T.decodeLatin1 . toASCIIBytes
354+toText = T.pack . toString
365-- | Convert a UUID into a hyphentated string using lower-case letters, packed
356-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366-- as ASCII bytes into `B.ByteString`.
357-- as ASCII bytes into `B.ByteString`.
@@ -455,13 +446,23 @@ fromASCIIBytes bs = do
455-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
446-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456toLazyASCIIBytes :: UUID -> BL.ByteString
447toLazyASCIIBytes :: UUID -> BL.ByteString
457toLazyASCIIBytes =
448toLazyASCIIBytes =
449+#if MIN_VERSION_bytestring(0,10,0)
458 BL.fromStrict
450 BL.fromStrict
452+ BL.fromChunks . return
459 . toASCIIBytes
454 . toASCIIBytes
461-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
456-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
457fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
463fromLazyASCIIBytes bs =
458fromLazyASCIIBytes bs =
464− if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
459+ if BL.length bs == 36 then fromASCIIBytes (
460+#if MIN_VERSION_bytestring(0,10,0)
463+ B.concat $ BL.toChunks bs
467-- Class Instances
468-- Class Instances
@@ -470,15 +471,26 @@ fromLazyASCIIBytes bs =
470-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472instance Random UUID where
473instance Random UUID where
473− random = uniform
474+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)
475+ where (w0, g0) = next g
474 randomR _ = random -- range is ignored
480 randomR _ = random -- range is ignored
476−-- @since 1.0.4
482+-- |Build a UUID from the results of five calls to next on a StdGen.
477−instance Uniform UUID where
483+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
478− uniformM gen = do
484+-- randomness. This code relies on at last 28 bits of randomness in the
479− w0 <- uniformWord64 gen
485+-- and optimizes its use so as to make only five random values, not six.
480− w1 <- uniformWord64 gen
486+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
487+fromGenNext w0 w1 w2 w3 w4 =
481− pure $ buildFromBytes 4 /-/ w0 /-/ w1
488+ buildFromBytes 4 /-/ (ThreeByte w0)
490+ /-/ w2 -- use all 4 bytes because we know the version
491+ -- field will "cover" the upper, non-random bits
483-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
495-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484-- only returns 31 bits of randomness.
496-- only returns 31 bits of randomness.
@@ -572,4 +584,10 @@ instance Data UUID where
572uuidType :: DataType
584uuidType :: DataType
573uuidType = mkNoRepType "Data.UUID.Types.UUID"
585uuidType = mkNoRepType "Data.UUID.Types.UUID"
575−deriving instance Lift UUID
587+#if !MIN_VERSION_base(4,5,0)
588+unsafeShiftR, unsafeShiftL :: Bits w => w -> Int -> w
589+{-# INLINE unsafeShiftR #-}
590+unsafeShiftR = shiftR
591+{-# INLINE unsafeShiftL #-}
592+unsafeShiftL = shiftL