aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorarie <arie@alleycat.cc>2021-06-16 10:09:43 +0200
committerarie <arie@alleycat.cc>2021-06-28 21:03:35 +0200
commit367ea15a024981da0c8983c5193c26e96f167016 (patch)
tree4e2cac1913a905031f76e2bf07d645382058f47c
parent4e6349d102a99011ff3ee45f168247ae6d16bc5d (diff)
Rdf-turtle
debugging, WIP. It's all very messy now, but that should improve soon.
-rw-r--r--bin/main.ml137
-rw-r--r--lib/turtle/ast.ml41
-rw-r--r--lib/turtle/parser.ml52
-rw-r--r--test/turtle/main.ml27
4 files changed, 215 insertions, 42 deletions
diff --git a/bin/main.ml b/bin/main.ml
index 0a4b96d..d1001ba 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -11,9 +11,12 @@ let turtle_list =
[
(* "<http://example.org/#spiderman> <http://www.perceive.net/schemas/relationship/enemyOf> _:a ." *)
(* ; *)
- "(_:a _:b)
- <http://www.perceive.net/schemas/relationship/enemyOf> _:a ."
- ;
+(* "(_:a _:b) *)
+(* <http://www.perceive.net/schemas/relationship/enemyOf> _:a ." *)
+(* ; *)
+(* "(<A-iri> <B-iri>) <http://www.perceive.net/schemas/relationship/enemyOf> _:a ." *)
+(* "(<A-iri>) <http://www.perceive.net/schemas/relationship/enemyOf> _:a ." *)
+(* ; *)
]
let test_sub =
@@ -45,6 +48,104 @@ 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 ->
@@ -52,12 +153,32 @@ let () =
|> parse Parser.statement
|> Result.get_ok
|> (fun statement ->
- Rdf_turtle.apply_statement (test_ctx, empty_graph) statement)
- |> (fun (_ctx, g) -> Graph.to_list @@ g)
+ Fmt.pr "%a@." Rdf_turtle.Ast.Statement.pp statement;
+ statement
+ )
+ |> (fun statement ->
+ Rdf_turtle.apply_statement (test_ctx, empty_graph) statement)
+ |> (fun (_ctx, g) ->
+ Graph.to_list @@ g)
|> List.iter (fun triple ->
- Fmt.pr "TRIPLE!! %a@." Triple.pp 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;
diff --git a/lib/turtle/ast.ml b/lib/turtle/ast.ml
index 856a949..6957ed8 100644
--- a/lib/turtle/ast.ml
+++ b/lib/turtle/ast.ml
@@ -39,7 +39,7 @@ module Iriref = struct
(to_string b)
let pp ppf iriref =
- Fmt.pf ppf "@[<h 1><iriref@ %s>@]" (to_string iriref)
+ Fmt.pf ppf "@[<hov 1><%s>@]" (to_string iriref)
end
@@ -57,7 +57,7 @@ module Language = struct
(to_string b)
let pp ppf language =
- Fmt.pf ppf "@[<h 1><language@ %s>@]" (to_string language)
+ Fmt.pf ppf "@[<hov 1>@%s@]" (to_string language)
end
@@ -74,7 +74,7 @@ module Prefixed_name = struct
(* TODO check whether this is nice *)
let pp ppf prefixed_name =
- Fmt.pf ppf "@[<h 1><prefixed_name fst@ %s snd@ %s>@]"
+ Fmt.pf ppf "@[<hov 1>%s:%s@]"
(fst prefixed_name)
(snd prefixed_name)
@@ -95,7 +95,7 @@ module Blank_node = struct
(* TODO check whether this is nice (for all the pp functions)*)
let pp ppf blank_node =
- Fmt.pf ppf "@[<h 1><blank_node@ %s>@]" (to_string blank_node)
+ Fmt.pf ppf "@[<hov 1>_:%s@]" (to_string blank_node)
end
@@ -148,9 +148,11 @@ module Literal = struct
let pp ppf literal =
(* TODO print the datatype and language *)
Fmt.pf ppf
- "@[<8><literal@ value@ %s@ iri %a>@]"
+ "@[<hov 8> \"%s\"%a^^%a @]"
(canonical literal)
+ (Fmt.option Language.pp) (language literal)
Iri.pp (datatype literal)
+
end
@@ -169,7 +171,7 @@ module Predicate = struct
let pp ppf = function
| Pred_a -> Fmt.pf ppf "@<pred_a>@]"
- | Pred_iri i -> Fmt.pf ppf "@[<4><predicate@ %a>@]" Iri.pp i
+ | Pred_iri i -> Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp i
end
@@ -215,28 +217,29 @@ and predobjs_equal a b =
a b
let rec object_pp ppf = function
- | Obj_iri iri -> Fmt.pf ppf "@[<h 1><obj_iri@ %a>@]" Iri.pp iri
- | Obj_blank_node bnode -> Fmt.pf ppf "@[<h 1><obj_blank_node@ %a>@]" Blank_node.pp bnode
- | Obj_literal lit -> Fmt.pf ppf "@[<h 1><obj_literal@ %a>@]" Literal.pp lit
- | Obj_coll coll -> Fmt.pf ppf "@[<h 1><obj_coll@ %a>@]" collection_pp coll
- | Obj_bnodps bnodps -> Fmt.pf ppf "@[<h 1><obj_bnodps@ %a>@]" bnodps_pp bnodps
+ | Obj_iri iri -> Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp iri
+ | Obj_blank_node bnode -> Fmt.pf ppf "@[<hov 1>%a@]" Blank_node.pp bnode
+ | Obj_literal lit -> Fmt.pf ppf "@[<hov 1>%a>@]" Literal.pp lit
+ | Obj_coll coll -> Fmt.pf ppf "@[<hov 1>%a@]" collection_pp coll
+ | Obj_bnodps bnodps -> Fmt.pf ppf "@[<hov 1>%a@]" bnodps_pp bnodps
and collection_pp ppf (Collection objs) =
- Fmt.pf ppf "@[<h 1><collection obj@ %a>@]" (Fmt.list object_pp) objs
+ let object_pp_space ppf = Fmt.pf ppf " %a" object_pp in
+ Fmt.pf ppf "@[<hov 1>(%a )@]" (Fmt.list object_pp_space) objs
and subject_pp ppf = function
- | Sub_iri iri ->Fmt.pf ppf "@[<h 1><sub_iri@ %a>@]" Iri.pp iri
- | Sub_blank_node bnode -> Fmt.pf ppf "@[<h 1><sub_blank_node@ %a>@]" Blank_node.pp bnode
- | Sub_bnodps bnodps -> Fmt.pf ppf "@[<h 1><sub_bnodps@ %a>@]" bnodps_pp bnodps
- | Sub_coll collection -> Fmt.pf ppf "@[<h 1><sub_collection@ %a>@]" collection_pp collection
+ | Sub_iri iri ->Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp iri
+ | Sub_blank_node bnode -> Fmt.pf ppf "@[<hov 1>%a@]" Blank_node.pp bnode
+ | Sub_bnodps bnodps -> Fmt.pf ppf "@[<hov 1>%a@]" bnodps_pp bnodps
+ | Sub_coll collection -> Fmt.pf ppf "@[<hov 1>%a@]" collection_pp collection
and bnodps_pp ppf (BnodPs predobjs) =
- Fmt.pf ppf "@[<h 1><obj_bnodps@ %a>@]" predobjs_pp predobjs
+ Fmt.pf ppf "@[<hov 1>[%a]@]" predobjs_pp predobjs
and predobjs_pp ppf l =
let objlist_pp ppf l =
List.iter
- (fun o -> Fmt.pf ppf "@[<h 1><object@ %a>@]" object_pp o)
+ (fun o -> Fmt.pf ppf "@[<hov 1>%a,@]" object_pp o)
l in
List.iter
(fun (p, objlist) ->
- Fmt.pf ppf "@[<h 1><predicate %a object_list %a>@"
+ Fmt.pf ppf "@[<hov 1>%a; %a@]"
Predicate.pp p
objlist_pp objlist)
l
diff --git a/lib/turtle/parser.ml b/lib/turtle/parser.ml
index 2a40664..8f33ed9 100644
--- a/lib/turtle/parser.ml
+++ b/lib/turtle/parser.ml
@@ -1,5 +1,13 @@
open Angstrom
+let string_starts_with s subs =
+ if String.length subs > String.length s then
+ false
+ else if subs <> String.sub s 0 (String.length subs) then
+ false
+ else
+ true
+
let whitespace_lst = ['\x20'; '\x0a'; '\x0d'; '\x09'; ]
let is_whitespace = function
@@ -30,7 +38,7 @@ let prefixed_name =
Ast.Prefixed_name.of_strings
(take_while (char_is_not_equal_to ([':'] @ whitespace_lst))
<* char ':')
- (take_while (char_is_not_equal_to ([']'] @ whitespace_lst)))
+ (take_while (char_is_not_equal_to ([']'; ')'; '('] @ whitespace_lst)))
let language =
lift
@@ -54,18 +62,33 @@ let iri =
* according to the spec, but it can also happen elsewhere.
* Moreover: an absent language results in an empty string. This could also be different. *)
let literal =
- lift3
- (fun value lang_opt iri -> match lang_opt with
- | "" -> Ast.Literal.make value iri
- | lang -> Ast.Literal.make value ~language:lang iri)
- (delimiters '"' '"')
- (option
- ""
- (char '@' *> take_while ( char_is_not_equal_to ( [':'] @ whitespace_lst)))
- )
- (option
- (Ast.Iri.of_prefixed_name @@ Ast.Prefixed_name.of_strings "xsd" "string")
- (string "^^" *> iri))
+let datatype_str = Ast.Iri.of_prefixed_name (Ast.Prefixed_name.of_strings "xsd" "string") in
+ choice ~failure_msg:"None of the parsers worked for Literal"
+ [
+ lift2
+ (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 ->
+ Ast.Literal.make value datatype)
+ (char '"'
+ *> take_while (char_is_not_equal_to ([':'; '"']))
+ <* char '"')
+ (string "^^" *> iri)
+ ;
+ lift
+ (fun value ->
+ Ast.Literal.make value datatype_str)
+ (char '"'
+ *> take_while (char_is_not_equal_to (['"']))
+ <* char '"')
+ ;
+ ]
let predicate =
choice [
@@ -101,6 +124,7 @@ let object_ collection bnodps =
);
(lift
(fun iri ->
+ Fmt.pr "IRI %a@." Ast.Iri.pp iri;
Ast.Obj_iri iri)
iri);
]
@@ -181,7 +205,7 @@ let triples =
choice [
(lift2
Ast.Triples.of_subject_and_predobjs
- subject
+ (subject <* whitespace)
predobjs);
(lift
Ast.Triples.of_bnodps
diff --git a/test/turtle/main.ml b/test/turtle/main.ml
index 6cd5c32..db4193d 100644
--- a/test/turtle/main.ml
+++ b/test/turtle/main.ml
@@ -240,6 +240,11 @@ let predobjs_test_case =
~language:"ru");
]
] ;
+(* "<http://www.perceive.net/schemas/relationship/enemyOf> \"LITERAL\" ", *)
+(* "<http://www.perceive.net/schemas/relationship/enemyOf> .", *)
+(* [ Predicate.of_iri @@ Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "p", *)
+(* [ Obj_iri (Iri.of_prefixed_name @@ Prefixed_name.of_strings "" "WWWWWWWWWWWWWWWWWWWwwW"); ] ; ] *)
+(* ; *)
] in
test_case "predobjs" `Quick
(fun () ->
@@ -352,13 +357,33 @@ let statement_test_case =
"foaf"
(Iriref.of_string "http://xmlns.com/foaf/0.1/"))
;
- "<http://example.org/#spiderman> <http://www.perceive.net/schemas/relationship/enemyOf> <http://example.org/#green-goblin> .",
+ "<http://example.org/#spiderman>
+ <http://www.perceive.net/schemas/relationship/enemyOf> <http://example.org/#green-goblin> .",
+ Statement.of_triples (
+ Triples.of_subject_and_predobjs
+ (Sub_iri (Iri.of_iriref (Iriref.of_string @@ "http://example.org/#spiderman")))
+ ([ Predicate.of_iri @@ Iri.of_iriref "http://www.perceive.net/schemas/relationship/enemyOf",
+ [ Obj_iri (Iri.of_iriref "http://example.org/#green-goblin"); ] ; ]))
+ ;
+(* "<http://example.org/#spiderman> <http://www.perceive.net/schemas/relationship/enemyOf> \"literal\" .", *)
+ "<http://example.org/#spiderman>
+ <http://www.perceive.net/schemas/relationship/enemyOf> <http://example.org/#green-goblin> .",
Statement.of_triples (
Triples.of_subject_and_predobjs
(Sub_iri (Iri.of_iriref (Iriref.of_string @@ "http://example.org/#spiderman")))
([ Predicate.of_iri @@ Iri.of_iriref "http://www.perceive.net/schemas/relationship/enemyOf",
[ Obj_iri (Iri.of_iriref "http://example.org/#green-goblin"); ] ; ]))
;
+ "<http://example.org/#spiderman> <http://www.perceive.net/schemas/relationship/enemyOf> \"literal\" .",
+ Statement.of_triples (
+ Triples.of_subject_and_predobjs
+ (Sub_iri (Iri.of_iriref (Iriref.of_string @@ "http://example.org/#spiderman")))
+ ([ Predicate.of_iri @@ Iri.of_iriref "http://www.perceive.net/schemas/relationship/enemyOf",
+ [ Obj_literal ( Literal.make
+ "literal"
+ (Iri.of_prefixed_name @@ Prefixed_name.of_strings "xsd" "string")
+ )]]))
+ ;
] in
test_case "statement" `Quick
(fun () ->