Some reorganisation of the tests, improve pp functions

3 files changed, 92 insertions, 144 deletions

diff --git a/bin/main.ml b/bin/main.ml
index d1001ba..b7c6260 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,12 +1,19 @@
 module Parser = Rdf_turtle.Parser
 
 open Rdf
+module Ast = Rdf_turtle.Ast
 
 let parse p =
   Angstrom.parse_string
     ~consume:Angstrom.Consume.All
     p
 
+let test (parser_str, parse_str, parser', pp) =
+    let () = Fmt.pr "\n@.Trying string:@. %s@. with parser %s@." parse_str parser_str in
+    parse_str |> parse parser' |> function
+      | Ok x -> Fmt.pr "... ok ... pp_output is:@. %a @." pp x
+      | Error e -> raise (Failure (Fmt.str "error: %s@." e))
+
 let turtle_list =
   [
 (*     "<http://example.org/#spiderman> <http://www.perceive.net/schemas/relationship/enemyOf> _:a ." *)
@@ -48,104 +55,6 @@ let test_ctx : Rdf_turtle.Ast.parser_state =
 
 let empty_graph = Graph.empty
 
-let str_iriref = "<http://example.org/#spidermanhhhhhhhhhhhhhh>"
-let ast_iriref =
-  str_iriref
-  |> parse Parser.iriref
-  |> Result.get_ok
-
-let str_language = "@en-fr"
-let ast_language =
-  str_language
-  |> parse Parser.language
-  |> Result.get_ok
-
-let str_prefixed_name = "rdfs:some-example"
-let ast_prefixed_name =
-  str_prefixed_name
-  |> parse Parser.prefixed_name
-  |> Result.get_ok
-
-let str_blank_node = "_:some-example"
-let ast_blank_node =
-  str_blank_node
-  |> parse Parser.blank_node
-  |> Result.get_ok
-
-let str_iri1 = "<https://some_iri.com/blah>"
-let ast_iri1 =
-  str_iri1
-  |> parse Parser.iri
-  |> Result.get_ok
-
-let str_iri2 = "rdfks:irir"
-let ast_iri2 =
-  str_iri2
-  |> parse Parser.iri
-  |> Result.get_ok
-
-let str_literal0 = "\"hia\""
-let ast_literal0 =
-  str_literal0
-  |> parse Parser.literal
-  |> Result.get_ok
-
-let str_literal1 = "\"Cette Série des Années Septantei\"@be"
-let ast_literal1 =
-  str_literal1
-  |> parse Parser.literal
-  |> Result.get_ok
-
-let str_literal2 = "\"Cette Série des Années Septantei\"^^<iri>"
-let ast_literal2 =
-  str_literal2
-  |> parse Parser.literal
-  |> Result.get_ok
-
-let str_literal3 = "\"Cette Série des Années Septantei\"^^<iri>@lang"
-(* let ast_literal3 = *)
-(*   str_literal3 *)
-(*   |> parse Parser.literal *)
-(*   |> Result.get_ok *)
-
-let str_predicate = "<iril]lfdsjk%>"
-let ast_predicate =
-  str_predicate
-  |> parse Parser.predicate
-  |> Result.get_ok
-
-let str_object_iri = "<iril]lfdsjk%>"
-let ast_object_iri =
-  str_object_iri
-  |> parse Parser.object'
-  |> Result.get_ok
-
-let str_object_bnode = "_:blabal"
-let ast_object_bnode =
-  str_object_bnode
-  |> parse Parser.object'
-  |> Result.get_ok
-
-(* let str_object_literal = "\"Cette Série des Années Septantei\"^^<iri>" *)
-let str_object_literal = ":a"
-let ast_object_literal =
-  str_object_literal
-  |> parse Parser.object'
-  |> Result.get_ok
-
-let str_object_coll = "(   _:a _:b <iriobj> rdfs:o   )"
-let ast_object_coll =
-  str_object_coll
-  |> parse Parser.object'
-  |> Result.get_ok
-
-let str_object_bnodps = "[ _:p _:o1 ]"
-(*     "[ foaf:name \"Bob\" ]", *)
-let ast_object_bnodps =
-  str_object_bnodps
-  |> parse Parser.object'
-  |> Result.get_ok
-
 let () =
   List.iter (
     fun statement_str ->
@@ -163,22 +72,29 @@ let () =
       |> List.iter (fun triple ->
           Fmt.pr "%a@." Triple.pp triple)
   ) turtle_list ;
-  Fmt.pr "IRI: %a @." Iri.pp test_iri;
-  Fmt.pr "IRI_2: %a @." Iri.pp test_iri_2;
-  Fmt.pr "@. Now we get some pring statements@.";
-  Fmt.pr "LANGUAGE: %a @." Rdf_turtle.Ast.Language.pp ast_language;
-  Fmt.pr "IRIREF: %a @." Rdf_turtle.Ast.Iriref.pp ast_iriref;
-  Fmt.pr "PREFIXED_NAME: %a @." Rdf_turtle.Ast.Prefixed_name.pp ast_prefixed_name;
-  Fmt.pr "BLANK_NODE: %a @." Rdf_turtle.Ast.Blank_node.pp ast_blank_node;
-  Fmt.pr "IRI1: %a @." Rdf_turtle.Ast.Iri.pp ast_iri1;
-  Fmt.pr "IRI2: %a @." Rdf_turtle.Ast.Iri.pp ast_iri2;
-  Fmt.pr "LITERAL0: %a @." Rdf_turtle.Ast.Literal.pp ast_literal0;
-  Fmt.pr "LITERAL1: %a @." Rdf_turtle.Ast.Literal.pp ast_literal1;
-  Fmt.pr "LITERAL2: %a @." Rdf_turtle.Ast.Literal.pp ast_literal2;
-(*   Fmt.pr "LITERAL3: %a @." Rdf_turtle.Ast.Literal.pp ast_literal3; *)
-  Fmt.pr "PREDICATE: %a @." Rdf_turtle.Ast.Predicate.pp ast_predicate;
-  Fmt.pr "OBJECT_IRI: %a @." Rdf_turtle.Ast.object_pp ast_object_iri;
-  Fmt.pr "OBJECT_BNODE: %a @." Rdf_turtle.Ast.object_pp ast_object_bnode;
-  Fmt.pr "OBJECT_LITERAL: %a @." Rdf_turtle.Ast.object_pp ast_object_literal;
-  Fmt.pr "OBJECT_COLL: %a @." Rdf_turtle.Ast.object_pp ast_object_coll;
-  Fmt.pr "OBJECT_BNODPS: %a @." Rdf_turtle.Ast.object_pp ast_object_bnodps;
+(*   test ("literal", "\"Cette Série des Années Septantei\"^^<iri>@lang", Parser.literal, Ast.Literal.pp) ; *)
+
+(*   test ("iriref", "<http://example.org/#spidermanhhhhhhhhhhhhhh>", Parser.iriref, Ast.Iriref.pp) ; *)
+(*   test ("language", "@en-fr", Parser.language, Ast.Language.pp) ; *)
+  test ("iri", "a:p", Parser.iri, Ast.Iri.pp) ;
+(*   test ("prefixed_name", "rdfs:some-example", Parser.prefixed_name, Ast.Prefixed_name.pp) ; *)
+(*   test ("blank_node", "_:some-example", Parser.blank_node, Ast.Blank_node.pp) ; *)
+(*   test ("iri" , "<https://someiri.com/blah>", Parser.iri, Ast.Iri.pp) ; *)
+(*   test ("iri" , "rdfsk:irir", Parser.iri, Ast.Iri.pp) ; *)
+(*   test ("literal", "\"hia\"", Parser.literal, Ast.Literal.pp) ; *)
+(*   test ("literal", "\"Cette Série des Années Septantei\"@be", Parser.literal, Ast.Literal.pp) ; *)
+  test ("literal", "\"Cette Série des Années Septantei\"^^xsd:string", Parser.literal, Ast.Literal.pp) ;
+(*   test ("predicate", "b:a", Parser.predicate, Ast.Predicate.pp) ; *)
+(*   test ("object (iri)", "a:p", Parser.object', Ast.object_pp) ; *)
+(*   test ("object (bnode)", "_:blabla", Parser.object', Ast.object_pp) ; *)
+(*   test ("object (literal)", "\"Cette Série des Années Septantei\"^^<iri>", Parser.object', Ast.object_pp) ; *)
+(*   test ("object (coll)", "(_:a _:b <iriobj> rdfs:o)", Parser.object', Ast.object_pp) ; *)
+(*   test ("object (bnodps)", "[ <predicate> <object> ]", Parser.object', Ast.object_pp) ; *)
+  test ("object (bnodps)", "[ <pred1> <obj1>; <pred2> <obj2>, <obj3> ]", Parser.object', Ast.object_pp) ;
+(*   test ("object (bnodps)", "[ a:p a:o1 ]", Parser.object', Ast.object_pp) ; *)
+  test ("object (bnodps)",
+        "[ rel:enemyOf <#green-goblin> ;
+           a foaf:Person ;
+           foaf:name \"Spiderman\", \"Человек-паук\"@ru]",
+        Parser.object', Ast.object_pp) ;
+
diff --git a/lib/turtle/ast.ml b/lib/turtle/ast.ml
index 6957ed8..c9a4fe3 100644
--- a/lib/turtle/ast.ml
+++ b/lib/turtle/ast.ml
@@ -170,7 +170,7 @@ module Predicate = struct
     | _ -> false
 
   let pp ppf = function
-    | Pred_a -> Fmt.pf ppf "@<pred_a>@]"
+    | Pred_a -> Fmt.pf ppf "a"
     | Pred_iri i -> Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp i
 
 end
@@ -232,17 +232,32 @@ and subject_pp ppf = function
   | Sub_coll collection -> Fmt.pf ppf "@[<hov 1>%a@]" collection_pp collection
 and bnodps_pp ppf (BnodPs predobjs) =
   Fmt.pf ppf "@[<hov 1>[%a]@]" predobjs_pp predobjs
-and predobjs_pp ppf l =
-  let objlist_pp ppf l =
+and predobjs_pp ppf predobjs =
+  let objlist_pp ppf objs =
+    match objs with
+    | [obj] -> object_pp ppf obj
+    | head :: tail ->
+      object_pp ppf head;
+      (List.iter
+      (fun o -> Fmt.pf ppf "@[<hov 1>,%a@]" object_pp o) tail)
+    | _ -> raise @@ Invalid_argument "An empty list should not be possible"
+  in
+  match predobjs with
+  | [(p, objs)] ->
+    Fmt.pf ppf "@[<hov 1>%a %a@]"
+      Predicate.pp p
+      objlist_pp objs
+  | (p, objs) :: tail ->
+    Fmt.pf ppf "@[<hov 1>%a %a@]"
+      Predicate.pp p
+      objlist_pp objs;
     List.iter
-      (fun o -> Fmt.pf ppf "@[<hov 1>%a,@]" object_pp o)
-      l in
-  List.iter
-    (fun (p, objlist) ->
-       Fmt.pf ppf "@[<hov 1>%a; %a@]"
-         Predicate.pp p
-         objlist_pp objlist)
-    l
+      (fun (p, objs) ->
+         Fmt.pf ppf "@[<hov 1> ;\n    %a %a@]"
+           Predicate.pp p
+           objlist_pp objs)
+      tail
+  | _ -> raise @@ Invalid_argument "An empty list should not be possible"
 
 
 module Triples = struct
diff --git a/lib/turtle/parser.ml b/lib/turtle/parser.ml
index 8f33ed9..a586c55 100644
--- a/lib/turtle/parser.ml
+++ b/lib/turtle/parser.ml
@@ -23,6 +23,10 @@ let whitespace =
   many @@ choice [string " "; string "\n"; string "\t"]
   >>| ignore
 
+let whitespace1 =
+  many1 @@ choice [string " "; string "\n"; string "\t"]
+  >>| ignore
+
 let delimiters c1 c2 =
   char c1
   *> take_while (fun d -> not @@ Char.equal c2 d)
@@ -36,15 +40,18 @@ let iriref =
 let prefixed_name =
   lift2
     Ast.Prefixed_name.of_strings
-    (take_while (char_is_not_equal_to ([':'] @ whitespace_lst))
-     <* char ':')
-    (take_while (char_is_not_equal_to ([']'; ')'; '('] @ whitespace_lst)))
+    (peek_char >>= function
+      | Some '_' -> fail "A prefixed_name can not start with _"
+      | _ ->
+          (take_while (char_is_not_equal_to ([':'] @ whitespace_lst))
+          <* char ':'))
+          (take_while (char_is_not_equal_to ([']'; ')'; '('] @ whitespace_lst)))
 
 let language =
   lift
     Ast.Language.of_string
     (char '@'
-     *> take_while is_not_whitespace)
+     *> take_while (char_is_not_equal_to ([']'; ')'; '('] @ whitespace_lst)))
 
 let blank_node =
   lift
@@ -66,15 +73,15 @@ let datatype_str = Ast.Iri.of_prefixed_name (Ast.Prefixed_name.of_strings "xsd"
   choice ~failure_msg:"None of the parsers worked for Literal"
     [
       lift2
-        (fun value lang -> 
+        (fun value lang ->
            Ast.Literal.make value ~language:lang datatype_str)
         (char '"'
          *> take_while (char_is_not_equal_to (['"']))
          <* char '"')
         (language)
-      ; 
-      lift2 
-        (fun value datatype -> 
+      ;
+      lift2
+        (fun value datatype ->
            Ast.Literal.make value datatype)
         (char '"'
          *> take_while (char_is_not_equal_to ([':'; '"']))
@@ -82,18 +89,23 @@ let datatype_str = Ast.Iri.of_prefixed_name (Ast.Prefixed_name.of_strings "xsd"
         (string "^^" *> iri)
       ;
       lift
-        (fun value -> 
+        (fun value ->
            Ast.Literal.make value datatype_str)
         (char '"'
          *> take_while (char_is_not_equal_to (['"']))
          <* char '"')
-      ; 
+      ;
     ]
 
 let predicate =
   choice [
-    lift (fun _ -> Ast.Predicate.a)  (char 'a' <* whitespace);
-    lift Ast.Predicate.of_iri iri
+    lift (fun _ ->
+        Fmt.pr "PRED_A:@.";
+        Ast.Predicate.a)  (char 'a' <* whitespace1);
+    lift (fun iri ->
+        Fmt.pr "PRED_IRI: %a@." Ast.Iri.pp iri;
+        Ast.Predicate.of_iri iri)
+      iri
   ]
 
 (*   TODO if you change the order of literal and iri, the tests won't work anymore. *)
@@ -114,17 +126,19 @@ let object_ collection bnodps =
     );
     (lift
        (fun literal ->
+          Fmt.pr "OBJ_LITERAL %a" Ast.Literal.pp literal;
           Ast.Obj_literal literal)
        literal
     );
     (lift
        (fun blank_node ->
+          Fmt.pr "OBJ_BNODE %a" Ast.Blank_node.pp blank_node;
           Ast.Obj_blank_node blank_node)
        blank_node
     );
     (lift
        (fun iri ->
-          Fmt.pr "IRI %a@." Ast.Iri.pp iri;
+          Fmt.pr "OBJ_IRI %a@." Ast.Iri.pp iri;
           Ast.Obj_iri iri)
        iri);
   ]
@@ -164,7 +178,9 @@ let subject_ bnodps =
 
 let bnodps predobjs =
   lift
-    (fun predobjs -> Ast.BnodPs predobjs)
+    (fun predobjs ->
+       Fmt.pr "BNODPS";
+       Ast.BnodPs predobjs)
     (
       char '['
       *> whitespace
@@ -185,14 +201,15 @@ let predobjs =
     <* whitespace
   in
   fix (fun predobjs ->
+      Fmt.pr "PREDOBJS";
       let bnodps = bnodps predobjs in
       let collection = collection_ bnodps in
       let object' = object_ collection bnodps in
-      sep_by1 semicolon (
+      sep_by semicolon (
         lift2
           (fun p objs -> (p, objs))
           (whitespace *> predicate <* whitespace)
-          (sep_by1 comma (whitespace *> object' <* whitespace))
+          (sep_by comma (whitespace *> object' <* whitespace))
       )
     )