aboutsummaryrefslogtreecommitdiff
path: root/lib/turtle/parser.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/turtle/parser.ml')
-rw-r--r--lib/turtle/parser.ml49
1 files changed, 33 insertions, 16 deletions
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))
)
)