uuid-types-1.0.3/0000755000000000000000000000000012700020743012004 5ustar0000000000000000uuid-types-1.0.3/uuid-types.cabal0000644000000000000000000000451412700020743015104 0ustar0000000000000000Name: uuid-types Version: 1.0.3 Copyright: (c) 2008-2014 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com License: BSD3 License-file: LICENSE Category: Data Build-Type: Simple Cabal-Version: >= 1.8 Description: This library contains type definitions for Universally Unique Identifiers and basic conversion functions. See for the general idea. Synopsis: Type definitions for Universally Unique Identifiers Homepage: https://github.com/aslatter/uuid Bug-Reports: https://github.com/aslatter/uuid/issues Extra-Source-Files: CHANGES Library Build-Depends: base >=3 && < 5, binary >= 0.4 && < 0.9, bytestring >= 0.9 && < 0.11, deepseq >= 1.3 && < 1.5, hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3), random >= 1.0.1 && < 1.2, text >= 1 && < 1.3 Exposed-Modules: Data.UUID.Types -- Exposed for companion projects; *NOT* part of the official API: Data.UUID.Types.Internal.Builder Data.UUID.Types.Internal Extensions: DeriveDataTypeable Ghc-Options: -Wall source-repository head type: git location: https://github.com/aslatter/uuid.git 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: base >= 3 && < 5, uuid-types, bytestring >= 0.9 && < 0.11, HUnit >=1.2 && < 1.4, QuickCheck >=2.4 && < 2.9, tasty >= 0.10 && < 0.12, tasty-hunit == 0.9.*, tasty-quickcheck == 0.8.* benchmark benchmark Type: exitcode-stdio-1.0 Main-is: BenchUUID.hs Hs-source-dirs: tests Extensions: DeriveDataTypeable, CPP Ghc-Options: -Wall -fno-warn-orphans Build-depends: base == 4.*, uuid-types, bytestring >= 0.9 && < 0.11, containers >= 0.4 && < 0.6, criterion >= 0.4 && < 1.2, deepseq >= 1.1 && < 1.5, random >= 1.0.1 && < 1.2 uuid-types-1.0.3/LICENSE0000644000000000000000000000266012700020743013015 0ustar0000000000000000Copyright (c) 2008, Antoine Latter All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of the authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. uuid-types-1.0.3/CHANGES0000644000000000000000000000024212700020743012775 0ustar00000000000000001.0.3 - Bump package dependencies 1.0.2 - Add toText/fromText 1.0.1 - Update dependencies in tests and benchmarks. 1.0.0 - Initial split from "uuid-1.3.8" uuid-types-1.0.3/Setup.hs0000644000000000000000000000007512700020743013442 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain uuid-types-1.0.3/tests/0000755000000000000000000000000012700020743013146 5ustar0000000000000000uuid-types-1.0.3/tests/BenchUUID.hs0000644000000000000000000001112712700020743015212 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_bytestring(0,10,0)) -- Needed for NFData instance import Control.DeepSeq import qualified Data.ByteString.Lazy.Internal as BL #endif import Criterion.Main import Data.Maybe (fromJust) import qualified Data.Set as Set import qualified Data.ByteString.Lazy as BL import qualified Data.UUID.Types as U import Foreign (alloca, peek, poke) import System.Random #if !(MIN_VERSION_bytestring(0,10,0)) instance NFData BL.ByteString where rnf BL.Empty = () rnf (BL.Chunk _ ts) = rnf ts #endif main :: IO () main = do u1 <- randomIO let s1 = U.toString u1 b1 = U.toByteString u1 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 Storable benchmark alloca $ \ uuidPtr -> do poke uuidPtr u1 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 ], bench "set making" $ nf Set.fromList uuids, bgroup "storable" [ bench "peek" $ nfIO (peek uuidPtr), bench "poke" $ whnfIO $ poke uuidPtr u1 ] ] -- 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" ] uuid-types-1.0.3/tests/TestUUID.hs0000644000000000000000000001341212700020743015111 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Char8 as BC8 import Data.Char (ord) import Data.Functor ((<$>)) import Data.Word import qualified Data.UUID.Types as U import Foreign (alloca, peek, poke) import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck ( Arbitrary(arbitrary), choose ) import Test.Tasty ( defaultMain, TestTree, testGroup ) import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase ) import Test.Tasty.QuickCheck ( testProperty ) instance Arbitrary U.UUID where -- the UUID random instance ignores bounds arbitrary = choose (U.nil, U.nil) type Test = TestTree test_null :: Test test_null = testCase "nil is null" $ assertBool "" (U.null U.nil) test_nil :: Test test_nil = testGroup "nil" [ testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000", testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0) ] test_conv :: Test test_conv = testGroup "conversions" [ testCase "conv bytes to string" $ maybe "" (U.toString) (U.fromByteString b16) @?= s16, testCase "conv string to bytes" $ maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16 ] where b16 = BL.pack [1..16] s16 = "01020304-0506-0708-090a-0b0c0d0e0f10" -- | Test fromByteString with a fixed-input. test_fromByteString :: Test test_fromByteString = testCase "UUID fromByteString" $ Just inputUUID @=? U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226") -- | Test fromWords with a fixed-input test_fromWords :: Test test_fromWords = testCase "UUID fromWords" $ inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594 inputUUID :: U.UUID inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2" prop_stringRoundTrip :: Test prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip where stringRoundTrip :: U.UUID -> Bool stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u) prop_byteStringRoundTrip :: Test prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip where byteStringRoundTrip :: U.UUID -> Bool byteStringRoundTrip u = maybe False (== u) $ U.fromByteString (U.toByteString u) prop_stringLength :: Test prop_stringLength = testProperty "String length" stringLength where stringLength :: U.UUID -> Bool stringLength u = length (U.toString u) == 36 prop_byteStringLength :: Test prop_byteStringLength = testProperty "ByteString length" byteStringLength where byteStringLength :: U.UUID -> Bool byteStringLength u = BL.length (U.toByteString u) == 16 prop_randomsDiffer :: Test prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer where randomsDiffer :: (U.UUID, U.UUID) -> Bool randomsDiffer (u1, u2) = u1 /= u2 prop_randomNotNull :: Test prop_randomNotNull = testProperty "Random not null" randomNotNull where randomNotNull :: U.UUID -> Bool randomNotNull = not. U.null prop_readShowRoundTrip :: Test prop_readShowRoundTrip = testProperty "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 -- Mostly going to test for wrong UUIDs fromASCIIBytes_fromString1 :: String -> Bool fromASCIIBytes_fromString1 s = if all (\c -> ord c < 256) s then U.fromString s == U.fromASCIIBytes (BC8.pack s) else True fromASCIIBytes_fromString2 :: U.UUID -> Bool fromASCIIBytes_fromString2 (U.toString -> s) = U.fromString s == U.fromASCIIBytes (BC8.pack s) toASCIIBytes_toString :: U.UUID -> Bool toASCIIBytes_toString uuid = U.toString uuid == BC8.unpack (U.toASCIIBytes uuid) fromASCIIBytes_toASCIIBytes :: U.UUID -> Bool fromASCIIBytes_toASCIIBytes (BC8.pack . U.toString -> bs) = Just bs == (U.toASCIIBytes <$> U.fromASCIIBytes bs) toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool toASCIIBytes_fromASCIIBytes uuid = Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid) toWords_fromWords :: U.UUID -> Bool toWords_fromWords uuid = uuid == myUncurry4 U.fromWords (U.toWords uuid) fromWords_toWords :: (Word32, Word32, Word32, Word32) -> Bool fromWords_toWords wds = wds == U.toWords (myUncurry4 U.fromWords wds) myUncurry4 :: (x1 -> x2 -> x3 -> x4 -> y) -> (x1, x2, x3, x4) -> y myUncurry4 f (a,b,c,d) = f a b c d prop_storableRoundTrip :: Test prop_storableRoundTrip = testProperty "Storeable round-trip" $ unsafePerformIO . prop where prop :: U.UUID -> IO Bool prop uuid = alloca $ \ptr -> do poke ptr uuid uuid2 <- peek ptr return $ uuid == uuid2 main :: IO () main = do defaultMain $ testGroup "tests" $ concat $ [ [ test_null, test_nil, test_conv, test_fromByteString, test_fromWords ] , [ prop_stringRoundTrip, prop_readShowRoundTrip, prop_byteStringRoundTrip, prop_storableRoundTrip, prop_stringLength, prop_byteStringLength, prop_randomsDiffer, prop_randomNotNull ] , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes , testProperty "toWords_fromWords" toWords_fromWords , testProperty "fromWords_toWords" fromWords_toWords ] ] uuid-types-1.0.3/Data/0000755000000000000000000000000012700020743012655 5ustar0000000000000000uuid-types-1.0.3/Data/UUID/0000755000000000000000000000000012700020743013423 5ustar0000000000000000uuid-types-1.0.3/Data/UUID/Types.hs0000644000000000000000000000205712700020743015067 0ustar0000000000000000{- | Module : Data.UUID.Types Copyright : (c) 2008,2012 Antoine Latter License : BSD-style Maintainer : aslatter@gmail.com Stability : experimental Portability : portable This library is useful for comparing, parsing and printing Universally Unique Identifiers. See for the general idea. See for the specification. -} module Data.UUID.Types(UUID ,toString ,fromString ,toText ,fromText ,toASCIIBytes ,fromASCIIBytes ,toLazyASCIIBytes ,fromLazyASCIIBytes ,toByteString ,fromByteString ,toWords ,fromWords ,null ,nil ) where import Prelude () -- we need to hide Prelude.null import Data.UUID.Types.Internal -- Everything is really implemented in Data.UUID.Types.Internal, but I -- don't want to export the constructors out of the package. uuid-types-1.0.3/Data/UUID/Types/0000755000000000000000000000000012700020743014527 5ustar0000000000000000uuid-types-1.0.3/Data/UUID/Types/Internal.hs0000644000000000000000000004210512700020743016641 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.UUID.Types.Internal -- Copyright : (c) 2008-2009, 2012 Antoine Latter -- (c) 2009 Mark Lentczner -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable module Data.UUID.Types.Internal (UUID(..) ,null ,nil ,fromByteString ,toByteString ,fromString ,toString ,fromText ,toText ,fromWords ,toWords ,toList ,buildFromBytes ,buildFromWords ,fromASCIIBytes ,toASCIIBytes ,fromLazyASCIIBytes ,toLazyASCIIBytes ,UnpackedUUID(..) ,pack ,unpack ) where import Prelude hiding (null) import Control.Applicative ((<*>)) import Control.DeepSeq (NFData(..)) import Control.Monad (liftM4, guard) import Data.Functor ((<$>)) import Data.Char import Data.Bits import Data.Hashable import Data.List (elemIndices) import Foreign.Ptr (Ptr) #if MIN_VERSION_base(4,0,0) import Data.Data #else import Data.Generics.Basics #endif import Foreign.Storable import Data.Binary import Data.Binary.Put import Data.Binary.Get import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Unsafe as BU import Data.Text (Text) import qualified Data.Text as T import Data.UUID.Types.Internal.Builder import System.Random -- |The UUID type. A 'Random' instance is provided which produces -- 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 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 deriving (Eq, Ord, Typeable) {- Other representations that we tried are: Mimic V1 structure: !Word32 !Word16 !Word16 !Word16 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 Sixteen bytes: !Word8 ... (x 16) Simple list of bytes: [Word8] ByteString (strict) ByteString Immutable array: UArray Int Word8 Vector: UArr Word8 None was as fast, overall, as the representation used here. -} -- | Covert a 'UUID' into a sequence of 'Word32' values. -- Useful for when you need to serialize a UUID and -- neither 'Storable' nor 'Binary' are appropriate. -- Introduced in version 1.2.2. toWords :: UUID -> (Word32, Word32, Word32, Word32) toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4) -- | Create a 'UUID' from a sequence of 'Word32'. The -- opposite of 'toWords'. Useful when you need a total -- function for constructing 'UUID' values. -- Introduced in version 1.2.2. fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID fromWords = UUID data UnpackedUUID = UnpackedUUID { time_low :: Word32 -- 0-3 , time_mid :: Word16 -- 4-5 , time_hi_and_version :: Word16 -- 6-7 , clock_seq_hi_res :: Word8 -- 8 , clock_seq_low :: Word8 -- 9 , node_0 :: Word8 , node_1 :: Word8 , node_2 :: Word8 , node_3 :: Word8 , node_4 :: Word8 , node_5 :: Word8 } deriving (Read, Show, Eq, Ord) unpack :: UUID -> UnpackedUUID unpack (UUID w0 w1 w2 w3) = build /-/ w0 /-/ w1 /-/ w2 /-/ w3 where build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF = UnpackedUUID { time_low = word x0 x1 x2 x3 , time_mid = w8to16 x4 x5 , time_hi_and_version = w8to16 x6 x7 , clock_seq_hi_res = x8 , clock_seq_low = x9 , node_0 = xA , node_1 = xB , node_2 = xC , node_3 = xD , node_4 = xE , node_5 = xF } pack :: UnpackedUUID -> UUID pack unpacked = makeFromBytes /-/ (time_low unpacked) /-/ (time_mid unpacked) /-/ (time_hi_and_version unpacked) /-/ (clock_seq_hi_res unpacked) /-/ (clock_seq_low unpacked) /-/ (node_0 unpacked) /-/ (node_1 unpacked) /-/ (node_2 unpacked) /-/ (node_3 unpacked) /-/ (node_4 unpacked) /-/ (node_5 unpacked) -- -- UTILITIES -- -- |Build a Word32 from four Word8 values, presented in big-endian order word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 word a b c d = (fromIntegral a `shiftL` 24) .|. (fromIntegral b `shiftL` 16) .|. (fromIntegral c `shiftL` 8) .|. (fromIntegral d ) -- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0, byte :: Int -> Word32 -> Word8 byte i w = fromIntegral (w `shiftR` (i * 8)) -- |Build a Word16 from two Word8 values, presented in big-endian order. w8to16 :: Word8 -> Word8 -> Word16 w8to16 w0s w1s = (w0 `shiftL` 8) .|. w1 where w0 = fromIntegral w0s w1 = fromIntegral w1s -- |Make a UUID from sixteen Word8 values makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = UUID w0 w1 w2 w3 where w0 = word b0 b1 b2 b3 w1 = word b4 b5 b6 b7 w2 = word b8 b9 ba bb w3 = word bc bd be bf -- |Make a UUID from four Word32 values makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID makeFromWords = UUID -- |A Builder for constructing a UUID of a given version. buildFromBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf where b6' = b6 .&. 0x0f .|. (v `shiftL` 4) b8' = b8 .&. 0x3f .|. 0x80 -- |Build a UUID of a given version from Word32 values. buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12) w2' = w2 .&. 0x3fffffff .|. 0x80000000 -- |Return the bytes that make up the UUID toList :: UUID -> [Word8] toList (UUID w0 w1 w2 w3) = [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0, byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1, byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2, byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3] -- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't -- exactly sixteen bytes long fromList :: [Word8] -> Maybe UUID fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] = Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf fromList _ = Nothing -- -- UUID API -- -- |Returns true if the passed-in UUID is the 'nil' UUID. null :: UUID -> Bool null = (== nil) -- Note: This actually faster than: -- null (UUID 0 0 0 0) = True -- null _ = False -- |The nil UUID, as defined in RFC 4122. -- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@. nil :: UUID nil = UUID 0 0 0 0 -- |Extract a UUID from a 'ByteString' in network byte order. -- The argument must be 16 bytes long, otherwise 'Nothing' is returned. fromByteString :: BL.ByteString -> Maybe UUID fromByteString = fromList . BL.unpack -- |Encode a UUID into a 'ByteString' in network order. toByteString :: UUID -> BL.ByteString toByteString = BL.pack . toList -- |If the passed in 'String' can be parsed as a 'UUID', it will be. -- The hyphens may not be omitted. -- Example: -- -- @ -- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\" -- @ -- -- Hex digits may be upper or lower-case. fromString :: String -> Maybe UUID fromString xs | validFmt = fromString' xs | otherwise = Nothing where validFmt = elemIndices '-' xs == [8,13,18,23] fromString' :: String -> Maybe UUID fromString' s0 = do (w0, s1) <- hexWord s0 (w1, s2) <- hexWord s1 (w2, s3) <- hexWord s2 (w3, s4) <- hexWord s3 if s4 /= "" then Nothing else Just $ UUID w0 w1 w2 w3 where hexWord :: String -> Maybe (Word32, String) hexWord s = Just (0, s) >>= hexByte >>= hexByte >>= hexByte >>= hexByte hexByte :: (Word32, String) -> Maybe (Word32, String) hexByte (w, '-':ds) = hexByte (w, ds) hexByte (w, hi:lo:ds) | bothHex = Just ((w `shiftL` 8) .|. octet, ds) | otherwise = Nothing where bothHex = isHexDigit hi && isHexDigit lo octet = fromIntegral (16 * digitToInt hi + digitToInt lo) hexByte _ = Nothing -- | Convert a UUID into a hypenated string using lower-case letters. -- Example: -- -- @ -- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\" -- @ toString :: UUID -> String toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 "" where hexw :: Word32 -> String -> String hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s hexw' :: Word32 -> String -> String hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16 : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s hexn :: Word32 -> Int -> Char hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf) -- | If the passed in `Text` can be parsed as an ASCII representation of -- a `UUID`, it will be. The hyphens may not be omitted. fromText :: Text -> Maybe UUID fromText = fromString . T.unpack -- | Convert a UUID into a hyphentated string using lower-case letters. toText :: UUID -> Text toText = T.pack . toString -- | Convert a UUID into a hyphentated string using lower-case letters, packed -- as ASCII bytes into `B.ByteString`. -- -- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`. toASCIIBytes :: UUID -> B.ByteString toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid) -- | Helper function for `toASCIIBytes` pokeASCII :: UUID -> Ptr Word8 -> IO () pokeASCII uuid ptr = do pokeDash 8 pokeDash 13 pokeDash 18 pokeDash 23 pokeSingle 0 w0 pokeDouble 9 w1 pokeDouble 19 w2 pokeSingle 28 w3 where (w0, w1, w2, w3) = toWords uuid -- ord '-' ==> 45 pokeDash ix = pokeElemOff ptr ix 45 pokeSingle ix w = do pokeWord ix w 28 pokeWord (ix + 1) w 24 pokeWord (ix + 2) w 20 pokeWord (ix + 3) w 16 pokeWord (ix + 4) w 12 pokeWord (ix + 5) w 8 pokeWord (ix + 6) w 4 pokeWord (ix + 7) w 0 -- We skip the dash in the middle pokeDouble ix w = do pokeWord ix w 28 pokeWord (ix + 1) w 24 pokeWord (ix + 2) w 20 pokeWord (ix + 3) w 16 pokeWord (ix + 5) w 12 pokeWord (ix + 6) w 8 pokeWord (ix + 7) w 4 pokeWord (ix + 8) w 0 pokeWord ix w r = pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf))) toDigit :: Word32 -> Word32 toDigit w = if w < 10 then 48 + w else 97 + w - 10 -- | If the passed in `B.ByteString` can be parsed as an ASCII representation of -- a `UUID`, it will be. The hyphens may not be omitted. -- -- This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`. fromASCIIBytes :: B.ByteString -> Maybe UUID fromASCIIBytes bs = do guard wellFormed fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28 where -- ord '-' ==> 45 dashIx bs' ix = BU.unsafeIndex bs' ix == 45 -- Important: check the length first, given the `unsafeIndex` later. wellFormed = B.length bs == 36 && dashIx bs 8 && dashIx bs 13 && dashIx bs 18 && dashIx bs 23 single ix = combine <$> octet ix <*> octet (ix + 2) <*> octet (ix + 4) <*> octet (ix + 6) double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2) <*> octet ix1 <*> octet (ix1 + 2) combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3 octet ix = do hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix) lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1)) return (16 * hi + lo) toDigit :: Word8 -> Maybe Word8 toDigit w -- Digit | w >= 48 && w <= 57 = Just (w - 48) -- Uppercase | w >= 65 && w <= 70 = Just (10 + w - 65) -- Lowercase | w >= 97 && w <= 102 = Just (10 + w - 97) | otherwise = Nothing -- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`. toLazyASCIIBytes :: UUID -> BL.ByteString toLazyASCIIBytes = #if MIN_VERSION_bytestring(0,10,0) BL.fromStrict #else BL.fromChunks . return #endif . toASCIIBytes -- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`. fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID fromLazyASCIIBytes bs = if BL.length bs == 36 then fromASCIIBytes ( #if MIN_VERSION_bytestring(0,10,0) BL.toStrict bs #else B.concat $ BL.toChunks bs #endif ) else Nothing -- -- Class Instances -- instance Random UUID where random g = (fromGenNext w0 w1 w2 w3 w4, g4) where (w0, g0) = next g (w1, g1) = next g0 (w2, g2) = next g1 (w3, g3) = next g2 (w4, g4) = next g3 randomR _ = random -- range is ignored -- |Build a UUID from the results of five calls to next on a StdGen. -- While next on StdGet returns an Int, it doesn't provide 32 bits of -- randomness. This code relies on at last 28 bits of randomness in the -- and optimizes its use so as to make only five random values, not six. fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID fromGenNext w0 w1 w2 w3 w4 = buildFromBytes 4 /-/ (ThreeByte w0) /-/ (ThreeByte w1) /-/ w2 -- use all 4 bytes because we know the version -- field will "cover" the upper, non-random bits /-/ (ThreeByte w3) /-/ (ThreeByte w4) -- |A ByteSource to extract only three bytes from an Int, since next on StdGet -- only returns 31 bits of randomness. type instance ByteSink ThreeByte g = Takes3Bytes g newtype ThreeByte = ThreeByte Int instance ByteSource ThreeByte where f /-/ (ThreeByte w) = f b1 b2 b3 where b1 = fromIntegral (w `shiftR` 16) b2 = fromIntegral (w `shiftR` 8) b3 = fromIntegral w instance NFData UUID where rnf = rnf . toWords instance Hashable UUID where hash (UUID w0 w1 w2 w3) = hash w0 `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 hashWithSalt s (UUID w0 w1 w2 w3) = s `hashWithSalt` w0 `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 instance Show UUID where show = toString instance Read UUID where 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 sizeOf _ = 16 alignment _ = 4 peekByteOff p off = pack <$> (UnpackedUUID <$> peekByteOff p off -- Word32 <*> peekByteOff p (off+4) -- Word16 <*> peekByteOff p (off+6) -- Word16 <*> peekByteOff p (off+8) -- Word8 <*> peekByteOff p (off+9) -- Word8 <*> peekByteOff p (off+10) -- Word8 <*> peekByteOff p (off+11) -- Word8 <*> peekByteOff p (off+12) -- Word8 <*> peekByteOff p (off+13) -- Word8 <*> peekByteOff p (off+14) -- Word8 <*> peekByteOff p (off+15) -- Word8 ) pokeByteOff p off u = case unpack u of (UnpackedUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) -> do pokeByteOff p off x0 pokeByteOff p (off+4) x1 pokeByteOff p (off+6) x2 pokeByteOff p (off+8) x3 pokeByteOff p (off+9) x4 pokeByteOff p (off+10) x5 pokeByteOff p (off+11) x6 pokeByteOff p (off+12) x7 pokeByteOff p (off+13) x8 pokeByteOff p (off+14) x9 pokeByteOff p (off+15) x10 instance Binary UUID where put (UUID w0 w1 w2 w3) = putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3 get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be -- My goal with this instance was to make it work just enough to do what -- I want when used with the HStringTemplate library. instance Data UUID where toConstr uu = mkConstr uuidType (show uu) [] (error "fixity") gunfold _ _ = error "gunfold" dataTypeOf _ = uuidType uuidType :: DataType uuidType = mkNoRepType "Data.UUID.Types.UUID" #if !(MIN_VERSION_base(4,2,0)) mkNoRepType :: String -> DataType mkNoRepType = mkNorepType #endif uuid-types-1.0.3/Data/UUID/Types/Internal/0000755000000000000000000000000012700020743016303 5ustar0000000000000000uuid-types-1.0.3/Data/UUID/Types/Internal/Builder.hs0000644000000000000000000000546012700020743020232 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_HADDOCK hide #-} -- Module : Data.UUID.Types.Internal.Builder -- Copyright : (c) 2009 Mark Lentczner -- -- License : BSD-style -- -- Maintainer : markl@glyphic.com -- Stability : experimental -- Portability : portable -- -- This module provides a system that can call a function that takes -- a sequence of some number of Word8 arguments. -- -- The twist is that the Word8 arguments can be supplied directly -- from Word8s, or from other sources that may provide more than -- one Word8 apiece. Examples are Word16 and Word32 that supply -- two and four Word8s respectively. Other ByteSource instances -- can be defined. -- -- This module is admittedly overkill. There are only three places -- in the uuid package that need to call buildFromBytes with 16 -- Word8 values, but each place uses Words of different lengths: -- version 1 uuids: 32-16-16-16-8-8-8-8-8-8 -- version 4 uuids: 24-24-32-24-24 -- version 5 uuids: 32-32-32-32 -- Originally, these three constructions were hand coded but the -- code was ungainly. Using this module makes the code very -- concise, and turns out to optimize to just as fast, or faster! module Data.UUID.Types.Internal.Builder (ByteSource(..) ,ByteSink ,Takes1Byte ,Takes2Bytes ,Takes3Bytes ,Takes4Bytes ) where import Data.Bits import Data.Word type Takes1Byte g = Word8 -> g type Takes2Bytes g = Word8 -> Word8 -> g type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g -- | Type of function that a given ByteSource needs. -- This function must take as many Word8 arguments as the ByteSource provides type family ByteSink w g type instance ByteSink Word8 g = Takes1Byte g type instance ByteSink Word16 g = Takes2Bytes g type instance ByteSink Word32 g = Takes4Bytes g type instance ByteSink Int g = Takes4Bytes g -- | Class of types that can add Word8s to a Builder. -- Instances for Word8, Word16, Word32 and Int provide 1, 2, 4 and 4 bytes, -- respectively, into a ByteSink class ByteSource w where -- | Apply the source's bytes to the sink (/-/) :: ByteSink w g -> w -> g infixl 6 /-/ instance ByteSource Word8 where f /-/ w = f w instance ByteSource Word16 where f /-/ w = f b1 b2 where b1 = fromIntegral (w `shiftR` 8) b2 = fromIntegral w instance ByteSource Word32 where f /-/ w = f b1 b2 b3 b4 where b1 = fromIntegral (w `shiftR` 24) b2 = fromIntegral (w `shiftR` 16) b3 = fromIntegral (w `shiftR` 8) b4 = fromIntegral w instance ByteSource Int where f /-/ w = f b1 b2 b3 b4 where b1 = fromIntegral (w `shiftR` 24) b2 = fromIntegral (w `shiftR` 16) b3 = fromIntegral (w `shiftR` 8) b4 = fromIntegral w