git.iko.soy/typeable/uuid
on master help sign in
initial commit
10d0badaslatter
Data/UUID.hsnew file+170
compare with master
unifiedsplit
@@ -0,0 +1,170 @@
1+{-# INCLUDE "cbits.h" #-}
2+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
3+
4+module Data.UUID(UUID
5+ ,fromString
6+ ,toString
7+ ,toStringUpper
8+ ,toStringLower
9+ ,generate
10+ ,generateRandom
11+ ,generateTime
12+ ,null
13+ )
14+where
15+
16+import Foreign.C.String
17+import Foreign.C
18+import Foreign
19+
20+import Data.Char
21+
22+import Prelude hiding (null)
23+
24+#if defined(__GLASGOW_HASKELL__)
25+import GHC.Base (unsafeChr)
26+#endif
27+
28+newtype UUID = U C_UUID
29+
30+type C_UUID = Ptr ()
31+
32+instance Eq UUID where
33+ (U a) == (U b) = c_compare a b == 0
34+
35+instance Ord UUID where
36+ compare (U p1) (U p2) =
37+ case c_compare p1 p2 of
38+ 0 -> EQ
39+ n|n<0 -> LT
40+ |n>0 -> GT
41+
42+instance Show UUID where
43+ show = toString
44+
45+generate :: IO UUID
46+generate = do
47+ p <- mallocBytes 16
48+ c_generate p
49+ return $ U p
50+
51+generateRandom :: IO UUID
52+generateRandom = do
53+ p <- mallocBytes 16
54+ c_generate_random p
55+ return $ U p
56+
57+generateTime :: IO UUID
58+generateTime = do
59+ p <- mallocBytes 16
60+ c_generate_time p
61+ return $ U p
62+
63+null :: UUID -> Bool
64+null (U p) = c_null p /= 0
65+
66+fromString :: String -> Maybe UUID
67+fromString s = unsafePerformIO $ do
68+ p <- mallocBytes 16
69+ chars <- mallocBytes 37
70+ pack 0 s chars
71+ res <- c_read p (castPtr chars)
72+ case res of
73+ 0 -> return . Just $ U p
74+ _ -> return Nothing
75+
76+pack :: Int -> String -> Ptr Word8 -> IO ()
77+pack 37 _ p = pokeByteOff p 37 (0 :: Word8)
78+pack n (c:cs) p = do
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+
93+toString :: UUID -> String
94+toString (U p) = unsafePerformIO $ do
95+ chars <- mallocBytes 37
96+ c_show p chars
97+ unpack (castPtr chars) 0
98+
99+toStringLower :: UUID -> String
100+toStringLower (U p) = unsafePerformIO $ do
101+ chars <- mallocBytes 37
102+ c_show_lower p chars
103+ unpack (castPtr chars) 0
104+
105+toStringUpper :: UUID -> String
106+toStringUpper (U p) = unsafePerformIO $ do
107+ chars <- mallocBytes 37
108+ c_show_upper p chars
109+ unpack (castPtr chars) 0
110+
111+-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.
112+-- Shamelessly stolen from the 'bytestring' package.
113+w2c :: Word8 -> Char
114+#if !defined(__GLASGOW_HASKELL__)
115+w2c = chr . fromIntegral
116+#else
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+
129+-- comparing UUIDs
130+foreign import ccall unsafe "c_compare"
131+ c_compare :: C_UUID -> C_UUID -> CInt
132+
133+-- making random UUIDs
134+foreign import ccall unsafe "c_generate"
135+ c_generate :: C_UUID -> IO ()
136+
137+foreign import ccall unsafe "c_generate_time"
138+ c_generate_time :: C_UUID -> IO ()
139+
140+foreign import ccall unsafe "c_generate_random"
141+ c_generate_random :: C_UUID -> IO ()
142+
143+-- Null check
144+foreign import ccall unsafe "c_null"
145+ c_null :: C_UUID -> CInt
146+
147+
148+-- Parsing
149+foreign import ccall unsafe "c_read"
150+ c_read :: C_UUID -> CString ->IO CInt
151+
152+-- Showing
153+
154+foreign import ccall unsafe "c_show"
155+ c_show :: C_UUID -> CString -> IO ()
156+
157+foreign import ccall unsafe "c_show_lower"
158+ c_show_lower :: C_UUID -> CString -> IO ()
159+
160+foreign import ccall unsafe "c_show_upper"
161+ c_show_upper :: C_UUID -> CString -> IO ()
162+
163+
164+-- Queries
165+
166+foreign import ccall unsafe "c_type"
167+ c_type :: C_UUID -> CInt
168+
169+foreign import ccall unsafe "c_variant"
170+ c_variant :: C_UUID -> CInt
Setup.hsnew file+4
@@ -0,0 +1,4 @@
1+import Distribution.Simple
2+main :: IO ()
3+main = defaultMain
4+
cbits.cnew file+61
@@ -0,0 +1,61 @@
1+#include <uuid/uuid.h>
2+#include "cbits.h"
3+
4+int c_compare(uuid_t *a, uuid_t *b)
5+{
6+ return uuid_compare(&a,&b);
7+}
8+
9+
10+void c_generate(uuid_t *out)
11+{
12+ return uuid_generate(&out);
13+}
14+
15+void c_generate_time(uuid_t *out)
16+{
17+ return uuid_generate_time(&out);
18+}
19+
20+void c_generate_random(uuid_t *out)
21+{
22+ return uuid_generate_random(&out);
23+}
24+
25+
26+int c_null(uuid_t *u)
27+{
28+ return uuid_is_null(&u);
29+}
30+
31+
32+int c_read(uuid_t *out,char *in)
33+{
34+ return uuid_parse(in, &out);
35+}
36+
37+void c_show(uuid_t *in, char *out)
38+{
39+ return uuid_unparse(&in,out);
40+}
41+
42+void c_show_lower(uuid_t *in, char *out)
43+{
44+ return uuid_unparse_lower(&in,out);
45+}
46+
47+void c_show_upper(uuid_t *in, char *out)
48+{
49+ return uuid_unparse_upper(&in,out);
50+}
51+
52+
53+int c_type(uuid_t *u)
54+{
55+ return uuid_type(&u);
56+}
57+
58+int c_variant(uuid_t *u)
59+{
60+ return uuid_variant(&u);
61+}
cbits.hnew file+25
@@ -0,0 +1,25 @@
1+
2+
3+#ifndef __HASKELL_UUID_H
4+#define __HASKELL_UUID_H
5+
6+#include <uuid/uuid.h>
7+
8+int c_compare(uuid_t *a, uuid_t *b);
9+
10+void c_generate(uuid_t *out);
11+void c_generate_time(uuid_t *out);
12+void c_generate_random(uuid_t *out);
13+
14+int c_null(uuid_t *u);
15+
16+int c_read(uuid_t *out,char *in);
17+
18+void c_show(uuid_t *in, char *out);
19+void c_show_lower(uuid_t *in, char *out);
20+void c_show_upper(uuid_t *in, char *out);
21+
22+int c_type(uuid_t *u);
23+int c_variant(uuid_t *u);
24+
25+#endif //__HASKELL_UUID_H
uuid.cabalnew file+22
@@ -0,0 +1,22 @@
1+Name: uuid
2+Version: 0.0.0
3+Copyright: 2008, Antoine Latter
4+Author: Antoine Latter
5+Maintainer: aslatter@gmail.com
6+
7+Category: Data
8+Build-Type: Simple
9+
10+Library
11+ Build-Depends: base
12+
13+ Exposed-Modules:
14+ Data.UUID
15+
16+ Extensions: ForeignFunctionInterface
17+
18+ extra-libraries: uuid
19+ c-sources: cbits.c
20+ includes: cbits.h
21+
22+