ldb-hs: Add some show and parse functions

Jelmer Vernooij jelmer at samba.org
Sun May 11 23:19:02 GMT 2008


Tue Nov 29 17:16:46 CET 2005  Jelmer Vernooij <jelmer at samba.org>
  * Add some show and parse functions

    M ./LDB.chs -15 +37

Tue Nov 29 17:16:46 CET 2005  Jelmer Vernooij <jelmer at samba.org>
  * Add some show and parse functions
diff -rN -u old-ldb-hs/LDB.chs new-ldb-hs/LDB.chs
--- old-ldb-hs/LDB.chs	2008-05-12 01:19:02.000000000 +0200
+++ new-ldb-hs/LDB.chs	2008-05-12 01:19:02.000000000 +0200
@@ -62,21 +62,36 @@
 }
 
 -- Convert from LMessage to Message
-fromLMessage :: LMessage -> Message
+fromLMessage :: LMessage -> IO Message
 fromLMessage = undefined -- FIXME
 
-toLMessage :: Message -> LMessage
+toLMessage :: Message -> IO LMessage
 toLMessage = undefined -- FIXME
 
 data Dn = EmptyDn
 		| Child String String Dn
 		| Special String
 
-fromLDn :: LDn -> Dn
+instance Show Dn where
+	show (Special n) = "@" ++ n
+	show (EmptyDn) = ""
+	show (Child n v p) = n ++ "=" ++ v ++"," ++ (show p)
+
+fromLDn :: LDn -> IO Dn
 fromLDn = undefined -- FIXME
 
-toLDn :: Dn -> LDn
-toLDn = undefined -- FIXME
+toLDn :: Dn -> IO LDn
+toLDn (EmptyDn) = do {#call ldb_dn_new#} nullPtr
+toLDn (Child n v p) = do 
+	name <- newCString n
+	value <- newCString v
+	parent <- toLDn p
+	dn <- {#call ldb_dn_build_child#} nullPtr name value parent
+	free name
+	free value
+	return dn
+toLDn (Special n) = do
+	withCString n $ {#call ldb_dn_explode#} nullPtr
 
 ldbException :: String
 ldbException = "An LDB error occurred"
@@ -85,37 +100,44 @@
 connect url opts = do
 	ctx <- {#call unsafe ldb_init#} nullPtr
 	mem <- newCString url
-	{#call unsafe ldb_connect#} ctx mem 0 undefined
+	{#call unsafe ldb_connect#} ctx mem 0 undefined --FIXME
 	free mem
 	return ctx
 
 search :: Context -> Dn -> Scope -> String -> [String] -> IO [Message]
 search ctx dn sc expr attrs = do
 	mem <- newCString expr
-	{#call unsafe ldb_search#} ctx (toLDn dn) sc mem []
+	lattrs <- undefined
+	lmsg <- undefined
+	ldn <- toLDn dn
+	ret <- {#call unsafe ldb_search#} ctx ldn (fromEnum sc) mem lattrs lmsg
 	free mem
-	return [] -- FIXME
+	return $ map fromLMessage lmsg
 
 add :: Context -> Message -> IO ()
 add ctx msg = do
-	{#call unsafe ldb_add#} ctx $ toLMessage msg
+	lmsg <- toLMessage msg
+	ret <- {#call unsafe ldb_add#} ctx lmsg
 	return ()
 
 modify :: Context -> Message -> IO ()
 modify ctx msg = do
-	{#call unsafe ldb_modify#} ctx $ toLMessage msg
+	lmsg <- toLMessage msg
+	ret <- {#call unsafe ldb_modify#} ctx lmsg
 	return ()
 
 delete :: Context -> Dn -> IO ()
 delete ctx dn = do
-	{#call unsafe ldb_delete#} ctx $ toLDn dn
+	ldn <- toLDn dn
+	ret <- {#call unsafe ldb_delete#} ctx ldn
 	return ()
 
 rename :: Context -> Dn -> Dn -> IO ()
 rename ctx od nd = do
-	{#call unsafe ldb_rename#} ctx (toLDn od) (toLDn nd)
+	oldn <- toLDn od
+	nldn <- toLDn nd
+	ret <- {#call unsafe ldb_rename#} ctx oldn nldn
 	return ()
 
-parseDn :: String -> LDn
-parseDn s = do
-	return $ {#call ldb_dn_explode#} nullPtr $ withCString s
+parseDn :: String -> Dn
+parseDn s = undefined -- FIXME




More information about the samba-cvs mailing list