uuid (empty) → 0.1.0

raw patch · 5 files changed

+348/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

Data/UUID.hs +225/−0
Data/UUID/Internal.hs +59/−0
LICENSE +28/−0
Setup.hs +4/−0
uuid.cabal +32/−0

+ Data/UUID.hs view

@@ -0,0 +1,225 @@+{-# INCLUDE <uuid/uuid.h> #-}+{-# INCLUDE <string.h> #-}+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module      : Data.UUID+-- Copyright   : (c) 2008 Antoine Latter+--+-- License     : BSD-style+--+-- Maintainer  : aslatter@gmail.com+-- 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+-- printing Universally Unique Identifiers.+-- See <http://en.wikipedia.org/wiki/UUID> for the general idea.++module Data.UUID(UUID+                ,fromString+                ,toString+                ,toStringUpper+                ,toStringLower+                ,generate+                ,generateRandom+                ,generateTime+                ,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)++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 = do+  fp <- mallocForeignPtrArray 16+  withForeignPtr fp $ \p -> c_generate p+  return $ U fp++-- |Create a new 'UUID'.  If \/dev\/urandom is available, it will be used.+-- Otherwise a psuedorandom generator will be used.+generateRandom :: IO UUID+generateRandom = do+  fp <- mallocForeignPtrArray 16+  withForeignPtr fp $ \p -> c_generate_random p+  return $ U fp++-- |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 = do +  fp <- mallocForeignPtrArray 16+  withForeignPtr fp $ \p -> c_generate_time 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 (castPtr 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 (U fp) = unsafePerformIO $ do+  chars <- mallocBytes 37+  withForeignPtr fp $ \p -> c_show p chars+  st <- peekCAString chars+  free chars+  return st++-- |Returns a 'String' representation of the passed in 'UUID'.+-- Hex digits occuring in the output will be lower-case.+toStringLower :: UUID -> String+toStringLower (U fp) = unsafePerformIO $ do+  chars <- mallocBytes 37+  withForeignPtr fp $ \p -> c_show_lower p chars+  st <- peekCAString chars+  free chars+  return st+  +-- |Returns a 'String' representation of the passed in 'UUID'.+-- Hex digits occuring in the output will be upper-case.+toStringUpper :: UUID -> String+toStringUpper (U fp) = unsafePerformIO $ do+  chars <- mallocBytes 37+  withForeignPtr fp $ \p -> c_show_upper p chars+  st <- peekCAString chars+  free chars+  return st+++-- 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 ()

+ Data/UUID/Internal.hs view

@@ -0,0 +1,59 @@+-- |+-- Module      : Data.UUID.Internal+-- Copyright   : (c) 2008 Antoine Latter+--+-- License     : BSD-style+--+-- 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++import Foreign.ForeignPtr+import Foreign.C+import Foreign++-- |The UUID type.  Represents 128-bits of identification.+newtype UUID = U (ForeignPtr CChar)++-- |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)++-- |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."++-- |Creates a UUID out of a list of bytes.+-- Does not perform a length check.+-- 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++-- |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++-- |The passed in pointer is treated as if it were a pointer+-- to 16 bytes of memory.  You're in trouble if it isn't.+fromForeignPtr :: ForeignPtr CChar -> UUID+fromForeignPtr = U

+ LICENSE view

@@ -0,0 +1,28 @@+Copyright (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.

+ Setup.hs view

@@ -0,0 +1,4 @@+import Distribution.Simple+main :: IO ()+main = defaultMain+

+ uuid.cabal view

@@ -0,0 +1,32 @@+Name: uuid+Version: 0.1.0+Copyright: 2008, Antoine Latter+Author: Antoine Latter+Maintainer: aslatter@gmail.com+License: BSD3+License-file: LICENSE++Category: Data+Build-Type: Simple+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. ++Library+ Build-Depends: base++ Exposed-Modules:+   Data.UUID,+   Data.UUID.Internal++ Extensions: ForeignFunctionInterface++ Extra-Libraries: uuid