git.iko.soy/typeable/uuid
on cebcaa2 help sign in
typeable/uuid/Data/UUID.hs
204 lines 5.6 kB history raw
1{-# INCLUDE <uuid/uuid.h> #-}
2{-# INCLUDE <string.h> #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
5-- |Haskell bindings to /libuuid/.
6-- The library /libuuid/ is available as a part of e2fsprogs:
7-- <http://e2fsprogs.sourceforge.net/>.
8--
9-- This library is useful for creating, comparing, parsing and
10-- printing Universally Unique Identifiers.
11-- See <http://en.wikipedia.org/wiki/UUID> for the general idea.
13module Data.UUID(UUID
14 ,fromString
15 ,toString
16 ,toStringUpper
17 ,toStringLower
18 ,generate
19 ,generateRandom
20 ,generateTime
21 ,null
22 )
23where
25import Foreign.C.String
26import Foreign.C
27import Foreign.ForeignPtr
28import Foreign
30import Data.Typeable
32import Prelude hiding (null)
34import Data.UUID.Internal
36instance Eq UUID where
37 a == b = compare a b == EQ
39instance Ord UUID where
40 compare (U fp1) (U fp2) = unsafePerformIO $
41 withForeignPtr fp1 $ \p1 ->
42 withForeignPtr fp2 $ \p2 ->
43 case c_compare p1 p2 of
44 0 -> return EQ
45 n|n<0 -> return LT
46 |n>0 -> return GT
48instance Show UUID where
49 show = toString
51instance Read UUID where
52 readsPrec _ str = case fromString (take 36 str) of
53 Nothing -> []
54 Just u -> [(u,drop 36 str)]
56instance Typeable UUID where
57 typeOf _ = mkTyConApp (mkTyCon "Data.UUID.UUID") []
59instance Storable UUID where
60 sizeOf _ = (16 *) $ alignment (undefined :: CChar)
61 alignment _ = alignment (undefined :: CChar)
63 peek psource = do
64 fp <- mallocForeignPtrArray 16
65 withForeignPtr fp $ \pdest ->
66 memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
67 return $ U fp
69 poke pdest (U fp) = withForeignPtr fp $ \psource ->
70 memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
73-- |Creates a new 'UUID'. If \/dev\/urandom is available, it will be used.
74-- Otherwise a UUID will be generated based on the current time and the
75-- hardware MAC address, if available.
76generate :: IO UUID
77generate = do
78 fp <- mallocForeignPtrArray 16
79 withForeignPtr fp $ \p -> c_generate p
80 return $ U fp
82-- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used.
83-- Otherwise a psuedorandom generator will be used.
84generateRandom :: IO UUID
85generateRandom = do
86 fp <- mallocForeignPtrArray 16
87 withForeignPtr fp $ \p -> c_generate_random p
88 return $ U fp
90-- |Create a new 'UUID'. The UUID will be generated based on the
91-- current time and the hardware MAC address, if available.
92generateTime :: IO UUID
93generateTime = do
94 fp <- mallocForeignPtrArray 16
95 withForeignPtr fp $ \p -> c_generate_time p
96 return $ U fp
98-- |Returns 'True' if the passed-in 'UUID' is the null UUID.
99null :: UUID -> Bool
100null (U fp) = unsafePerformIO $
101 withForeignPtr fp $ \p ->
102 return $ c_null p == 1
104-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
105-- The hyphens may not be ommited.
106-- Example:
107--
108-- @
109-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
110-- @
111--
112-- Hex digits may be upper or lower-case.
113fromString :: String -> Maybe UUID
114fromString s = unsafePerformIO $ do
115 fp <- mallocForeignPtrArray 16
116 res <- withCString s $ \chars ->
117 withForeignPtr fp $ \p ->
118 c_read (castPtr chars) p
119 case res of
120 0 -> return . Just $ U fp
121 _ -> return Nothing
123-- |Returns a 'String' representation of the passed in 'UUID'.
124-- Hex digits occuring in the output will be either upper or
125-- lower-case depending on system defaults and locale.
126toString :: UUID -> String
127toString (U fp) = unsafePerformIO $ do
128 chars <- mallocBytes 37
129 withForeignPtr fp $ \p -> c_show p chars
130 st <- peekCString chars
131 free chars
132 return st
134-- |Returns a 'String' representation of the passed in 'UUID'.
135-- Hex digits occuring in the output will be lower-case.
136toStringLower :: UUID -> String
137toStringLower (U fp) = unsafePerformIO $ do
138 chars <- mallocBytes 37
139 withForeignPtr fp $ \p -> c_show_lower p chars
140 st <- peekCString chars
141 free chars
142 return st
144-- |Returns a 'String' representation of the passed in 'UUID'.
145-- Hex digits occuring in the output will be upper-case.
146toStringUpper :: UUID -> String
147toStringUpper (U fp) = unsafePerformIO $ do
148 chars <- mallocBytes 37
149 withForeignPtr fp $ \p -> c_show_upper p chars
150 st <- peekCString chars
151 free chars
152 return st
155-- FFI calls to do the work
157type C_UUID = Ptr CChar
159-- comparing UUIDs
160foreign import ccall unsafe "uuid_compare"
161 c_compare :: C_UUID -> C_UUID -> CInt
163-- making random UUIDs
164foreign import ccall unsafe "uuid_generate"
165 c_generate :: C_UUID -> IO ()
167foreign import ccall unsafe "uuid_generate_time"
168 c_generate_time :: C_UUID -> IO ()
170foreign import ccall unsafe "uuid_generate_random"
171 c_generate_random :: C_UUID -> IO ()
173-- Null check
174foreign import ccall unsafe "uuid_is_null"
175 c_null :: C_UUID -> CInt
177-- Parsing
178foreign import ccall unsafe "uuid_parse"
179 c_read :: CString -> C_UUID ->IO CInt
181-- Showing
183foreign import ccall unsafe "uuid_unparse"
184 c_show :: C_UUID -> CString -> IO ()
186foreign import ccall unsafe "uuid_unparse_lower"
187 c_show_lower :: C_UUID -> CString -> IO ()
189foreign import ccall unsafe "uuid_unparse_upper"
190 c_show_upper :: C_UUID -> CString -> IO ()
193-- Queries
195foreign import ccall unsafe "uuid_type"
196 c_type :: C_UUID -> CInt
198foreign import ccall unsafe "uuid_variant"
199 c_variant :: C_UUID -> CInt
201-- Other
203foreign import ccall unsafe "memcpy"
204 memcpy :: Ptr a -> Ptr b -> CSize -> IO ()