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