aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorarie <arie@alleycat.cc>2021-06-07 17:01:06 +0200
committerarie <arie@alleycat.cc>2021-06-28 21:02:45 +0200
commit933fde01c878fbe20952c05ad700fecd0c0286ef (patch)
treeaea60c41b1f57305ad3a68c20e6fb205547f286e
parent618d4dc294d0613de8747a2b14aec89429958b8a (diff)
Rdf turtle
add test for directive, improved types, added some pp and equal functions.
-rw-r--r--lib/turtle/rdf_turtle.ml95
-rw-r--r--lib/turtle/rdf_turtle.mli59
-rw-r--r--test/alcotest/rdf_alcotest.ml12
-rw-r--r--test/alcotest/rdf_alcotest.mli9
-rw-r--r--test/turtle/main.ml16
5 files changed, 169 insertions, 22 deletions
diff --git a/lib/turtle/rdf_turtle.ml b/lib/turtle/rdf_turtle.ml
index 631446e..c9512f0 100644
--- a/lib/turtle/rdf_turtle.ml
+++ b/lib/turtle/rdf_turtle.ml
@@ -238,15 +238,85 @@ module AST = struct
l
- type triples =
- SubjPredObjs of subject * predobjs
- | Triple_BNodePs of bnodeps
+ module Triples = struct
- type directive = PrefixID of string * Iriref.t | Base of Iriref.t
+ type t = SubjPredObjs of subject * predobjs
+ | BNodePs of bnodeps
- type statement = Directive of directive | Triples of triples
+ let equal a b =
+ match a, b with
+ | SubjPredObjs (asub, ap), SubjPredObjs (bsub, bp) ->
+ subject_equal asub bsub && predobjs_equal ap bp
+ | BNodePs ab, BNodePs bb ->
+ bnodeps_equal ab bb
+ | _, _ -> false
+
+ let pp ppf = function
+ | SubjPredObjs (s, p) ->
+ Fmt.pf ppf "@[<h 1><triples@ subject %a@ predicate %a>@]"
+ subject_pp s
+ predobjs_pp p
+ | BNodePs b ->
+ Fmt.pf ppf "@[<h 1><triples@ bnodeps %a>@]" bnodeps_pp b
+
+ end
+
+ module Directive = struct
+
+ type t = PrefixID of string * Iriref.t | Base of Iriref.t
+
+ let of_string_and_iriref s i =
+ PrefixID (s, i)
+
+ let of_iriref i =
+ Base i
+
+ let equal a b =
+ match a, b with
+ | PrefixID (ast, ai), PrefixID (bst, bi) ->
+ String.equal ast bst && Iriref.equal ai bi
+ | Base ai, Base bi ->
+ Iriref.equal ai bi
+ | _, _ -> false
+
+ let pp ppf = function
+ | PrefixID (s, i) ->
+ Fmt.pf ppf "@[<h 1><directive@ prefixID %a@ iriref %a@]"
+ Fmt.string s
+ Iriref.pp i
+ | Base i ->
+ Fmt.pf ppf "@[<h 1><directive@ base %a>@]" Iriref.pp i
+ end
- type turtle = statement list
+ module Statement = struct
+
+ type t = Directive of Directive.t | Triples of Triples.t
+
+ let equal a b =
+ match a, b with
+ | Directive a, Directive b -> Directive.equal a b
+ | Triples a, Triples b -> Triples.equal a b
+ | _, _ -> false
+
+ let pp ppf = function
+ | Directive d ->
+ Fmt.pf ppf "@[<h 1><statement@ directive@ %a@]" Directive.pp d
+ | Triples t ->
+ Fmt.pf ppf "@[<h 1><statement@ triples %a>@]" Triples.pp t
+
+ end
+
+ module Turtle = struct
+
+ type t = Statement.t list
+
+ let equal a b =
+ list_equal Statement.equal a b
+
+ let pp ppf l =
+ Fmt.pf ppf "@[<h 1><turtle@ statement list %a>@]" (Fmt.list Statement.pp) l
+
+end
type parser_state = {
base_uri : Iri.t;
@@ -444,11 +514,11 @@ module Parser = struct
let triples =
choice [
(lift2
- (fun subject predobjs -> AST.SubjPredObjs (subject, predobjs))
+ (fun subject predobjs -> AST.Triples.SubjPredObjs (subject, predobjs))
subject
predobjs);
(lift
- (fun bnodeps -> AST.Triple_BNodePs bnodeps)
+ (fun bnodeps -> AST.Triples.BNodePs bnodeps)
bnodeps
)
]
@@ -456,7 +526,7 @@ module Parser = struct
let directive =
choice [
lift2
- (fun str iriref -> AST.PrefixID (str, iriref))
+ (fun str iriref -> AST.Directive.PrefixID (str, iriref))
(string "@prefix"
*> whitespace
*> (take_while (char_is_not_equal_to ':'))
@@ -467,8 +537,9 @@ module Parser = struct
<* char '.')
;
lift
- (fun iriref -> AST.Base iriref)
+ (fun iriref -> AST.Directive.Base iriref)
(string "@base"
+ *> whitespace
*> iriref
<* whitespace
<* char '.'
@@ -478,11 +549,11 @@ module Parser = struct
let statement =
choice [
lift
- (fun directive -> AST.Directive directive)
+ (fun directive -> AST.Statement.Directive directive)
(directive)
;
lift
- (fun triples -> AST.Triples triples)
+ (fun triples -> AST.Statement.Triples triples)
(triples
<* whitespace
<* char '.'
diff --git a/lib/turtle/rdf_turtle.mli b/lib/turtle/rdf_turtle.mli
index c62b076..bf80de3 100644
--- a/lib/turtle/rdf_turtle.mli
+++ b/lib/turtle/rdf_turtle.mli
@@ -163,15 +163,54 @@ module AST : sig
val predobjs_pp : predobjs Fmt.t
[@@ocaml.toplevel_printer]
- type triples =
- SubjPredObjs of subject * predobjs
- | Triple_BNodePs of bnodeps
+ module Triples : sig
- type directive = PrefixID of string * Iriref.t | Base of Iriref.t
+ type t = SubjPredObjs of subject * predobjs
+ | BNodePs of bnodeps
- type statement = Directive of directive | Triples of triples
+ val equal : t -> t -> bool
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ end
+
+ module Directive : sig
+
+ type t = PrefixID of string * Iriref.t | Base of Iriref.t
+
+ val of_string_and_iriref : string -> Iriref.t -> t
+
+ val of_iriref : Iriref.t -> t
+
+ val equal : t -> t -> bool
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ end
- type turtle = statement list
+ module Statement : sig
+
+ type t = Directive of Directive.t | Triples of Triples.t
+
+ val equal : t -> t -> bool
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ end
+
+ module Turtle : sig
+
+ type t = Statement.t list
+
+ val equal : t -> t -> bool
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ end
type parser_state = {
base_uri : Iri.t;
@@ -211,12 +250,12 @@ module Parser : sig
val object' : AST.object' Angstrom.t
- val triples : AST.triples Angstrom.t
+ val triples : AST.Triples.t Angstrom.t
- val directive : AST.directive Angstrom.t
+ val directive : AST.Directive.t Angstrom.t
- val statement : AST.statement Angstrom.t
+ val statement : AST.Statement.t Angstrom.t
- val turtle : AST.turtle Angstrom.t
+ val turtle : AST.Turtle.t Angstrom.t
end
diff --git a/test/alcotest/rdf_alcotest.ml b/test/alcotest/rdf_alcotest.ml
index 87d57fe..88e9831 100644
--- a/test/alcotest/rdf_alcotest.ml
+++ b/test/alcotest/rdf_alcotest.ml
@@ -60,3 +60,15 @@ let ast_bnodeps =
let ast_predobjs =
Alcotest.testable Rdf_turtle.AST.predobjs_pp Rdf_turtle.AST.predobjs_equal
+
+let ast_triples =
+ Alcotest.testable Rdf_turtle.AST.Triples.pp Rdf_turtle.AST.Triples.equal
+
+let ast_directive =
+ Alcotest.testable Rdf_turtle.AST.Directive.pp Rdf_turtle.AST.Directive.equal
+
+let ast_statement =
+ Alcotest.testable Rdf_turtle.AST.Statement.pp Rdf_turtle.AST.Statement.equal
+
+let ast_turtle =
+ Alcotest.testable Rdf_turtle.AST.Turtle.pp Rdf_turtle.AST.Turtle.equal
diff --git a/test/alcotest/rdf_alcotest.mli b/test/alcotest/rdf_alcotest.mli
index 1cf4402..56a0e57 100644
--- a/test/alcotest/rdf_alcotest.mli
+++ b/test/alcotest/rdf_alcotest.mli
@@ -41,3 +41,12 @@ val ast_subject : Rdf_turtle.AST.subject Alcotest.testable
val ast_bnodeps : Rdf_turtle.AST.bnodeps Alcotest.testable
val ast_predobjs : Rdf_turtle.AST.predobjs Alcotest.testable
+
+val ast_triples : Rdf_turtle.AST.Triples.t Alcotest.testable
+
+val ast_directive : Rdf_turtle.AST.Directive.t Alcotest.testable
+
+val ast_statement : Rdf_turtle.AST.Statement.t Alcotest.testable
+
+val ast_turtle : Rdf_turtle.AST.Turtle.t Alcotest.testable
+
diff --git a/test/turtle/main.ml b/test/turtle/main.ml
index 6ada3e4..d70ca4e 100644
--- a/test/turtle/main.ml
+++ b/test/turtle/main.ml
@@ -237,6 +237,21 @@ let predobjs_test_case =
(Result.ok @@ v))
cases)
+let directive_test_case =
+ let cases = [
+ "@base <http://one.example/> .",
+ Turtle.Directive.of_iriref (Turtle.Iriref.of_string "http://one.example/")
+ ] in
+ test_case "directive" `Quick
+ (fun () ->
+ List.iter
+ (fun (enc, v) ->
+ check (result Rdf_alcotest.ast_directive string)
+ "can parse"
+ (parse Parser.directive enc)
+ (Result.ok @@ v))
+ cases)
+
let () =
Alcotest.run "Turtle" [
"Basic parsers", [
@@ -250,5 +265,6 @@ let () =
object_test_case;
bnodeps_test_case;
predobjs_test_case;
+ directive_test_case;
]
]