X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=1342c38ea9b87e0f59d7ff802b6dc31dee9c5d14;hb=ccacf5dec5207d94bc692bfa59670bc8ee4d049f;hp=73ba813e45ca06793dd04545feded00923000480;hpb=05273da8830f2f10e417115a3981924a8b14228a;p=libguestfs.git

diff --git a/src/generator.ml b/src/generator.ml
index 73ba813..1342c38 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -7265,10 +7265,10 @@ and generate_haskell_hs () =
    *)
   let can_generate style =
     match style with
-    | RErr, _ -> true
-    | RBool _, _
+    | RErr, _
     | RInt _, _
-    | RInt64 _, _
+    | RInt64 _, _ -> true
+    | RBool _, _
     | RConstString _, _
     | RString _, _
     | RStringList _, _
@@ -7806,7 +7806,38 @@ public class Bindtests {
 "
 
 and generate_haskell_bindtests () =
-  () (* XXX Haskell bindings need to be fleshed out. *)
+  generate_header HaskellStyle GPLv2;
+
+  pr "\
+module Bindtests where
+import qualified Guestfs
+
+main = do
+  g <- Guestfs.create
+";
+
+  let mkargs args =
+    String.concat " " (
+      List.map (
+	function
+	| CallString s -> "\"" ^ s ^ "\""
+	| CallOptString None -> "Nothing"
+	| CallOptString (Some s) -> sprintf "(Just \"%s\")" s
+	| CallStringList xs ->
+	    "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+	| CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
+	| CallInt i -> string_of_int i
+	| CallBool true -> "True"
+	| CallBool false -> "False"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
+  );
+
+  pr "  putStrLn \"EOF\"\n"
 
 (* Language-independent bindings tests - we do it this way to
  * ensure there is parity in testing bindings across all languages.
@@ -8036,7 +8067,7 @@ Run it from the top source directory using the command
   generate_haskell_hs ();
   close ();
 
-  let close = output_to "haskell/bindtests.hs" in
+  let close = output_to "haskell/Bindtests.hs" in
   generate_haskell_bindtests ();
   close ();