packages feed

uuid 0.1.1 → 1.0.0

raw patch · 7 files changed

+514/−254 lines, 7 filesdep +Cryptodep +binarydep +bytestring

Dependencies added: Crypto, binary, bytestring, maccatcher, random, time

Files

CONTRIBUTORS view
@@ -2,3 +2,4 @@  Antoine Latter Jason Dusek+Tim Newsham
Data/UUID.hs view
@@ -1,7 +1,3 @@-{-# INCLUDE <uuid/uuid.h> #-}-{-# INCLUDE <string.h> #-}-{-# LANGUAGE ForeignFunctionInterface #-}- -- | -- Module      : Data.UUID -- Copyright   : (c) 2008 Antoine Latter@@ -12,205 +8,22 @@ -- Stability   : experimental -- Portability : portable -- --- Haskell bindings to /libuuid/.--- The library /libuuid/ is available as a part of e2fsprogs:--- <http://e2fsprogs.sourceforge.net/>.------ This library is useful for creating, comparing, parsing and+-- +-- This library is useful for comparing, parsing and -- printing Universally Unique Identifiers. -- See <http://en.wikipedia.org/wiki/UUID> for the general idea.+--+-- For generating UUIDs, check out 'Data.UUID.V1', 'Data.UUID.V5' and+-- 'System.Random'.  module Data.UUID(UUID-                ,fromString                 ,toString-                ,toStringUpper-                ,toStringLower-                ,generate-                ,generateRandom-                ,generateTime+                ,fromString                 ,null-                )-where--import Foreign.C.String-import Foreign.C-import Foreign.ForeignPtr-import Foreign--import Data.Typeable-import Data.Generics.Basics--import Prelude hiding (null)+                ) where  import Data.UUID.Internal -instance Eq UUID where-    a == b = compare a b == EQ--instance Ord UUID where-    compare (U fp1) (U fp2) = unsafePerformIO $-        withForeignPtr fp1 $ \p1 ->-        withForeignPtr fp2 $ \p2 ->-        case c_compare p1 p2 of-           0     -> return EQ-           n|n<0 -> return LT-            |n>0 -> return GT--instance Show UUID where-    show = toString--instance Read UUID where-    readsPrec _ str = case fromString (take 36 str) of-      Nothing -> []-      Just u  -> [(u,drop 36 str)]--instance Typeable UUID where-    typeOf _ = mkTyConApp (mkTyCon "Data.UUID.UUID") []--instance Storable UUID where-    sizeOf _ = (16 *) $ alignment (undefined :: CChar)-    alignment _ = alignment (undefined :: CChar)--    peek psource = do-      fp <- mallocForeignPtrArray 16-      withForeignPtr fp $ \pdest ->-          memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)-      return $ U fp--    poke pdest (U fp) = withForeignPtr fp $ \psource ->-          memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)----- 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 =  mkNorepType "Data.UUID.UUID"----- |Creates a new 'UUID'.  If \/dev\/urandom is available, it will be used.--- Otherwise a UUID will be generated based on the current time and the--- hardware MAC address, if available.-generate :: IO UUID-generate = generateWrap c_generate---- |Create a new 'UUID'.  If \/dev\/urandom is available, it will be used.--- Otherwise a psuedorandom generator will be used.-generateRandom :: IO UUID-generateRandom = generateWrap c_generate_random---- |Create a new 'UUID'.  The UUID will be  generated based on the--- current time and the hardware MAC address, if available.-generateTime :: IO UUID-generateTime = generateWrap c_generate_time--generateWrap :: (C_UUID -> IO ()) -> IO UUID-generateWrap gen = do-  fp <- mallocForeignPtrArray 16-  withForeignPtr fp $ \p -> gen p-  return $ U fp---- |Returns 'True' if the passed-in 'UUID' is the null UUID.-null :: UUID -> Bool-null (U fp) = unsafePerformIO $-              withForeignPtr fp $ \p ->-              return $ c_null p == 1---- |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 s = unsafePerformIO $ do-  fp <- mallocForeignPtrArray 16-  res <- withCAString s $ \chars ->-      withForeignPtr fp $ \p ->-      c_read chars p-  case res of-    0 -> return . Just $ U fp-    _ -> return Nothing---- |Returns a 'String' representation of the passed in 'UUID'.--- Hex digits occuring in the output will be either upper or--- lower-case depending on system defaults and locale.-toString :: UUID -> String-toString = toStringWrap c_show---- |Returns a 'String' representation of the passed in 'UUID'.--- Hex digits occuring in the output will be lower-case.-toStringLower :: UUID -> String-toStringLower = toStringWrap c_show_lower-  --- |Returns a 'String' representation of the passed in 'UUID'.--- Hex digits occuring in the output will be upper-case.-toStringUpper :: UUID -> String-toStringUpper = toStringWrap c_show_upper---- |The passed in function /f/ is given a the raw UUID data--- and a 37-byte buffer to fill with the textual representation--- of the UUID.  The buffer is expected to contain a null-terminator--- after /f/ is finished.-toStringWrap :: (C_UUID -> CString -> IO ()) -> UUID -> String-toStringWrap f (U fp) = unsafePerformIO $-  allocaBytes 37 $ \chars -> do-  withForeignPtr fp $ \p -> f p chars-  peekCAString chars---- FFI calls to do the work--type C_UUID = Ptr CChar---- comparing UUIDs-foreign import ccall unsafe "uuid_compare"-  c_compare :: C_UUID -> C_UUID -> CInt---- making random UUIDs-foreign import ccall unsafe "uuid_generate"-  c_generate :: C_UUID -> IO ()--foreign import ccall unsafe "uuid_generate_time"-  c_generate_time :: C_UUID -> IO ()--foreign import ccall unsafe "uuid_generate_random"-  c_generate_random :: C_UUID -> IO ()---- Null check-foreign import ccall unsafe "uuid_is_null"-  c_null :: C_UUID -> CInt---- Parsing-foreign import ccall unsafe "uuid_parse"-  c_read :: CString -> C_UUID ->IO CInt---- Showing--foreign import ccall unsafe "uuid_unparse"-  c_show :: C_UUID -> CString -> IO ()--foreign import ccall unsafe "uuid_unparse_lower"-  c_show_lower :: C_UUID -> CString -> IO ()--foreign import ccall unsafe "uuid_unparse_upper"-  c_show_upper :: C_UUID -> CString -> IO ()----- Queries--foreign import ccall unsafe "uuid_type"-  c_type :: C_UUID -> CInt--foreign import ccall unsafe "uuid_variant"-  c_variant :: C_UUID -> CInt---- Other--foreign import ccall unsafe "memcpy"-  memcpy :: Ptr a -> Ptr b -> CSize -> IO ()+-- Everything is really implemented in Data.UUID.Internal,+-- but I don't want to export the constructors out of the+-- package.
Data/UUID/Internal.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}+ -- |--- Module      : Data.UUID.Internal+-- Module      : Data.UUID -- Copyright   : (c) 2008 Antoine Latter -- -- License     : BSD-style@@ -7,57 +9,277 @@ -- Maintainer  : aslatter@gmail.com -- Stability   : experimental -- Portability : portable--- --- If the public interface in "Data.UUID" doesn't give you--- the flexibility you need, you should be able to find--- something here. -module Data.UUID.Internal(UUID(..)-                         ,toBytes-                         ,fromBytes-                         ,unsafeFromBytes-                         ,toForeignPtr-                         ,fromForeignPtr-                         ) where+module Data.UUID.Internal+    (UUID(..)+    ,Node(..)+    ,nodeToList+    ,listToNode+    ,fromString+    ,toString+    ,versionMask+    ,reservedMask+    ,reserved+    ) where -import Foreign.ForeignPtr-import Foreign.C-import Foreign+import Data.Word+import Data.Char+import Data.Maybe+import Data.Bits+import Data.List (splitAt, foldl', unfoldr) --- |The UUID type.  Represents 128-bits of identification.-newtype UUID = U (ForeignPtr CChar)+import Data.Typeable+import Data.Generics.Basics --- |Returns the passed in UUID as a list of 16 bytes.-toBytes :: UUID -> [Word8]-toBytes (U fp) = unsafePerformIO $ withForeignPtr fp $ \p ->-                 peekArray 16 (castPtr p)+import Foreign.Ptr+import Foreign.Storable --- |Creates a UUID out of a list of bytes.--- Will throw an error if the list is not of length 16.-fromBytes :: [Word8] -> UUID-fromBytes  xs = if length xs == 16- then unsafeFromBytes xs- else error "Data.UUID.Internal.fromBytes: passed in list of bytes must be of length 16."+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get --- |Creates a UUID out of a list of bytes.--- Does not perform a length check on the passed in list.--- Behavior is undefined for lists not of length 16.-unsafeFromBytes :: [Word8] -> UUID-unsafeFromBytes xs = U $ castForeignPtr $ unsafePerformIO $ do-   p <- mallocForeignPtrBytes 16-   withForeignPtr p $ flip pokeArray xs-   return p+import System.Random --- |Unsafe.+import Text.Printf++#ifndef STRICT+#define SLOT(x) x+#else+#define SLOT(x) {-# UNPACK #-} !x+#endif++-- |The UUID type.  A 'Random' instance is provided which produces+-- version 3 UUIDs as specified in RFC 4122.  The 'Storable' and +-- 'Binary' instances are compatable with RFC 4122.  The 'Binary'+-- instance serializes to network byte order.+data UUID = UUID+    {uuid_timeLow  :: SLOT(Word32)+    ,uuid_timeMid  :: SLOT(Word16)+    ,uuid_timeHigh :: SLOT(Word16) -- includes version number+    ,uuid_clockSeqHi :: SLOT(Word8) -- includes reserved field+    ,uuid_clokcSeqLow :: SLOT(Word8)+    ,uuid_node :: SLOT(Node)+    } deriving (Eq, Ord, Typeable)++instance Random UUID where+    random g = let (timeLow, g1)  = randomBoundedIntegral g+                   (timeMid, g2)  = randomBoundedIntegral g1+                   (timeHigh, g3) = randomBoundedIntegral g2+                   (seqHigh, g4)  = randomBoundedIntegral g3+                   (seqLow, g5)   = randomBoundedIntegral g4+                   (node, g6)     = random g5+                   seqHighReserved = (seqHigh .&. reservedMask) .|. reserved+                   timeHighVersion = (timeHigh .&. versionMask) .|. versionRandom+               in (UUID timeLow timeMid timeHighVersion seqHighReserved seqLow node, g6)++    randomR _ = random -- range is ignored++versionMask :: Word16 -- 0000 1111 1111 1111+versionMask = 0x0FFF++versionRandom :: Word16+versionRandom = 4 `shiftL` 12++reservedMask :: Word8 -- 0011 1111+reservedMask = 0x3F++reserved :: Word8+reserved = bit 7++data Node = Node+    SLOT(Word8)+    SLOT(Word8)+    SLOT(Word8)+    SLOT(Word8)+    SLOT(Word8)+    SLOT(Word8)+ deriving (Eq, Ord, Typeable)++instance Random Node where+    random g = let (w1, g1) = randomBoundedIntegral g+                   (w2, g2) = randomBoundedIntegral g1+                   (w3, g3) = randomBoundedIntegral g2+                   (w4, g4) = randomBoundedIntegral g3+                   (w5, g5) = randomBoundedIntegral g4+                   (w6, g6) = randomBoundedIntegral g5+               in (Node w1 w2 w3 w4 w5 w6, g6)+    randomR _ = random -- neglect range+++nodeToList :: Node -> [Word8]+nodeToList (Node w1 w2 w3 w4 w5 w6) = [w1, w2, w3, w4, w5, w6]++listToNode :: [Word8] -> Maybe Node+listToNode [w1, w2, w3, w4, w5, w6] = return $ Node w1 w2 w3 w4 w5 w6+listToNode _ = Nothing++instance Show UUID where+    show = toString++instance Read UUID where+    readsPrec _ str = case fromString (take 36 str) of+      Nothing -> []+      Just u  -> [(u,drop 36 str)]+++instance Storable UUID where+    sizeOf _ = 16+    alignment _ = 4 -- not sure what to put here++    peek p = do+      tl   <- peek $ castPtr p+      tm   <- peekByteOff p 4+      th   <- peekByteOff p 6+      ch   <- peekByteOff p 8+      cl   <- peekByteOff p 9+      node <- peekByteOff p 10+      return $ UUID tl tm th ch cl node++    poke p (UUID tl tm th ch cl node) = do+      poke (castPtr p) tl+      pokeByteOff p 4 tm+      pokeByteOff p 6 th+      pokeByteOff p 8 ch+      pokeByteOff p 9 cl+      pokeByteOff p 10 node++instance Storable Node where+    sizeOf _ = 6+    alignment _ = 1 -- ???++    peek p = do+      w1 <- peek $ castPtr p+      w2 <- peekByteOff p 1+      w3 <- peekByteOff p 2+      w4 <- peekByteOff p 3+      w5 <- peekByteOff p 4+      w6 <- peekByteOff p 5+      return $ Node w1 w2 w3 w4 w5 w6++    poke p (Node w1 w2 w3 w4 w5 w6) = do+      poke (castPtr p) w1+      pokeByteOff p 1 w2+      pokeByteOff p 2 w3+      pokeByteOff p 3 w4+      pokeByteOff p 4 w5+      pokeByteOff p 5 w6++-- Binary instance in network byte-order+instance Binary UUID where+    put (UUID tl tm th ch cl n) = do+                       putWord32be tl+                       putWord16be tm+                       putWord16be th+                       putWord8 ch+                       putWord8 cl+                       put n++    get = do+      tl <- getWord32be+      tm <- getWord16be+      th <- getWord16be+      ch <- getWord8+      cl <- getWord8+      node <- get+      return $ UUID tl tm th ch cl node++instance Binary Node where+    put (Node w1 w2 w3 w4 w5 w6) = do+                       putWord8 w1+                       putWord8 w2+                       putWord8 w3+                       putWord8 w4+                       putWord8 w5+                       putWord8 w6++    get = do+      w1 <- getWord8+      w2 <- getWord8+      w3 <- getWord8+      w4 <- getWord8+      w5 <- getWord8+      w6 <- getWord8+      return $ Node w1 w2 w3 w4 w5 w6+++-- 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 =  mkNorepType "Data.UUID.UUID"+++++-- |If the passed in 'String' can be parsed as a 'UUID', it will be.+-- The hyphens may not be omitted.+-- Example: ----- Given a UUID, returns a pointer to the 16 bytes--- of memory that make up the UUID.-toForeignPtr :: UUID -> ForeignPtr CChar-toForeignPtr (U p) = p+-- @+--  fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"+-- @+--+-- Hex digits may be upper or lower-case.+fromString :: String -> Maybe UUID+fromString xs | validFmt  = Just uuid+              | otherwise = Nothing+  where validFmt = length ws == 5 &&+                   map length ws == [8,4,4,4,12] &&+                   all isHexDigit (concat ws) &&+                   isJust node+        ws = splitList '-' xs+        [tl, tm, th, c, n] = ws+        ns = unfoldUntil Prelude.null (splitAt 2) n :: [String]+        node = listToNode $ map hexVal ns :: Maybe Node+        uuid = UUID (hexVal tl) (hexVal tm) (hexVal th) (hexVal $ take 2 c) (hexVal $ drop 2 c) (fromJust $ node) --- |Unsafe.+-- | Convert a string to a hex value, assuming the string is already validated.+hexVal :: Num a => String -> a+hexVal = fromInteger . foldl' (\n c -> 16*n + digitToInteger c) 0++digitToInteger :: Char -> Integer+digitToInteger = fromIntegral . digitToInt+++-- | Convert a UUID into a hypenated string using lower-case letters.+-- Example: ----- The passed in pointer is treated as if it were a pointer--- to 16 bytes of memory, which is then returned as a UUID.-fromForeignPtr :: ForeignPtr CChar -> UUID-fromForeignPtr = U+-- @+--  toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\"+-- @+toString :: UUID -> String+toString (UUID tl tm th ch cl n) = printf "%08x-%04x-%04x-%02x%02x-%s" tl tm th ch cl ns+    where ns = concatMap hexb $ nodeToList n+          hexb x = printf "%02x" x :: String+++-- remove all occurances of the input element in the inpt list.+-- none of the sub-lists are empty.+splitList :: Eq a => a -> [a] -> [[a]]+splitList c xs = let ys = dropWhile (== c) xs+                 in case span (/= c) ys of+                      ([],_) -> []+                      (sub,rest) -> sub : splitList c rest++-- the passed-in predicate signals when to stop unfolding+unfoldUntil :: (b -> Bool) -> (b -> (a, b)) -> b -> [a]+unfoldUntil p f n = unfoldr g n+ where g m | p m       = Nothing+           | otherwise = Just $ f m+++-- no random intance for Data.Word types :-(+-- this will work, though++randomBoundedIntegral :: (RandomGen g, Bounded a, Integral a) => g -> (a, g)+randomBoundedIntegral g =+    let (n, g1) = randomR (fromIntegral l, fromIntegral u) g+        _ = n :: Integer+        retVal = fromIntegral n `asTypeOf` (l `asTypeOf` u)+        u = maxBound+        l = minBound+    in (retVal, g1)+
+ Data/UUID/V1.hs view
@@ -0,0 +1,108 @@+{-# OPTIONS_GHC -fno-cse #-}++-- |+-- Module      : Data.UUID.V1+-- Copyright   : (c) 2008 Jason Dusek+--+-- License     : BSD-style+--+-- Maintainer  : aslatter@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- RFC 4122 Version 1 UUID state machine.++module Data.UUID.V1(nextUUID)+where++import Data.Time++import Data.Bits+import Data.Word+import Data.Binary++import Data.IORef+import System.IO+import System.IO.Unsafe++import System.Info.MAC+import Data.MAC++import Data.UUID.Internal++-- | Returns a new UUID derived from the local hardware MAC+-- address and the current system time.+-- Is generated according to the Version 1 UUID sepcified in+-- RFC 4122.+--+-- Returns nothing if the hardware MAC address could not+-- be discovered.+nextUUID :: IO (Maybe UUID)+nextUUID = do+  res <- stepTime+  mac <- mac+  case (res, mac) of+    (Just (c, t), Just (MAC a' b' c' d' e' f')) -> do+      let+        (tL, tM, tH) = word64ToTimePieces t+        (cL, cH) = word16ToClockSeqPieces c+      return $ Just $ UUID tL tM tH cH cL $ Node a' b' c' d' e' f'+    _ -> return Nothing+++-- |The bit layout and version number here used are described in clause 13 of+--  ITU X.667, from September 2004.+word64ToTimePieces :: Word64 -> (Word32, Word16, Word16) +word64ToTimePieces w = (lo, mi, hi) + where+  lo = fromIntegral $ (w `shiftL` 32) `shiftR` 32+  mi = fromIntegral $ (w `shiftL` 16) `shiftR` 48+  hi = (fromIntegral $ w `shiftR` 48) `setBit` 15 +++stepTime = do+  State c0 h0 <- readIORef state+  h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+  if h1 > h0 +    then  do+      writeIORef state $ State 0 h1+      return $ Just (0, h1)+    else  do+      let+        c1 = succ c0+      if c1 < 2^14+        then  do+          writeIORef state $ State c1 h0+          return $ Just (c1, h0)+        else  do+          return Nothing+++{-# NOINLINE state #-}+state = unsafePerformIO $ do+  h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+  newIORef $ State 0 h0 +++data State = State+    {-# UNPACK #-} !Word16+    {-# UNPACK #-} !Word64+ deriving (Show)++++hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64+hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt+ where+  gregorianReform = UTCTime (fromGregorian 1582 10 15) 0+  dt = t `diffUTCTime` gregorianReform+++-- |Per clause 13 of ITU X.667, from September 2004.+word16ToClockSeqPieces :: Word16 -> (Word8, Word8)+word16ToClockSeqPieces w = (lo, hi)+ where+  lo = fromIntegral $ (w `shiftL` 8) `shiftR` 8+  hi = (fromIntegral $ w `shiftR` 8) `setBit` 7 ++
+ Data/UUID/V5.hs view
@@ -0,0 +1,101 @@+-- |+-- Module      : Data.UUID.V5+-- Copyright   : (c) 2008 Antoine Latter+--+-- License     : BSD-style+--+-- Maintainer  : aslatter@gmail.com+-- Stability   : experimental+-- Portability : portable+-- +-- +-- This module implements Version 5 UUIDs as specified+-- in RFC 4122.+--+-- These UUIDs identify an object within a namespace,+-- and are deterministic.+--+-- The namespace is identified by a UUID.  Several sample+-- namespaces are enclosed.++module Data.UUID.V5+    (generateNamed+    ,namespaceDNS+    ,namespaceURL+    ,namespaceOID+    ,namespaceX500+    ) where+                    ++import Data.UUID.Internal++import Data.Binary+import Data.Bits+import Data.Maybe++import qualified Data.ByteString.Lazy as BS+import Data.ByteString.Lazy (ByteString)++import qualified Data.Digest.SHA1 as SHA1+++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+--+-- Uses a SHA1 hash.+generateNamed :: UUID    -- ^Namespace+              -> [Word8] -- ^Object+              -> UUID+generateNamed namespace object =+    let chunk = BS.unpack (encode namespace) ++ object+        SHA1.Word160 w1 w2 w3 w4 w5 = SHA1.hash chunk++        tl = w1+        tm = high16 w2+        th = (versionSHA .|.) $ (versionMask .&.) $ low16 w2+        ch = (reserved .|.) $ (reservedMask .&.) $ high8 $ high16 w3+        cl = low8  $ high16 w3+        node = Node (high8 (low16 w3))+                    (low8  (low16 w3))+                    (high8 (high16 w4))+                    (low8 (high16 w4))+                    (high8 (low16 w4))+                    (low8 (low16 w4))+    in UUID tl tm th ch cl node++-- HASH 0  1  - 2  3  : w1+--      4  5  - 6  7  : w2+--      8  9  - 10 11 : w3+--      12 13 - 14 15 : w4+--      16 17 - 18 19 : w5++low16 :: Word32 -> Word16+low16 = fromIntegral . (.&. 0x0000FFFF)++high16 :: Word32 -> Word16+high16 = fromIntegral . flip shiftR 16++low8 :: Word16 -> Word8+low8 = fromIntegral . (.&. 0x00FF)++high8 :: Word16 -> Word8+high8 = fromIntegral . flip shiftR 8++versionSHA = 5 `shiftL` 12++unsafeFromString :: String -> UUID+unsafeFromString = fromJust . fromString++-- |The namespace for DNS addresses+namespaceDNS :: UUID+namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for URLs+namespaceURL :: UUID+namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"++namespaceOID :: UUID+namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"++namespaceX500 :: UUID+namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"
+ Demo.hs view
@@ -0,0 +1,16 @@++-- timing demo++import Data.UUID+import System.Random++newUUID :: IO UUID+newUUID = randomIO++count = 300000++main = sequence_ $ replicate count $ do+         x <- newUUID+         y <- newUUID+         seq (x == y) $ return ()+ 
uuid.cabal view
@@ -1,5 +1,5 @@ Name: uuid-Version: 0.1.1+Version: 1.0.0 Copyright: (c) 2008 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com@@ -11,26 +11,25 @@ Cabal-Version: >= 1.2  Description:- Haskell bindings to libuuid.- .- The library libuuid is available as a part of e2fsprogs:- <http://e2fsprogs.sourceforge.net/>.- .- .  This library is useful for creating, comparing, parsing and  printing Universally Unique Identifiers.  See <http://en.wikipedia.org/wiki/UUID> for the general idea.   Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers +Homepage: http://community.haskell.org/~aslatter/code/uuid/+ Library- Build-Depends: base+ Build-Depends: base, random, binary, bytestring, Crypto, maccatcher,+                time   Exposed-Modules:-   Data.UUID,+   Data.UUID+   Data.UUID.V1+   Data.UUID.V5++ Other-Modules:    Data.UUID.Internal - Extensions: ForeignFunctionInterface+ Extensions: DeriveDataTypeable - if !os(darwin)-  Extra-Libraries: uuid