diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -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 diff --git a/Data/UUID.hs b/Data/UUID.hs --- a/Data/UUID.hs +++ b/Data/UUID.hs @@ -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, diff --git a/Data/UUID/Internal.hs b/Data/UUID/Internal.hs --- a/Data/UUID/Internal.hs +++ b/Data/UUID/Internal.hs @@ -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 diff --git a/Data/UUID/V1.hs b/Data/UUID/V1.hs --- a/Data/UUID/V1.hs +++ b/Data/UUID/V1.hs @@ -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 diff --git a/tests/BenchUUID.hs b/tests/BenchUUID.hs deleted file mode 100644 --- a/tests/BenchUUID.hs +++ /dev/null @@ -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 diff --git a/tests/TestUUID.hs b/tests/TestUUID.hs deleted file mode 100644 --- a/tests/TestUUID.hs +++ /dev/null @@ -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 - ] diff --git a/uuid.cabal b/uuid.cabal --- a/uuid.cabal +++ b/uuid.cabal @@ -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