uuid 1.2.2 → 1.2.3
raw patch · 7 files changed
+39/−334 lines, 7 filesdep +deepseqdep +uuiddep −paralleldep ~Cryptodep ~basedep ~binary
Dependencies added: deepseq, uuid
Dependencies removed: parallel
Dependency ranges changed: Crypto, base, binary, bytestring, containers, criterion, maccatcher, mersenne-random-pure64, time
Files
- CHANGES +14/−0
- Data/UUID.hs +1/−1
- Data/UUID/Internal.hs +5/−4
- Data/UUID/V1.hs +0/−1
- tests/BenchUUID.hs +0/−133
- tests/TestUUID.hs +0/−162
- uuid.cabal +19/−33
CHANGES view
@@ -1,3 +1,17 @@+1.2.3++- The Read instance now drops leading spaces in the string to be parsed.+Thanks to Marc Ziegert for reporting this bug.++- The tests have moved over to the new Cabal test running framework.++1.2.2++- Add functions fromWords/toWords++The goal was to have a total function that can be used to construct+a UUID, primarily for use by uuid-th.+ 1.2.1 - Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting
Data/UUID.hs view
@@ -28,7 +28,7 @@ ,nil ) where -import Prelude hiding (null)+import Prelude () -- we need to hide Prelude.null import Data.UUID.Internal -- Everything is really implemented in Data.UUID.Internal,
Data/UUID/Internal.hs view
@@ -26,7 +26,6 @@ ) where import Prelude hiding (null)-import qualified Prelude import Control.Monad (liftM4) import Data.Char@@ -270,9 +269,11 @@ show = toString instance Read UUID where- readsPrec _ str = case fromString (take 36 str) of- Nothing -> []- Just u -> [(u,drop 36 str)]+ readsPrec _ str =+ let noSpaces = dropWhile isSpace str+ in case fromString (take 36 noSpaces) of+ Nothing -> []+ Just u -> [(u,drop 36 noSpaces)] instance Storable UUID where
Data/UUID/V1.hs view
@@ -24,7 +24,6 @@ import Data.Word import Control.Concurrent.MVar-import System.IO import System.IO.Unsafe import qualified System.Info.MAC as SysMAC
− tests/BenchUUID.hs
@@ -1,133 +0,0 @@-import Control.Parallel.Strategies-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.Internal 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"- ]--#if !(MIN_VERSION_criterion(0,4,0))-nf f arg = B ( rnf . f) arg-whnf f arg = B f arg-#endif--#if !(MIN_VERSION_criterion(0,4,1))-nfIO act = rnf `fmap` act-#endif
− tests/TestUUID.hs
@@ -1,162 +0,0 @@-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-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- arbitrary = (fst . random) `fmap` rand- coarbitrary = undefined--instance Arbitrary Word8 where- arbitrary = (fromIntegral . fst . randomR (0,255::Int)) `fmap` rand- coarbitrary = undefined---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---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_byteStringRoundTrip,- prop_stringLength,- prop_byteStringLength,- prop_randomsDiffer,- prop_randomNotNull,- prop_randomsValid,- prop_v3NotNull,- prop_v3Valid,- prop_v5NotNull,- prop_v5Valid- ]
uuid.cabal view
@@ -1,5 +1,5 @@ Name: uuid-Version: 1.2.2+Version: 1.2.3 Copyright: (c) 2008-2011 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com@@ -8,7 +8,7 @@ Category: Data Build-Type: Simple-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Description: This library is useful for creating, comparing, parsing and@@ -24,9 +24,6 @@ CHANGES CONTRIBUTORS -Flag test- Description: Build unit test and benchmark programs.- Default: False Library Build-Depends: random, binary, bytestring, Crypto, maccatcher,@@ -48,32 +45,21 @@ Ghc-Shared-Options: Ghc-Options: -Wall -Executable benchuuid- Main-Is: BenchUUID.hs- HS-Source-Dirs: tests .- Extensions: DeriveDataTypeable, CPP- If flag(test)- Buildable: True- Build-Depends: random, binary, bytestring, Crypto, maccatcher,- time, base >=3, base < 5, containers,- criterion >= 0.3 && < 0.5, parallel >= 2.1 && < 2.3,- mersenne-random-pure64 >= 0.2 && < 0.3- Else- Buildable: False--Executable testuuid- Main-Is: TestUUID.hs- HS-Source-Dirs: tests .- Extensions: DeriveDataTypeable- Ghc-Prof-Options: -auto-all -caf-all- Ghc-Shared-Options:- Ghc-Options: -Wall -fno-warn-orphans-- If flag(test)- Buildable: True- Build-Depends: random, binary, bytestring, Crypto, maccatcher,- time, base >=3, base < 5,- HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3- Else- Buildable: False+-- not strictly a test, but we want it to error if+-- it can't build+Test-Suite benchmark+ Type: exitcode-stdio-1.0+ 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.* +Test-Suite testuuid+ Type: exitcode-stdio-1.0+ Main-is: TestUUID.hs+ Hs-source-dirs: tests+ 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