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