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