aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bin/main.ml150
-rw-r--r--lib/turtle/ast.ml37
-rw-r--r--lib/turtle/parser.ml49
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))
)
)