@@ -95,25 +95,22 @@ uuidType = mkNorepType "Data.UUID.UUID"
95-- Otherwise a UUID will be generated based on the current time and the
95-- Otherwise a UUID will be generated based on the current time and the
96-- hardware MAC address, if available.
96-- hardware MAC address, if available.
97generate :: IO UUID
97generate :: IO UUID
98−generate = do
98+generate = generateWrap c_generate
99− fp <- mallocForeignPtrArray 16
100− withForeignPtr fp $ \p -> c_generate p
103-- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used.
100-- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used.
104-- Otherwise a psuedorandom generator will be used.
101-- Otherwise a psuedorandom generator will be used.
105generateRandom :: IO UUID
102generateRandom :: IO UUID
106−generateRandom = do
103+generateRandom = generateWrap c_generate_random
107− fp <- mallocForeignPtrArray 16
108− withForeignPtr fp $ \p -> c_generate_random p
111-- |Create a new 'UUID'. The UUID will be generated based on the
105-- |Create a new 'UUID'. The UUID will be generated based on the
112-- current time and the hardware MAC address, if available.
106-- current time and the hardware MAC address, if available.
113generateTime :: IO UUID
107generateTime :: IO UUID
114−generateTime = do
108+generateTime = generateWrap c_generate_time
110+generateWrap :: (C_UUID -> IO ()) -> IO UUID
111+generateWrap gen = do
115 fp <- mallocForeignPtrArray 16
112 fp <- mallocForeignPtrArray 16
116− withForeignPtr fp $ \p -> c_generate_time p
113+ withForeignPtr fp $ \p -> gen p
117 return $ U fp
114 return $ U fp
119-- |Returns 'True' if the passed-in 'UUID' is the null UUID.
116-- |Returns 'True' if the passed-in 'UUID' is the null UUID.
@@ -136,7 +133,7 @@ fromString s = unsafePerformIO $ do
136 fp <- mallocForeignPtrArray 16
133 fp <- mallocForeignPtrArray 16
137 res <- withCAString s $ \chars ->
134 res <- withCAString s $ \chars ->
138 withForeignPtr fp $ \p ->
135 withForeignPtr fp $ \p ->
139− c_read (castPtr chars) p
136+ c_read chars p
140 case res of
137 case res of
141 0 -> return . Just $ U fp
138 0 -> return . Just $ U fp
142 _ -> return Nothing
139 _ -> return Nothing
@@ -145,33 +142,27 @@ fromString s = unsafePerformIO $ do
145-- Hex digits occuring in the output will be either upper or
142-- Hex digits occuring in the output will be either upper or
146-- lower-case depending on system defaults and locale.
143-- lower-case depending on system defaults and locale.
147toString :: UUID -> String
144toString :: UUID -> String
148−toString (U fp) = unsafePerformIO $ do
145+toString = toStringWrap c_show
149− chars <- mallocBytes 37
150− withForeignPtr fp $ \p -> c_show p chars
151− st <- peekCAString chars
155-- |Returns a 'String' representation of the passed in 'UUID'.
147-- |Returns a 'String' representation of the passed in 'UUID'.
156-- Hex digits occuring in the output will be lower-case.
148-- Hex digits occuring in the output will be lower-case.
157toStringLower :: UUID -> String
149toStringLower :: UUID -> String
158−toStringLower (U fp) = unsafePerformIO $ do
150+toStringLower = toStringWrap c_show_lower
159− chars <- mallocBytes 37
160− withForeignPtr fp $ \p -> c_show_lower p chars
161− st <- peekCAString chars
165-- |Returns a 'String' representation of the passed in 'UUID'.
152-- |Returns a 'String' representation of the passed in 'UUID'.
166-- Hex digits occuring in the output will be upper-case.
153-- Hex digits occuring in the output will be upper-case.
167toStringUpper :: UUID -> String
154toStringUpper :: UUID -> String
155+toStringUpper = toStringWrap c_show_upper
157+-- |The passed in function /f/ is given a the raw UUID data
158+-- and a 37-byte buffer to fill with the textual representation
159+-- of the UUID. The buffer is expected to be null-terminated
160+-- after /f/ is finished.
161+toStringWrap :: (C_UUID -> CString -> IO ()) -> UUID -> String
168−toStringUpper (U fp) = unsafePerformIO $ do
162+toStringWrap f (U fp) = unsafePerformIO $
169− chars <- mallocBytes 37
163+ allocaBytes 37 $ \chars -> do
170− withForeignPtr fp $ \p -> c_show_upper p chars
164+ withForeignPtr fp $ \p -> f p chars
171− st <- peekCAString chars
165+ peekCAString chars
176-- FFI calls to do the work
167-- FFI calls to do the work