git.iko.soy/typeable/uuid
on master help sign in
docs + cleanup
5b263a5aslatter
Data/UUID.hs+99−90
compare with master
unifiedsplit
@@ -1,5 +1,13 @@
1−{-# INCLUDE "cbits.h" #-}
1+{-# INCLUDE <uuid/uuid.h> #-}
2−{-# LANGUAGE ForeignFunctionInterface, CPP #-}
2+{-# LANGUAGE ForeignFunctionInterface #-}
3+
4+-- |Haskell bindings to /libuuid/.
5+-- The library /libuuid/ is available as a part of e2fsprogs:
6+-- <http://e2fsprogs.sourceforge.net/>.
7+--
8+-- This library is useful for creating, comparing, parsing and
9+-- printing Universally Unique Identifiers.
10+-- See <http://en.wikipedia.org/wiki/UUID> for the general idea.
3
11
4module Data.UUID(UUID
12module Data.UUID(UUID
5 ,fromString
13 ,fromString
@@ -15,156 +23,157 @@ where
15
23
16import Foreign.C.String
24import Foreign.C.String
17import Foreign.C
25import Foreign.C
26+import Foreign.ForeignPtr
18import Foreign
27import Foreign
19
28
20−import Data.Char
21−
22import Prelude hiding (null)
29import Prelude hiding (null)
23
30
24−#if defined(__GLASGOW_HASKELL__)
31+import Data.UUID.Internal
25−import GHC.Base (unsafeChr)
26−#endif
27−
28−newtype UUID = U C_UUID
29−
30−type C_UUID = Ptr ()
31
32
32instance Eq UUID where
33instance Eq UUID where
33− (U a) == (U b) = c_compare a b == 0
34+ a == b = compare a b == EQ
34
35
35instance Ord UUID where
36instance Ord UUID where
36− compare (U p1) (U p2) =
37+ compare (U fp1) (U fp2) = unsafePerformIO $
38+ withForeignPtr fp1 $ \p1 ->
39+ withForeignPtr fp2 $ \p2 ->
37 case c_compare p1 p2 of
40 case c_compare p1 p2 of
38− 0 -> EQ
41+ 0 -> return EQ
39− n|n<0 -> LT
42+ n|n<0 -> return LT
40− |n>0 -> GT
43+ |n>0 -> return GT
41
44
42instance Show UUID where
45instance Show UUID where
43 show = toString
46 show = toString
44
47
48+instance Read UUID where
49+ readsPrec _ str = case fromString (take 36 str) of
50+ Nothing -> []
51+ Just u -> [(u,drop 36 str)]
52+
53+-- |Creates a new 'UUID'. If \/dev\/urandom is available, it will be used.
54+-- Otherwise a UUID will be generated based on the current time and the
55+-- hardware MAC address, if available.
45generate :: IO UUID
56generate :: IO UUID
46generate = do
57generate = do
47− p <- mallocBytes 16
58+ fp <- mallocForeignPtrArray 16
48− c_generate p
59+ withForeignPtr fp $ \p -> c_generate p
49− return $ U p
60+ return $ U fp
50
61
62+-- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used.
63+-- Otherwise a psuedorandom generator will be used.
51generateRandom :: IO UUID
64generateRandom :: IO UUID
52generateRandom = do
65generateRandom = do
53− p <- mallocBytes 16
66+ fp <- mallocForeignPtrArray 16
54− c_generate_random p
67+ withForeignPtr fp $ \p -> c_generate_random p
55− return $ U p
68+ return $ U fp
56
69
70+-- |Create a new 'UUID'. The UUID will be generated based on the
71+-- current time and the hardware MAC address, if available.
57generateTime :: IO UUID
72generateTime :: IO UUID
58generateTime = do
73generateTime = do
59− p <- mallocBytes 16
74+ fp <- mallocForeignPtrArray 16
60− c_generate_time p
75+ withForeignPtr fp $ \p -> c_generate_time p
61− return $ U p
76+ return $ U fp
62
77
78+-- |Returns 'True' if the passed-in 'UUID' is the null UUID.
63null :: UUID -> Bool
79null :: UUID -> Bool
80+null (U fp) = unsafePerformIO $
81+ withForeignPtr fp $ \p ->
64−null (U p) = c_null p /= 0
82+ return $ c_null p == 1
65−
83+
84+-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
85+-- The hyphens may not be ommited.
86+-- Example:
87+--
88+-- @
89+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
90+-- @
91+--
92+-- Hex digits may be upper or lower-case.
66fromString :: String -> Maybe UUID
93fromString :: String -> Maybe UUID
67fromString s = unsafePerformIO $ do
94fromString s = unsafePerformIO $ do
68− p <- mallocBytes 16
95+ fp <- mallocForeignPtrArray 16
69− chars <- mallocBytes 37
96+ res <- withCString s $ \chars ->
70− pack 0 s chars
97+ withForeignPtr fp $ \p ->
71− res <- c_read p (castPtr chars)
98+ c_read (castPtr chars) p
72 case res of
99 case res of
73− 0 -> return . Just $ U p
100+ 0 -> return . Just $ U fp
74 _ -> return Nothing
101 _ -> return Nothing
75
102
76−pack :: Int -> String -> Ptr Word8 -> IO ()
103+-- |Returns a 'String' representation of the passed in UUID.
77−pack 37 _ p = pokeByteOff p 37 (0 :: Word8)
104+-- Hex digits occuring in the output will be either upper or
78−pack n (c:cs) p = do
105+-- lower-case depending on system defaults and locale.
79− pokeByteOff p n (c2w c)
80− pack (n+1) cs p
81−pack n [] p = pokeByteOff p n (0 :: Word8)
82−
83−unpack :: Ptr Word8 -> Int -> IO String
84−unpack p 37 = return []
85−unpack p n = do
86− c <- peekByteOff p n
87− case c of
88− 0 -> return []
89− _ -> do
90− cs <- unpack p (n+1)
91− return $ (w2c c) : cs
92−
93toString :: UUID -> String
106toString :: UUID -> String
94−toString (U p) = unsafePerformIO $ do
107+toString (U fp) = unsafePerformIO $ do
95 chars <- mallocBytes 37
108 chars <- mallocBytes 37
96− c_show p chars
109+ withForeignPtr fp $ \p -> c_show p chars
97− unpack (castPtr chars) 0
110+ st <- peekCString chars
111+ free chars
112+ return st
98
113
114+-- |Returns a 'String' representation of the passed in UUID.
115+-- Hex digits occuring in the output will be lower-case.
99toStringLower :: UUID -> String
116toStringLower :: UUID -> String
100−toStringLower (U p) = unsafePerformIO $ do
117+toStringLower (U fp) = unsafePerformIO $ do
101 chars <- mallocBytes 37
118 chars <- mallocBytes 37
102− c_show_lower p chars
119+ withForeignPtr fp $ \p -> c_show_lower p chars
103− unpack (castPtr chars) 0
120+ st <- peekCString chars
104−
121+ free chars
122+ return st
123+
124+-- |Returns a 'String' representation of the passed in UUID.
125+-- Hex digits occuring in the output will be upper-case.
105toStringUpper :: UUID -> String
126toStringUpper :: UUID -> String
106−toStringUpper (U p) = unsafePerformIO $ do
127+toStringUpper (U fp) = unsafePerformIO $ do
107 chars <- mallocBytes 37
128 chars <- mallocBytes 37
108− c_show_upper p chars
129+ withForeignPtr fp $ \p -> c_show_upper p chars
109− unpack (castPtr chars) 0
130+ st <- peekCString chars
110−
131+ free chars
111−-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.
132+ return st
112−-- Shamelessly stolen from the 'bytestring' package.
133+
113−w2c :: Word8 -> Char
134+
114−#if !defined(__GLASGOW_HASKELL__)
135+-- FFI calls to do the work
115−w2c = chr . fromIntegral
136+
116−#else
137+type C_UUID = Ptr CChar
117−w2c = unsafeChr . fromIntegral
118−#endif
119−{-# INLINE w2c #-}
120−
121−-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and
122−-- silently truncates to 8 bits Chars > '\255'. It is provided as
123−-- convenience for ByteString construction.
124−-- Shamelessly stolen from the 'bytestring' package.
125−c2w :: Char -> Word8
126−c2w = fromIntegral . ord
127−{-# INLINE c2w #-}
128
138
129-- comparing UUIDs
139-- comparing UUIDs
130−foreign import ccall unsafe "c_compare"
140+foreign import ccall unsafe "uuid_compare"
131 c_compare :: C_UUID -> C_UUID -> CInt
141 c_compare :: C_UUID -> C_UUID -> CInt
132
142
133-- making random UUIDs
143-- making random UUIDs
134−foreign import ccall unsafe "c_generate"
144+foreign import ccall unsafe "uuid_generate"
135 c_generate :: C_UUID -> IO ()
145 c_generate :: C_UUID -> IO ()
136
146
137−foreign import ccall unsafe "c_generate_time"
147+foreign import ccall unsafe "uuid_generate_time"
138 c_generate_time :: C_UUID -> IO ()
148 c_generate_time :: C_UUID -> IO ()
139
149
140−foreign import ccall unsafe "c_generate_random"
150+foreign import ccall unsafe "uuid_generate_random"
141 c_generate_random :: C_UUID -> IO ()
151 c_generate_random :: C_UUID -> IO ()
142
152
143-- Null check
153-- Null check
144−foreign import ccall unsafe "c_null"
154+foreign import ccall unsafe "uuid_is_null"
145 c_null :: C_UUID -> CInt
155 c_null :: C_UUID -> CInt
146
156
147−
148-- Parsing
157-- Parsing
149−foreign import ccall unsafe "c_read"
158+foreign import ccall unsafe "uuid_parse"
150− c_read :: C_UUID -> CString ->IO CInt
159+ c_read :: CString -> C_UUID ->IO CInt
151
160
152-- Showing
161-- Showing
153
162
154−foreign import ccall unsafe "c_show"
163+foreign import ccall unsafe "uuid_unparse"
155 c_show :: C_UUID -> CString -> IO ()
164 c_show :: C_UUID -> CString -> IO ()
156
165
157−foreign import ccall unsafe "c_show_lower"
166+foreign import ccall unsafe "uuid_unparse_lower"
158 c_show_lower :: C_UUID -> CString -> IO ()
167 c_show_lower :: C_UUID -> CString -> IO ()
159
168
160−foreign import ccall unsafe "c_show_upper"
169+foreign import ccall unsafe "uuid_unparse_upper"
161 c_show_upper :: C_UUID -> CString -> IO ()
170 c_show_upper :: C_UUID -> CString -> IO ()
162
171
163
172
164-- Queries
173-- Queries
165
174
166−foreign import ccall unsafe "c_type"
175+foreign import ccall unsafe "uuid_type"
167 c_type :: C_UUID -> CInt
176 c_type :: C_UUID -> CInt
168
177
169−foreign import ccall unsafe "c_variant"
178+foreign import ccall unsafe "uuid_variant"
170 c_variant :: C_UUID -> CInt
179 c_variant :: C_UUID -> CInt
Data/UUID/Internal.hsnew file+45
@@ -0,0 +1,45 @@
1+module Data.UUID.Internal(UUID(..)
2+ ,toBytes
3+ ,fromBytes
4+ ,unsafeFromBytes
5+ ,toForeignPtr
6+ ,fromForeignPtr
7+ ) where
8+
9+import Foreign.ForeignPtr
10+import Foreign.C
11+import Foreign
12+
13+-- |The UUID type. Represents 128-bits of identification.
14+newtype UUID = U (ForeignPtr CChar)
15+
16+-- |Returns the passed in UUID as a list of 16 bytes.
17+toBytes :: UUID -> [Word8]
18+toBytes (U fp) = unsafePerformIO $ withForeignPtr fp $ \p ->
19+ peekArray 16 (castPtr p)
20+
21+-- |Creates a UUID out of a list of bytes.
22+-- Will throw an error if the list is not of length 16.
23+fromBytes :: [Word8] -> UUID
24+fromBytes xs = if length xs == 16
25+ then unsafeFromBytes xs
26+ else error "Data.UUID.Internal.fromBytes: passed in list of bytes must be of length 16."
27+
28+-- |Creates a UUID out of a list of bytes.
29+-- Does not perform a length check.
30+-- Behavior is undefined for lists not of length 16.
31+unsafeFromBytes :: [Word8] -> UUID
32+unsafeFromBytes xs = U $ castForeignPtr $ unsafePerformIO $ do
33+ p <- mallocForeignPtrBytes 16
34+ withForeignPtr p $ flip pokeArray xs
35+ return p
36+
37+-- |Given a UUID, returns a pointer to the 16 bytes
38+-- of memory that make up the UUID.
39+toForeignPtr :: UUID -> ForeignPtr CChar
40+toForeignPtr (U p) = p
41+
42+-- |The passed in pointer is treated as if it were a pointer
43+-- to 16 bytes of memory. You're in trouble if it isn't.
44+fromForeignPtr :: ForeignPtr CChar -> UUID
45+fromForeignPtr = U
cbits.c+11−11
@@ -3,59 +3,59 @@
3
3
4int c_compare(uuid_t *a, uuid_t *b)
4int c_compare(uuid_t *a, uuid_t *b)
5{
5{
6− return uuid_compare(&a,&b);
6+ return uuid_compare(a,b);
7}
7}
8
8
9
9
10void c_generate(uuid_t *out)
10void c_generate(uuid_t *out)
11{
11{
12− return uuid_generate(&out);
12+ return uuid_generate(out);
13}
13}
14
14
15void c_generate_time(uuid_t *out)
15void c_generate_time(uuid_t *out)
16{
16{
17− return uuid_generate_time(&out);
17+ return uuid_generate_time(out);
18}
18}
19
19
20void c_generate_random(uuid_t *out)
20void c_generate_random(uuid_t *out)
21{
21{
22− return uuid_generate_random(&out);
22+ return uuid_generate_random(out);
23}
23}
24
24
25
25
26int c_null(uuid_t *u)
26int c_null(uuid_t *u)
27{
27{
28− return uuid_is_null(&u);
28+ return uuid_is_null(u);
29}
29}
30
30
31
31
32int c_read(uuid_t *out,char *in)
32int c_read(uuid_t *out,char *in)
33{
33{
34− return uuid_parse(in, &out);
34+ return uuid_parse(*in, out);
35}
35}
36
36
37void c_show(uuid_t *in, char *out)
37void c_show(uuid_t *in, char *out)
38{
38{
39− return uuid_unparse(&in,out);
39+ return uuid_unparse(in,out);
40}
40}
41
41
42void c_show_lower(uuid_t *in, char *out)
42void c_show_lower(uuid_t *in, char *out)
43{
43{
44− return uuid_unparse_lower(&in,out);
44+ return uuid_unparse_lower(in,out);
45}
45}
46
46
47void c_show_upper(uuid_t *in, char *out)
47void c_show_upper(uuid_t *in, char *out)
48{
48{
49− return uuid_unparse_upper(&in,out);
49+ return uuid_unparse_upper(in,out);
50}
50}
51
51
52
52
53int c_type(uuid_t *u)
53int c_type(uuid_t *u)
54{
54{
55− return uuid_type(&u);
55+ return uuid_type(u);
56}
56}
57
57
58int c_variant(uuid_t *u)
58int c_variant(uuid_t *u)
59{
59{
60− return uuid_variant(&u);
60+ return uuid_variant(u);
61}
61}
uuid.cabal+3−3
@@ -11,12 +11,12 @@ Library
11 Build-Depends: base
11 Build-Depends: base
12
12
13 Exposed-Modules:
13 Exposed-Modules:
14− Data.UUID
14+ Data.UUID,
15+ Data.UUID.Internal
15
16
16 Extensions: ForeignFunctionInterface
17 Extensions: ForeignFunctionInterface
17
18
18 extra-libraries: uuid
19 extra-libraries: uuid
19− c-sources: cbits.c
20+
20− includes: cbits.h
21
21
22
22