34a40da · typeable/uuid

git.iko.soy/typeable/uuid

on master help sign in

Use more compact internal representation (re #24)

34a40daHerbert Valerio Riedel10 years ago

uuid-types/Data/UUID/Types/Internal.hs+42−33

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}

1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP, ViewPatterns #-}

2{-# OPTIONS_HADDOCK hide #-}

4-- |

@@ -40,7 +40,7 @@ import Prelude hiding (null)

41import Control.Applicative ((<*>))

42import Control.DeepSeq (NFData(..))

43−import Control.Monad (liftM4, guard)

43+import Control.Monad (liftM2, guard)

44import Data.Functor ((<$>))

45import Data.Char

46import Data.Bits

@@ -77,12 +77,12 @@ import System.Random

77-- network order as 16 bytes.

78data UUID

79 = UUID

80− {-# UNPACK #-} !Word32

80+ {-# UNPACK #-} !Word64

81− {-# UNPACK #-} !Word32

81+ {-# UNPACK #-} !Word64

82− {-# UNPACK #-} !Word32

83− {-# UNPACK #-} !Word32

84 deriving (Eq, Ord, Typeable)

82 deriving (Eq, Ord, Typeable)

85{-

83{-

84+ Prior to uuid-types-1.0.4:

85+ !Word32 !Word32 !Word32 !Word32

86 Other representations that we tried are:

87 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16

88 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8

@@ -99,14 +99,19 @@ data UUID

99-- neither 'Storable' nor 'Binary' are appropriate.

100-- Introduced in version 1.2.2.

101toWords :: UUID -> (Word32, Word32, Word32, Word32)

102−toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)

102+toWords (UUID w12 w34) = (w1, w2, w3, w4)

103+ where

104+ w1 = fromIntegral (w12 `unsafeShiftR` 32)

105+ w2 = fromIntegral w12

106+ w3 = fromIntegral (w34 `unsafeShiftR` 32)

107+ w4 = fromIntegral w34

103

108

104-- | Create a 'UUID' from a sequence of 'Word32'. The

109-- | Create a 'UUID' from a sequence of 'Word32'. The

105-- opposite of 'toWords'. Useful when you need a total

110-- opposite of 'toWords'. Useful when you need a total

106-- function for constructing 'UUID' values.

111-- function for constructing 'UUID' values.

107-- Introduced in version 1.2.2.

112-- Introduced in version 1.2.2.

108fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

113fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

109−fromWords = UUID

114+fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)

110

115

111data UnpackedUUID =

116data UnpackedUUID =

112 UnpackedUUID {

117 UnpackedUUID {

@@ -125,9 +130,7 @@ data UnpackedUUID =

125 deriving (Read, Show, Eq, Ord)

130 deriving (Read, Show, Eq, Ord)

126

131

127unpack :: UUID -> UnpackedUUID

132unpack :: UUID -> UnpackedUUID

128−unpack (UUID w0 w1 w2 w3) =

133+unpack (UUID w0 w1) = build /-/ w0 /-/ w1

129− build /-/ w0 /-/ w1 /-/ w2 /-/ w3

130−

131 where

134 where

132 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =

135 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =

133 UnpackedUUID {

136 UnpackedUUID {

@@ -167,8 +170,8 @@ word a b c d = (fromIntegral a `shiftL` 24)

167 .|. (fromIntegral c `shiftL` 8)

170 .|. (fromIntegral c `shiftL` 8)

168 .|. (fromIntegral d )

171 .|. (fromIntegral d )

169

172

170−-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,

173+-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,

171−byte :: Int -> Word32 -> Word8

174+byte :: Int -> Word64 -> Word8

172byte i w = fromIntegral (w `shiftR` (i * 8))

175byte i w = fromIntegral (w `shiftR` (i * 8))

173

176

174-- |Build a Word16 from two Word8 values, presented in big-endian order.

177-- |Build a Word16 from two Word8 values, presented in big-endian order.

@@ -179,6 +182,9 @@ w8to16 w0s w1s =

179 w0 = fromIntegral w0s

182 w0 = fromIntegral w0s

180 w1 = fromIntegral w1s

183 w1 = fromIntegral w1s

181

184

185+-- | Construct 'Word64' from low/high 'Word32's

186+w32to64 :: Word32 -> Word32 -> Word64

187+w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)

182

188

183-- |Make a UUID from sixteen Word8 values

189-- |Make a UUID from sixteen Word8 values

184makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

190makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

@@ -187,16 +193,12 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

187 -> Word8 -> Word8 -> Word8 -> Word8

193 -> Word8 -> Word8 -> Word8 -> Word8

188 -> UUID

194 -> UUID

189makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf

195makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf

190− = UUID w0 w1 w2 w3

196+ = fromWords w0 w1 w2 w3

191 where w0 = word b0 b1 b2 b3

197 where w0 = word b0 b1 b2 b3

192 w1 = word b4 b5 b6 b7

198 w1 = word b4 b5 b6 b7

193 w2 = word b8 b9 ba bb

199 w2 = word b8 b9 ba bb

194 w3 = word bc bd be bf

200 w3 = word bc bd be bf

195

201

196−-- |Make a UUID from four Word32 values

197−makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

198−makeFromWords = UUID

199−

200-- |A Builder for constructing a UUID of a given version.

202-- |A Builder for constructing a UUID of a given version.

201buildFromBytes :: Word8

203buildFromBytes :: Word8

202 -> Word8 -> Word8 -> Word8 -> Word8

204 -> Word8 -> Word8 -> Word8 -> Word8

@@ -211,18 +213,18 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =

211

213

212-- |Build a UUID of a given version from Word32 values.

214-- |Build a UUID of a given version from Word32 values.

213buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID

215buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID

214−buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3

216+buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3

215 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)

217 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)

216 w2' = w2 .&. 0x3fffffff .|. 0x80000000

218 w2' = w2 .&. 0x3fffffff .|. 0x80000000

217

219

218

220

219-- |Return the bytes that make up the UUID

221-- |Return the bytes that make up the UUID

220toList :: UUID -> [Word8]

222toList :: UUID -> [Word8]

221−toList (UUID w0 w1 w2 w3) =

223+toList (UUID w0 w1) =

222− [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,

224+ [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,

223− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,

225+ byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,

224− byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,

226+ byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,

225− byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]

227+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]

226

228

227-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't

229-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't

228-- exactly sixteen bytes long

230-- exactly sixteen bytes long

@@ -246,7 +248,7 @@ null = (== nil)

246-- |The nil UUID, as defined in RFC 4122.

248-- |The nil UUID, as defined in RFC 4122.

247-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.

249-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.

248nil :: UUID

250nil :: UUID

249−nil = UUID 0 0 0 0

251+nil = UUID 0 0

250

252

251-- |Extract a UUID from a 'ByteString' in network byte order.

253-- |Extract a UUID from a 'ByteString' in network byte order.

252-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.

254-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.

@@ -278,7 +280,7 @@ fromString' s0 = do

278 (w2, s3) <- hexWord s2

280 (w2, s3) <- hexWord s2

279 (w3, s4) <- hexWord s3

281 (w3, s4) <- hexWord s3

280 if s4 /= "" then Nothing

282 if s4 /= "" then Nothing

281− else Just $ UUID w0 w1 w2 w3

283+ else Just $ fromWords w0 w1 w2 w3

282 where hexWord :: String -> Maybe (Word32, String)

284 where hexWord :: String -> Maybe (Word32, String)

283 hexWord s = Just (0, s) >>= hexByte >>= hexByte

285 hexWord s = Just (0, s) >>= hexByte >>= hexByte

284 >>= hexByte >>= hexByte

286 >>= hexByte >>= hexByte

@@ -299,7 +301,7 @@ fromString' s0 = do

299-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"

301-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"

300-- @

302-- @

301toString :: UUID -> String

303toString :: UUID -> String

302−toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""

304+toString uuid = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""

303 where hexw :: Word32 -> String -> String

305 where hexw :: Word32 -> String -> String

304 hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

306 hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

305 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s

307 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s

@@ -311,6 +313,8 @@ toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""

311 hexn :: Word32 -> Int -> Char

313 hexn :: Word32 -> Int -> Char

312 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)

314 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)

313

315

316+ (w0,w1,w2,w3) = toWords uuid

317+

314-- | If the passed in `Text` can be parsed as an ASCII representation of

318-- | If the passed in `Text` can be parsed as an ASCII representation of

315-- a `UUID`, it will be. The hyphens may not be omitted.

319-- a `UUID`, it will be. The hyphens may not be omitted.

316fromText :: Text -> Maybe UUID

320fromText :: Text -> Maybe UUID

@@ -468,14 +472,14 @@ instance ByteSource ThreeByte where

468 b3 = fromIntegral w

472 b3 = fromIntegral w

469

473

470instance NFData UUID where

474instance NFData UUID where

471− rnf = rnf . toWords

475+ rnf = flip seq ()

472

476

473instance Hashable UUID where

477instance Hashable UUID where

474− hash (UUID w0 w1 w2 w3) =

478+ hash (toWords -> (w0,w1,w2,w3)) =

475 hash w0 `hashWithSalt` w1

479 hash w0 `hashWithSalt` w1

476 `hashWithSalt` w2

480 `hashWithSalt` w2

477 `hashWithSalt` w3

481 `hashWithSalt` w3

478− hashWithSalt s (UUID w0 w1 w2 w3) =

482+ hashWithSalt s (toWords -> (w0,w1,w2,w3)) =

479 s `hashWithSalt` w0

483 s `hashWithSalt` w0

480 `hashWithSalt` w1

484 `hashWithSalt` w1

481 `hashWithSalt` w2

485 `hashWithSalt` w2

@@ -529,9 +533,8 @@ instance Storable UUID where

529 pokeByteOff p (off+15) x10

533 pokeByteOff p (off+15) x10

530

534

531instance Binary UUID where

535instance Binary UUID where

532− put (UUID w0 w1 w2 w3) =

536+ put (UUID w0 w1) = putWord64be w0 >> putWord64be w1

533− putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3

537+ get = liftM2 UUID getWord64be getWord64be

534− get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be

535

538

536

539

537-- My goal with this instance was to make it work just enough to do what

540-- My goal with this instance was to make it work just enough to do what

@@ -548,3 +551,9 @@ uuidType = mkNoRepType "Data.UUID.Types.UUID"

548mkNoRepType :: String -> DataType

551mkNoRepType :: String -> DataType

549mkNoRepType = mkNorepType

552mkNoRepType = mkNorepType

550#endif

553#endif

554+

555+#if !MIN_VERSION_base(4,5,0)

556+unsafeShiftR, unsafeShiftL :: Word64 -> Int -> Word64

557+unsafeShiftR = shiftR

558+unsafeShiftL = shiftL

559+#endif

uuid-types/Data/UUID/Types/Internal/Builder.hs+13

@@ -47,6 +47,7 @@ type Takes1Byte g = Word8 -> g

47type Takes2Bytes g = Word8 -> Word8 -> g

48type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g

49type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g

50+type Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> g

51-- | Type of function that a given ByteSource needs.

52-- | Type of function that a given ByteSource needs.

52-- This function must take as many Word8 arguments as the ByteSource provides

53-- This function must take as many Word8 arguments as the ByteSource provides

@@ -54,6 +55,7 @@ type family ByteSink w g

54type instance ByteSink Word8 g = Takes1Byte g

55type instance ByteSink Word8 g = Takes1Byte g

55type instance ByteSink Word16 g = Takes2Bytes g

56type instance ByteSink Word16 g = Takes2Bytes g

56type instance ByteSink Word32 g = Takes4Bytes g

57type instance ByteSink Word32 g = Takes4Bytes g

58+type instance ByteSink Word64 g = Takes8Bytes g

57type instance ByteSink Int g = Takes4Bytes g

59type instance ByteSink Int g = Takes4Bytes g

@@ -81,6 +83,17 @@ instance ByteSource Word32 where

81 b3 = fromIntegral (w `shiftR` 8)

83 b3 = fromIntegral (w `shiftR` 8)

82 b4 = fromIntegral w

84 b4 = fromIntegral w

86+instance ByteSource Word64 where

87+ f /-/ w = f b1 b2 b3 b4 b5 b6 b7 b8

88+ where b1 = fromIntegral (w `shiftR` 56)

89+ b2 = fromIntegral (w `shiftR` 48)

90+ b3 = fromIntegral (w `shiftR` 40)

91+ b4 = fromIntegral (w `shiftR` 32)

92+ b5 = fromIntegral (w `shiftR` 24)

93+ b6 = fromIntegral (w `shiftR` 16)

94+ b7 = fromIntegral (w `shiftR` 8)

95+ b8 = fromIntegral w

96+

84instance ByteSource Int where

97instance ByteSource Int where

85 f /-/ w = f b1 b2 b3 b4

98 f /-/ w = f b1 b2 b3 b4

86 where b1 = fromIntegral (w `shiftR` 24)

99 where b1 = fromIntegral (w `shiftR` 24)