module Data.UUID(UUID
,fromString
,toString
,toStringUpper
,toStringLower
,generate
,generateRandom
,generateTime
,null
)
where
import Foreign.C.String
import Foreign.C
import Foreign.ForeignPtr
import Foreign
import Data.Typeable
import Data.Generics.Basics
import Prelude hiding (null)
import Data.UUID.Internal
instance Eq UUID where
a == b = compare a b == EQ
instance Ord UUID where
compare (U fp1) (U fp2) = unsafePerformIO $
withForeignPtr fp1 $ \p1 ->
withForeignPtr fp2 $ \p2 ->
case c_compare p1 p2 of
0 -> return EQ
n|n<0 -> return LT
|n>0 -> return GT
instance Show UUID where
show = toString
instance Read UUID where
readsPrec _ str = case fromString (take 36 str) of
Nothing -> []
Just u -> [(u,drop 36 str)]
instance Typeable UUID where
typeOf _ = mkTyConApp (mkTyCon "Data.UUID.UUID") []
instance Storable UUID where
sizeOf _ = (16 *) $ alignment (undefined :: CChar)
alignment _ = alignment (undefined :: CChar)
peek psource = do
fp <- mallocForeignPtrArray 16
withForeignPtr fp $ \pdest ->
memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
return $ U fp
poke pdest (U fp) = withForeignPtr fp $ \psource ->
memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID)
instance Data UUID where
toConstr uu = mkConstr uuidType (show uu) [] (error "fixity")
gunfold _ _ = error "gunfold"
dataTypeOf _ = uuidType
uuidType = mkNorepType "Data.UUID.UUID"
generate :: IO UUID
generate = do
fp <- mallocForeignPtrArray 16
withForeignPtr fp $ \p -> c_generate p
return $ U fp
generateRandom :: IO UUID
generateRandom = do
fp <- mallocForeignPtrArray 16
withForeignPtr fp $ \p -> c_generate_random p
return $ U fp
generateTime :: IO UUID
generateTime = do
fp <- mallocForeignPtrArray 16
withForeignPtr fp $ \p -> c_generate_time p
return $ U fp
null :: UUID -> Bool
null (U fp) = unsafePerformIO $
withForeignPtr fp $ \p ->
return $ c_null p == 1
fromString :: String -> Maybe UUID
fromString s = unsafePerformIO $ do
fp <- mallocForeignPtrArray 16
res <- withCAString s $ \chars ->
withForeignPtr fp $ \p ->
c_read (castPtr chars) p
case res of
0 -> return . Just $ U fp
_ -> return Nothing
toString :: UUID -> String
toString (U fp) = unsafePerformIO $ do
chars <- mallocBytes 37
withForeignPtr fp $ \p -> c_show p chars
st <- peekCAString chars
free chars
return st
toStringLower :: UUID -> String
toStringLower (U fp) = unsafePerformIO $ do
chars <- mallocBytes 37
withForeignPtr fp $ \p -> c_show_lower p chars
st <- peekCAString chars
free chars
return st
toStringUpper :: UUID -> String
toStringUpper (U fp) = unsafePerformIO $ do
chars <- mallocBytes 37
withForeignPtr fp $ \p -> c_show_upper p chars
st <- peekCAString chars
free chars
return st
type C_UUID = Ptr CChar
foreign import ccall unsafe "uuid_compare"
c_compare :: C_UUID -> C_UUID -> CInt
foreign import ccall unsafe "uuid_generate"
c_generate :: C_UUID -> IO ()
foreign import ccall unsafe "uuid_generate_time"
c_generate_time :: C_UUID -> IO ()
foreign import ccall unsafe "uuid_generate_random"
c_generate_random :: C_UUID -> IO ()
foreign import ccall unsafe "uuid_is_null"
c_null :: C_UUID -> CInt
foreign import ccall unsafe "uuid_parse"
c_read :: CString -> C_UUID ->IO CInt
foreign import ccall unsafe "uuid_unparse"
c_show :: C_UUID -> CString -> IO ()
foreign import ccall unsafe "uuid_unparse_lower"
c_show_lower :: C_UUID -> CString -> IO ()
foreign import ccall unsafe "uuid_unparse_upper"
c_show_upper :: C_UUID -> CString -> IO ()
foreign import ccall unsafe "uuid_type"
c_type :: C_UUID -> CInt
foreign import ccall unsafe "uuid_variant"
c_variant :: C_UUID -> CInt
foreign import ccall unsafe "memcpy"
memcpy :: Ptr a -> Ptr b -> CSize -> IO ()