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