diff options
-rw-r--r-- | bin/main.ml | 137 | ||||
-rw-r--r-- | lib/turtle/ast.ml | 41 | ||||
-rw-r--r-- | lib/turtle/parser.ml | 52 | ||||
-rw-r--r-- | test/turtle/main.ml | 27 |
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 () -> |