add readTriple in the Haskell binding

4 files changed, 63 insertions, 3 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index af849817c..3482e0b11 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -607,7 +607,8 @@ pgf_expr_parser_expr(PgfExprParser* parser)
 		       parser->token_tag != PGF_TOKEN_RPAR &&
 		       parser->token_tag != PGF_TOKEN_RCURLY &&
 		       parser->token_tag != PGF_TOKEN_RTRIANGLE &&
-		       parser->token_tag != PGF_TOKEN_COLON) {
+		       parser->token_tag != PGF_TOKEN_COLON &&
+		       parser->token_tag != PGF_TOKEN_COMMA) {
 			PgfExpr arg = pgf_expr_parser_arg(parser);
 			if (gu_variant_is_null(arg))
 				return gu_null_variant;
@@ -798,7 +799,7 @@ PgfExpr
 pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err)
 {
 	GuPool* tmp_pool = gu_new_pool();
-	PgfExprParser* parser = 
+	PgfExprParser* parser =
 		pgf_new_parser(in, pool, tmp_pool, err);
 	PgfExpr expr = pgf_expr_parser_expr(parser);
 	if (parser->token_tag != PGF_TOKEN_EOF)
@@ -807,6 +808,38 @@ pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err)
 	return expr;
 }
 
+int
+pgf_read_expr_tuple(GuIn* in,
+                    int n_exprs, PgfExpr exprs[],
+                    GuPool* pool, GuExn* err)
+{
+	GuPool* tmp_pool = gu_new_pool();
+	PgfExprParser* parser =
+		pgf_new_parser(in, pool, tmp_pool, err);
+	if (parser->token_tag != PGF_TOKEN_LTRIANGLE)
+		return 0;
+	pgf_expr_parser_token(parser);
+	for (size_t i = 0; i < n_exprs; i++) {
+		if (i > 0) {
+			if (parser->token_tag != PGF_TOKEN_COMMA)
+				return 0;
+			pgf_expr_parser_token(parser);
+		}
+
+		exprs[i] = pgf_expr_parser_expr(parser);
+		if (gu_variant_is_null(exprs[i]))
+			return 0;
+	}
+	if (parser->token_tag != PGF_TOKEN_RTRIANGLE)
+		return 0;
+	pgf_expr_parser_token(parser);
+	if (parser->token_tag != PGF_TOKEN_EOF)
+		return 0;
+	gu_pool_free(tmp_pool);
+
+	return 1;
+}
+
 PgfType*
 pgf_read_type(GuIn* in, GuPool* pool, GuExn* err)
 {
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index f197fbc6c..23aa971f0 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -152,6 +152,11 @@ pgf_expr_string(GuString, GuPool* pool);
 PgfExpr
 pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);
 
+int
+pgf_read_expr_tuple(GuIn* in,
+                    int n_exprs, PgfExpr exprs[],
+                    GuPool* pool, GuExn* err);
+
 PgfType*
 pgf_read_type(GuIn* in, GuPool* pool, GuExn* err);
 
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 96b3eea35..15001c2c9 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -222,6 +222,8 @@ foreign import ccall "pgf/pgf.h pgf_print"
 foreign import ccall "pgf/expr.h pgf_read_expr"
   pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
 
+foreign import ccall "pgf/expr.h pgf_read_expr_tuple"
+  pgf_read_expr_tuple :: Ptr GuIn -> CInt -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt
 
 foreign import ccall "pgf/graphviz.h pgf_graphviz_abstract_tree"
   pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO ()
diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc
index a2fdf5505..1e70c3268 100644
--- a/src/runtime/haskell-bind/SG.hsc
+++ b/src/runtime/haskell-bind/SG.hsc
@@ -8,7 +8,7 @@ module SG( SG, openSG, closeSG
          , beginTrans, commit, rollback, inTransaction
          , SgId
          , insertExpr, getExpr
-         , insertTriple, getTriple
+         , readTriple, insertTriple, getTriple
          , queryTriple
          ) where
 
@@ -108,6 +108,26 @@ getExpr (SG sg) id = do
 -----------------------------------------------------------------------
 -- Triples
 
+readTriple :: String -> Maybe (Expr,Expr,Expr)
+readTriple str =
+  unsafePerformIO $
+    do exprPl <- gu_new_pool
+       withGuPool $ \tmpPl ->
+         withCString str $ \c_str ->
+           withTriple $ \triple -> do
+             do guin <- gu_string_in c_str tmpPl
+                exn <- gu_new_exn tmpPl
+                ok <- pgf_read_expr_tuple guin 3 triple exprPl exn
+                status <- gu_exn_is_raised exn
+                if (ok == 1 && not status)
+                  then do c_expr1 <- peekElemOff triple 0
+                          c_expr2 <- peekElemOff triple 1
+                          c_expr3 <- peekElemOff triple 2
+                          exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+                          return $ Just (Expr c_expr1 exprFPl,Expr c_expr2 exprFPl,Expr c_expr3 exprFPl)
+                  else do gu_pool_free exprPl
+                          return Nothing
+
 insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId
 insertTriple (SG sg) (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
   withGuPool $ \tmpPl ->