uuid 1.2.3 → 1.2.4
raw patch · 5 files changed
+313/−7 lines, 5 filesdep ~QuickCheckdep ~criteriondep ~deepseq
Dependency ranges changed: QuickCheck, criterion, deepseq
Files
- CHANGES +4/−0
- Data/UUID/Internal.hs +7/−2
- tests/BenchUUID.hs +125/−0
- tests/TestUUID.hs +168/−0
- uuid.cabal +9/−5
CHANGES view
@@ -1,3 +1,7 @@+1.2.4++- Unpack Word32 values into UUID constructor.+ 1.2.3 - The Read instance now drops leading spaces in the string to be parsed.
Data/UUID/Internal.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Data.UUID--- Copyright : (c) 2008-2009 Antoine Latter+-- Copyright : (c) 2008-2009, 2012 Antoine Latter -- (c) 2009 Mark Lentczner -- -- License : BSD-style@@ -55,7 +55,12 @@ -- version 4 UUIDs as specified in RFC 4122. The 'Storable' and -- 'Binary' instances are compatible with RFC 4122, storing the fields -- in network order as 16 bytes.-data UUID = UUID !Word32 !Word32 !Word32 !Word32+data UUID + = UUID+ {-# UNPACK #-} !Word32+ {-# UNPACK #-} !Word32+ {-# UNPACK #-} !Word32+ {-# UNPACK #-} !Word32 deriving (Eq, Ord, Typeable) {- Other representations that we tried are:
+ tests/BenchUUID.hs view
@@ -0,0 +1,125 @@+import Control.DeepSeq+import Criterion.Main+import Data.Char (ord)+import Data.IORef+import Data.Maybe (fromJust)+import Data.Word+import qualified Data.Set as Set+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Internal as BL+import qualified Data.UUID as U+import qualified Data.UUID.V1 as U+import qualified Data.UUID.V3 as U3+import qualified Data.UUID.V5 as U5+import System.Random+import System.Random.Mersenne.Pure64++instance NFData BL.ByteString where+ rnf BL.Empty = ()+ rnf (BL.Chunk _ ts) = rnf ts++instance NFData U.UUID where+++main :: IO ()+main = do+ u1 <- randomIO+ let s1 = U.toString u1+ b1 = U.toByteString u1+ n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]+ nil2 = fromJust $+ U.fromString "00000000-0000-0000-0000-000000000000"+ u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"+ u2b = fromJust $ U.fromByteString $+ BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,+ 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]+ u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"++ -- setup for random generation+ randomState <- newPureMT >>= newIORef+ let randomUUID = do+ state <- readIORef randomState+ let (uuid, state') = random state+ writeIORef randomState state'+ return uuid++ defaultMain [+ bgroup "testing" [+ bench "null non-nil" $ whnf U.null u1,+ bench "null nil" $ whnf U.null U.nil,+ bench "null nil2" $ whnf U.null nil2,+ bench "eq same" $ whnf (==u2a) u2b,+ bench "eq differ" $ whnf (==u2a) u3+ ],+ bgroup "conversion" [+ bench "toString" $ nf U.toString u1,+ bench "fromString" $ nf U.fromString s1,+ bench "toByteString" $ nf U.toByteString u1,+ bench "fromByteString" $ nf U.fromByteString b1+ ],+ bgroup "generation" [+ bench "V1" $ nfIO U.nextUUID,+ bench "V4" $ nfIO (randomUUID :: IO U.UUID),+ bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,+ bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1+ ],+ bench "set making" $ nf Set.fromList uuids+ ]++-- 50 uuids, so tests can be repeatable+uuids :: [U.UUID]+uuids + = map (fromJust . U.fromString)+ [+ "35d42593-1fca-4465-b588-a2e78cb996ba",+ "1e97e407-eca7-4c5d-a947-6fbe9dc168b6",+ "a41fd7ce-a053-4c0a-a742-77c95b85da2a",+ "f7e3913a-0fd7-4355-a92f-d73f9b046efa",+ "8961a35d-55c2-42f3-8680-08fce3986647",+ "96246c58-d0b4-4e56-a543-356bd59686a9",+ "72c46194-648c-4b1e-a9fb-2eba060ab43b",+ "0fc252d4-a37b-4eca-9309-e3d2a59a3a22",+ "a8aceb5a-6a8e-43f3-85bb-9653a3c1ebcd",+ "b23d1118-6bc8-4add-9d56-99634d78949f",+ "5f8c7896-9c4f-4d7e-a4d2-961bda298012",+ "219a4137-7bc5-42b1-ac95-490948a978e1",+ "5af5024f-fbe9-45ab-991d-49b655994437",+ "569dfb33-185d-4a3c-99c4-bc2b83250a7c",+ "43a58442-aa51-4a5d-8e00-b8a83b5fc5b0",+ "2865ced1-b54d-4725-8f01-b408f4617424",+ "b8cfaff0-4dee-4f32-af2f-0469b3e535fc",+ "63f45bc0-f303-4f1a-b0d6-76f876be626d",+ "d171eaf3-f20d-45d6-9268-0cc22dfbe887",+ "7c28f457-ad27-494a-8642-6e47e7f3efb8",+ "f8de9193-66ff-49e8-9826-fc50858d7855",+ "2af85f28-cace-4740-b8bb-2b5860f5fdb3",+ "b12a7a22-edb3-4694-b8f4-0532eaad6112",+ "5e052a08-8e49-4668-bbe7-77cdbc4679a3",+ "42d5a68d-3f08-4e39-9b8c-71cc17c538ed",+ "ba2b1487-b3a4-4a19-98cc-59530f36613f",+ "e4a5c569-b8ac-4851-8ad2-fbdb89986be2",+ "35b4a1b6-b5ca-4646-803b-c337ee730d9a",+ "f0df1206-05d9-49d6-a726-d49fb253e645",+ "9656a0f0-89b2-4cec-bb1c-fdf5633e1cd7",+ "d13382f5-04a1-422d-94d6-e47219425816",+ "b8d0c762-4c6b-4bd0-ad0b-f68988a87166",+ "06360e85-f18a-44f6-aa72-45f1e60b6b77",+ "347491ca-62b3-48e8-ac94-6ffebe1318ed",+ "014339d0-7b2d-4dda-914b-14ee5cb4391b",+ "dc57931b-4744-41be-b3c4-e24dbeeb606a",+ "2c9fdcf0-e1d6-4a2d-951d-4766b99032cb",+ "b6bde422-eea8-4231-bf1c-ee0e56699511",+ "921073c5-f7c1-4583-ac03-aeb7aef8662b",+ "eff6a517-aeb1-453e-9810-1b4b324c5a1e",+ "eadaae8c-cbf8-4e0b-ab80-e34284b07dad",+ "4d307c36-70d9-453f-8455-ec7e2ba405ed",+ "53ddef9a-2413-4f7f-8363-cff56ee17c6c",+ "4dd4c27a-b300-4a00-ab87-eef505275492",+ "4a5d7001-f0c1-4e2f-8362-8833bda2114b",+ "0c46f438-9365-406a-b04e-34436806ec25",+ "b35469cf-05f8-40ff-a38b-117604347957",+ "f1c54df0-5f59-4891-b3c6-82bac0d814ca",+ "8091837c-6456-42c3-a686-f4731a41d4f9",+ "2a0e2efb-a11c-4a44-81ee-3efc37379b48"+ ]+
+ tests/TestUUID.hs view
@@ -0,0 +1,168 @@+import Control.Monad (replicateM)+import Data.Bits+import qualified Data.ByteString.Lazy as B+import Data.Char (ord)+import Data.List (nub, (\\))+import Data.Maybe+import Data.Word+import qualified Data.UUID as U+import qualified Data.UUID.V1 as U+import qualified Data.UUID.V3 as U3+import qualified Data.UUID.V5 as U5+import Test.HUnit+import Test.QuickCheck hiding ((.&.))+import System.IO+import System.Random+++isValidVersion :: Int -> U.UUID -> Bool+isValidVersion v u = lenOK && variantOK && versionOK+ where bs = U.toByteString u+ lenOK = B.length bs == 16+ variantOK = (B.index bs 8) .&. 0xc0 == 0x80+ versionOK = (B.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)+++instance Arbitrary U.UUID where+ -- the UUID random instance ignores bounds+ arbitrary = choose (U.nil, U.nil)++-- instance Arbitrary Word8 where+-- arbitrary = (fromIntegral . fst . randomR (0,255::Int)) `fmap` rand+++test_null :: Test+test_null = TestList [+ "nil is null" ~: assertBool "" (U.null U.nil),+ "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)+ ]++test_nil :: Test+test_nil = TestList [+ "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",+ "nil bytes" ~: U.toByteString U.nil @?= B.pack (replicate 16 0)+ ]++test_conv :: Test+test_conv = TestList [+ "conv bytes to string" ~:+ maybe "" (U.toString) (U.fromByteString b16) @?= s16,+ "conv string to bytes" ~:+ maybe B.empty (U.toByteString) (U.fromString s16) @?= b16+ ]+ where b16 = B.pack [1..16]+ s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"++test_v1 :: [Maybe U.UUID] -> Test+test_v1 v1s = TestList [+ "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],+ "V1 not null" ~: TestList $ map (testUUID (not . U.null)) v1s,+ "V1 valid" ~: TestList $ map (testUUID (isValidVersion 1)) v1s+ ]+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test+ testUUID p u = maybe False p u ~? show u++test_v3 :: Test+test_v3 = TestList [+ "V3 computation" ~:+ U3.generateNamed U3.namespaceDNS name @?= uV3+ ]+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]+ uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"++test_v5 :: Test+test_v5 = TestList [+ "V5 computation" ~:+ U5.generateNamed U5.namespaceDNS name @?= uV5+ ]+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]+ uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"++prop_stringRoundTrip :: Property+prop_stringRoundTrip = label "String round trip" stringRoundTrip+ where stringRoundTrip :: U.UUID -> Bool+ stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)++prop_byteStringRoundTrip :: Property+prop_byteStringRoundTrip = label "ByteString round trip" byteStringRoundTrip+ where byteStringRoundTrip :: U.UUID -> Bool+ byteStringRoundTrip u = maybe False (== u)+ $ U.fromByteString (U.toByteString u)++prop_stringLength :: Property+prop_stringLength = label "String length" stringLength+ where stringLength :: U.UUID -> Bool+ stringLength u = length (U.toString u) == 36++prop_byteStringLength :: Property+prop_byteStringLength = label "ByteString length" byteStringLength+ where byteStringLength :: U.UUID -> Bool+ byteStringLength u = B.length (U.toByteString u) == 16++prop_randomsDiffer :: Property+prop_randomsDiffer = label "Randoms differ" randomsDiffer+ where randomsDiffer :: (U.UUID, U.UUID) -> Bool+ randomsDiffer (u1, u2) = u1 /= u2++prop_randomNotNull :: Property+prop_randomNotNull = label "Random not null" randomNotNull+ where randomNotNull :: U.UUID -> Bool+ randomNotNull = not. U.null++prop_randomsValid :: Property+prop_randomsValid = label "Random valid" randomsValid+ where randomsValid :: U.UUID -> Bool+ randomsValid = isValidVersion 4++prop_v3NotNull :: Property+prop_v3NotNull = label "V3 not null" v3NotNull+ where v3NotNull :: [Word8] -> Bool+ v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS++prop_v3Valid :: Property+prop_v3Valid = label "V3 valid" v3Valid+ where v3Valid :: [Word8] -> Bool+ v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS++prop_v5NotNull :: Property+prop_v5NotNull = label "V5 not null" v5NotNull+ where v5NotNull :: [Word8] -> Bool+ v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS++prop_v5Valid :: Property+prop_v5Valid = label "V5 valid" v5Valid+ where v5Valid :: [Word8] -> Bool+ v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS++prop_readShowRoundTrip :: Property+prop_readShowRoundTrip = label "Read/Show round-trip" prop+ where -- we're using 'Maybe UUID' to add a bit of+ -- real-world complexity.+ prop :: U.UUID -> Bool+ prop uuid = read (show (Just uuid)) == Just uuid++main :: IO ()+main = do+ v1s <- replicateM 100 U.nextUUID+ runTestText (putTextToHandle stderr False) (TestList [+ test_null,+ test_nil,+ test_conv,+ test_v1 v1s,+ test_v3,+ test_v5+ ])+ mapM_ quickCheck $ [+ prop_stringRoundTrip,+ prop_readShowRoundTrip,+ prop_byteStringRoundTrip,+ prop_stringLength,+ prop_byteStringLength,+ prop_randomsDiffer,+ prop_randomNotNull,+ prop_randomsValid,+ prop_v3NotNull,+ prop_v3Valid,+ prop_v5NotNull,+ prop_v5Valid+ ]
uuid.cabal view
@@ -1,6 +1,6 @@ Name: uuid-Version: 1.2.3-Copyright: (c) 2008-2011 Antoine Latter+Version: 1.2.4+Copyright: (c) 2008-2012 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com License: BSD3@@ -45,6 +45,10 @@ Ghc-Shared-Options: Ghc-Options: -Wall +source-repository head+ type: darcs+ location: http://code.haskell.org/uuid+ -- not strictly a test, but we want it to error if -- it can't build Test-Suite benchmark@@ -52,8 +56,8 @@ Main-is: BenchUUID.hs Hs-source-dirs: tests Extensions: DeriveDataTypeable, CPP- Build-depends: base == 4.*, uuid, random, criterion >= 0.4 && < 0.6, mersenne-random-pure64,- bytestring == 0.9.*, containers == 0.4.*, deepseq == 1.1.*+ Build-depends: base == 4.*, uuid, random, criterion >= 0.4 && < 0.7, mersenne-random-pure64,+ bytestring == 0.9.*, containers == 0.4.*, deepseq >= 1.1 && < 1.4 Test-Suite testuuid Type: exitcode-stdio-1.0@@ -62,4 +66,4 @@ Extensions: DeriveDataTypeable Ghc-Options: -Wall -fno-warn-orphans Build-Depends: random, bytestring, base >=3, base < 5, uuid,- HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3+ HUnit >=1.2 && < 1.3, QuickCheck >=2.4 && < 2.5