git.iko.soy/typeable/uuid
on 2d73448 help sign in
typeable/uuid/Data/UUID.hs
225 lines 6.2 kB history raw
1{-# INCLUDE <uuid/uuid.h> #-}
2{-# INCLUDE <string.h> #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
5-- |
6-- Module : Data.UUID
7-- Copyright : (c) 2008 Antoine Latter
8--
9-- License : BSD-style
10--
11-- Maintainer : aslatter@gmail.com
12-- Stability : experimental
13-- Portability : portable
14--
15-- Haskell bindings to /libuuid/.
16-- The library /libuuid/ is available as a part of e2fsprogs:
17-- <http://e2fsprogs.sourceforge.net/>.
18--
19-- This library is useful for creating, comparing, parsing and
20-- printing Universally Unique Identifiers.
21-- See <http://en.wikipedia.org/wiki/UUID> for the general idea.
23module Data.UUID(UUID
24 ,fromString
25 ,toString
26 ,toStringUpper
27 ,toStringLower
28 ,generate
29 ,generateRandom
30 ,generateTime
31 ,null
32 )
33where
35import Foreign.C.String
36import Foreign.C
37import Foreign.ForeignPtr
38import Foreign
40import Data.Typeable
41import Data.Generics.Basics
43import Prelude hiding (null)
45import Data.UUID.Internal
47instance Eq UUID where
48 a == b = compare a b == EQ
50instance Ord UUID where
51 compare (U fp1) (U fp2) = unsafePerformIO $
52 withForeignPtr fp1 $ \p1 ->
53 withForeignPtr fp2 $ \p2 ->
54 case c_compare p1 p2 of
55 0 -> return EQ
56 n|n<0 -> return LT
57 |n>0 -> return GT
59instance Show UUID where
60 show = toString
62instance Read UUID where
63 readsPrec _ str = case fromString (take 36 str) of
64 Nothing -> []
65 Just u -> [(u,drop 36 str)]
67instance Typeable UUID where
68 typeOf _ = mkTyConApp (mkTyCon "Data.UUID.UUID") []
70instance Storable UUID where
71 sizeOf _ = (16 *) $ alignment (undefined :: CChar)
72 alignment _ = alignment (undefined :: CChar)
74 peek psource = do
75 fp <- mallocForeignPtrArray 16
76 withForeignPtr fp $ \pdest ->
77 memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
78 return $ U fp
80 poke pdest (U fp) = withForeignPtr fp $ \psource ->
81 memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
84-- My goal with this instance was to make it work just enough to do what
85-- I want when used with the HStringTemplate library.
86instance Data UUID where
87 toConstr uu = mkConstr uuidType (show uu) [] (error "fixity")
88 gunfold _ _ = error "gunfold"
89 dataTypeOf _ = uuidType
91uuidType = mkNorepType "Data.UUID.UUID"
94-- |Creates a new 'UUID'. If \/dev\/urandom is available, it will be used.
95-- Otherwise a UUID will be generated based on the current time and the
96-- hardware MAC address, if available.
97generate :: IO UUID
98generate = do
99 fp <- mallocForeignPtrArray 16
100 withForeignPtr fp $ \p -> c_generate p
101 return $ U fp
103-- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used.
104-- Otherwise a psuedorandom generator will be used.
105generateRandom :: IO UUID
106generateRandom = do
107 fp <- mallocForeignPtrArray 16
108 withForeignPtr fp $ \p -> c_generate_random p
109 return $ U fp
111-- |Create a new 'UUID'. The UUID will be generated based on the
112-- current time and the hardware MAC address, if available.
113generateTime :: IO UUID
114generateTime = do
115 fp <- mallocForeignPtrArray 16
116 withForeignPtr fp $ \p -> c_generate_time p
117 return $ U fp
119-- |Returns 'True' if the passed-in 'UUID' is the null UUID.
120null :: UUID -> Bool
121null (U fp) = unsafePerformIO $
122 withForeignPtr fp $ \p ->
123 return $ c_null p == 1
125-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
126-- The hyphens may not be omitted.
127-- Example:
128--
129-- @
130-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
131-- @
132--
133-- Hex digits may be upper or lower-case.
134fromString :: String -> Maybe UUID
135fromString s = unsafePerformIO $ do
136 fp <- mallocForeignPtrArray 16
137 res <- withCAString s $ \chars ->
138 withForeignPtr fp $ \p ->
139 c_read (castPtr chars) p
140 case res of
141 0 -> return . Just $ U fp
142 _ -> return Nothing
144-- |Returns a 'String' representation of the passed in 'UUID'.
145-- Hex digits occuring in the output will be either upper or
146-- lower-case depending on system defaults and locale.
147toString :: UUID -> String
148toString (U fp) = unsafePerformIO $ do
149 chars <- mallocBytes 37
150 withForeignPtr fp $ \p -> c_show p chars
151 st <- peekCAString chars
152 free chars
153 return st
155-- |Returns a 'String' representation of the passed in 'UUID'.
156-- Hex digits occuring in the output will be lower-case.
157toStringLower :: UUID -> String
158toStringLower (U fp) = unsafePerformIO $ do
159 chars <- mallocBytes 37
160 withForeignPtr fp $ \p -> c_show_lower p chars
161 st <- peekCAString chars
162 free chars
163 return st
165-- |Returns a 'String' representation of the passed in 'UUID'.
166-- Hex digits occuring in the output will be upper-case.
167toStringUpper :: UUID -> String
168toStringUpper (U fp) = unsafePerformIO $ do
169 chars <- mallocBytes 37
170 withForeignPtr fp $ \p -> c_show_upper p chars
171 st <- peekCAString chars
172 free chars
173 return st
176-- FFI calls to do the work
178type C_UUID = Ptr CChar
180-- comparing UUIDs
181foreign import ccall unsafe "uuid_compare"
182 c_compare :: C_UUID -> C_UUID -> CInt
184-- making random UUIDs
185foreign import ccall unsafe "uuid_generate"
186 c_generate :: C_UUID -> IO ()
188foreign import ccall unsafe "uuid_generate_time"
189 c_generate_time :: C_UUID -> IO ()
191foreign import ccall unsafe "uuid_generate_random"
192 c_generate_random :: C_UUID -> IO ()
194-- Null check
195foreign import ccall unsafe "uuid_is_null"
196 c_null :: C_UUID -> CInt
198-- Parsing
199foreign import ccall unsafe "uuid_parse"
200 c_read :: CString -> C_UUID ->IO CInt
202-- Showing
204foreign import ccall unsafe "uuid_unparse"
205 c_show :: C_UUID -> CString -> IO ()
207foreign import ccall unsafe "uuid_unparse_lower"
208 c_show_lower :: C_UUID -> CString -> IO ()
210foreign import ccall unsafe "uuid_unparse_upper"
211 c_show_upper :: C_UUID -> CString -> IO ()
214-- Queries
216foreign import ccall unsafe "uuid_type"
217 c_type :: C_UUID -> CInt
219foreign import ccall unsafe "uuid_variant"
220 c_variant :: C_UUID -> CInt
222-- Other
224foreign import ccall unsafe "memcpy"
225 memcpy :: Ptr a -> Ptr b -> CSize -> IO ()