summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2020-09-03 13:12:49 +0200
committerpukkamustard <pukkamustard@posteo.net>2020-09-03 13:12:49 +0200
commit6c603605aad1bab3f6bb274f56fdba023c724639 (patch)
tree55afec2cefe71994075c649985ebc89ae0947c20
parent4c2f6d772967c70109ac64031e26fb6d716ec133 (diff)
(schemantic literal): goops based datatypes
-rw-r--r--hall.scm12
-rw-r--r--schemantic/iri.scm43
-rw-r--r--schemantic/literal.scm42
-rw-r--r--schemantic/ns.scm2
-rw-r--r--schemantic/rdf.scm85
-rw-r--r--schemantic/xsd.scm27
-rw-r--r--tests/schemantic/iri.scm (renamed from tests/schemantic/rdf.scm)9
-rw-r--r--tests/schemantic/literal.scm64
8 files changed, 209 insertions, 75 deletions
diff --git a/hall.scm b/hall.scm
index 9a4bf48..ac03afa 100644
--- a/hall.scm
+++ b/hall.scm
@@ -15,10 +15,18 @@
((scheme-file "schemantic")
(directory
"schemantic"
- ((scheme-file "rdf") (scheme-file "ns")))))
+ ((scheme-file "iri")
+ (scheme-file "xsd")
+ (scheme-file "rdf")
+ (scheme-file "literal")
+ (scheme-file "ns")))))
(tests ((directory
"tests"
- ((directory "schemantic" ((scheme-file "rdf")))))))
+ ((directory
+ "schemantic"
+ ((scheme-file "iri")
+ (log-file "iri")
+ (scheme-file "literal")))))))
(programs ((directory "scripts" ())))
(documentation
((org-file "README")
diff --git a/schemantic/iri.scm b/schemantic/iri.scm
new file mode 100644
index 0000000..54cb5e5
--- /dev/null
+++ b/schemantic/iri.scm
@@ -0,0 +1,43 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (schemantic iri)
+ #:use-module (oop goops)
+ #:use-module (oop goops describe)
+
+ #:use-module (web uri)
+
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 exceptions)
+
+ #:export (<iri>
+ make-iri
+ iri?
+ iri-value
+ define-namespace))
+
+(define-class <iri> ()
+ (value #:init-keyword #:value #:getter iri-value))
+
+(define-method (equal? (x <iri>) (y <iri>))
+ (equal? (iri-value x) (iri-value y)))
+
+(define-generic make-iri)
+(define-method (make-iri (s <string>)) (make <iri> #:value s))
+(define-method (make-iri (iri <iri>)) iri)
+(define-method (make-iri (x <top>))
+ (if (uri? x)
+ (make-iri (uri->string x))
+ (no-applicable-method)))
+
+(define (iri? x)
+ "Returns true if x is an iri"
+ (is-a? x <iri>))
+
+;; Syntax for defining new namespace
+
+(define-syntax-rule (define-namespace name uri)
+ (define (name id)
+ (make-iri (string-append uri id))))
+
diff --git a/schemantic/literal.scm b/schemantic/literal.scm
new file mode 100644
index 0000000..617f732
--- /dev/null
+++ b/schemantic/literal.scm
@@ -0,0 +1,42 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (schemantic literal)
+ #:use-module (oop goops)
+
+ #:use-module (schemantic iri)
+
+ #:export (<literal>
+ literal?
+ make-literal
+ make-generic-literal
+ literal-value
+ literal-lexical
+ literal-canonical
+ literal-datatype))
+
+(define-class <literal> ()
+ (value #:init-keyword #:value #:getter literal-value))
+
+(define (literal? x)
+ (is-a? x <literal>))
+
+(define-generic make-literal)
+(define-method (make-literal (l <literal>)) l)
+
+(define-generic literal-lexical)
+(define-generic literal-canonical)
+(define-generic literal-datatype)
+
+;; Generic literal
+
+(define-class <generic-literal> (<literal>)
+ (datatype #:init-keyword #:datatype))
+
+(define-method (literal-datatype (l <generic-literal>)) (slot-ref l 'datatype))
+
+(define* (make-generic-literal value #:key datatype)
+ (if (iri? datatype)
+ (make <generic-literal> #:value value #:datatype datatype)
+ #f))
diff --git a/schemantic/ns.scm b/schemantic/ns.scm
index e84636a..70e30a9 100644
--- a/schemantic/ns.scm
+++ b/schemantic/ns.scm
@@ -3,7 +3,7 @@
; SPDX-License-Identifier: GPL-3.0-or-later
(define-module (schemantic ns)
- #:use-module (schemantic rdf)
+ #:use-module (schemantic iri)
#:export (rdf rdfs owl xsd))
(define-namespace rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
diff --git a/schemantic/rdf.scm b/schemantic/rdf.scm
index 68329a7..ededcd5 100644
--- a/schemantic/rdf.scm
+++ b/schemantic/rdf.scm
@@ -4,73 +4,33 @@
(define-module (schemantic rdf)
#:use-module (oop goops)
-
#:use-module (oop goops describe) ; only for dev/debug
- #:use-module (web uri)
- #:use-module (ice-9 optargs)
- #:use-module (ice-9 exceptions)
+ #:use-module (schemantic iri)
+ #:use-module (schemantic literal)
+ #:use-module (schemantic xsd)
- #:export (<iri>
- make-iri
- iri?
- iri-value
-
- <literal>
- literal?
- literal-value
- literal-lexical
- literal-canonical
- literal-datatype
-
- <triple>
+ #:export (<triple>
make-triple
triple?
triple-subject
triple-predicate
- triple-object
-
- define-namespace))
-
-;; IRI
-
-(define-class <iri> ()
- (value #:init-keyword #:value #:getter iri-value))
-
-(define-method (initialize (self <iri>) initargs)
- (let-keywords initargs #f (value)
- (cond
- ((string? value) (next-method self (list #:value value)))
- ((uri? value) (next-method self (list #:value (uri->string value))))
- ((iri? value) (next-method self (list #:value (iri-value value))))
- (else (raise-exception
- (make-exception
- (make-programming-error)
- (make-exception-with-message "can not cast to iri")))))))
-
-(define-method (equal? (x <iri>) (y <iri>))
- (equal? (iri-value x) (iri-value y)))
-
-(define (make-iri value)
- "Returns a new iri with value"
- (make <iri> #:value value))
-
-(define (iri? x)
- "Returns true if x is an iri"
- (is-a? x <iri>))
-
-;; Literal
-
-(define-class <literal> ())
-
-(define (literal? x)
- (is-a? x <literal>))
-
-(define-generic literal-value)
-(define-generic literal-lexical)
-(define-generic literal-canonical)
-(define-generic literal-datatype)
-
+ triple-object)
+
+ #:re-export (<iri>
+ make-iri
+ iri?
+ iri-value
+ define-namespace
+
+ <literal>
+ make-literal
+ make-generic-literal
+ literal?
+ literal-value
+ literal-lexical
+ literal-canonical
+ literal-datatype))
;; Triple
@@ -88,8 +48,3 @@
(define (triple? x)
(is-a? x <triple>))
-;; Syntax for defining new namespace
-
-(define-syntax-rule (define-namespace name uri)
- (define (name id)
- (make-iri (string-append uri id))))
diff --git a/schemantic/xsd.scm b/schemantic/xsd.scm
new file mode 100644
index 0000000..ecc3bf2
--- /dev/null
+++ b/schemantic/xsd.scm
@@ -0,0 +1,27 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (schemantic xsd)
+ #:use-module (oop goops)
+
+ #:use-module (schemantic iri)
+ #:use-module (schemantic literal)
+ #:use-module ((schemantic ns) #:select (xsd))
+
+ #:export (<xsd:string>
+ <xsd:integer>))
+
+(define-class <xsd:string> (<literal>))
+(define-method (literal-lexical (x <xsd:string>)) (literal-value x))
+(define-method (literal-canonical (x <xsd:string>)) (literal-value x))
+(define-method (literal-datatype (x <xsd:string>)) (xsd "string"))
+(define-method (make-literal (s <string>)) (make <xsd:string> #:value s))
+
+(define-class <xsd:integer> (<literal>))
+(define-method (literal-lexical (x <xsd:integer>)) (number->string (literal-value x)))
+(define-method (literal-canonical (x <xsd:integer>)) (number->string (literal-value x)))
+(define-method (literal-datatype (x <xsd:integer>)) (xsd "integer"))
+(define-method (make-literal (s <integer>)) (make <xsd:integer> #:value s))
+
+;; TODO add the other XSD datatypes
diff --git a/tests/schemantic/rdf.scm b/tests/schemantic/iri.scm
index bc13c1b..3b7d44a 100644
--- a/tests/schemantic/rdf.scm
+++ b/tests/schemantic/iri.scm
@@ -2,13 +2,12 @@
;
; SPDX-License-Identifier: GPL-3.0-or-later
-(define-module (tests schemantic rdf)
- #:use-module (schemantic rdf)
+(define-module (tests schemantic iri)
+ #:use-module (schemantic iri)
#:use-module (web uri)
#:use-module (srfi srfi-64))
(define-namespace ex "http://example.com/#")
-(define-namespace ex2 "http://another-example.com/#")
(test-begin "iri")
@@ -36,7 +35,3 @@
(make-iri 4))
(test-end "iri")
-
-(equal?
- (make-iri "http://example.com/#")
- (make-iri "http://example.com/#"))
diff --git a/tests/schemantic/literal.scm b/tests/schemantic/literal.scm
new file mode 100644
index 0000000..486ca08
--- /dev/null
+++ b/tests/schemantic/literal.scm
@@ -0,0 +1,64 @@
+; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (tests schemantic literal)
+ #:use-module (oop goops)
+ #:use-module (schemantic rdf)
+ #:use-module (schemantic xsd)
+ #:use-module ((schemantic ns) #:select (xsd))
+
+ #:use-module (srfi srfi-64))
+
+(define-namespace ex "http://example.com/#")
+
+(test-begin "generic literal")
+
+(test-assert "generic literal is a literal"
+ (literal?
+ (make-generic-literal 1.9 #:datatype (ex "my-datatype"))))
+
+(test-equal
+ (ex "my-datatype")
+ (literal-datatype
+ (make-generic-literal 1.9 #:datatype (ex "my-datatype"))))
+
+(test-end "generic literal")
+
+(test-begin "xsd:string")
+
+(test-assert "string is cast to a literal"
+ (literal? (make-literal "hello")))
+
+(test-assert "string is cast to a xsd:string"
+ (is-a? (make-literal "hello") <xsd:string> ))
+
+(test-equal "datatype is xsd:string"
+ (xsd "string") (literal-datatype (make-literal "hello")))
+
+(test-equal "value of xsd:string can be refed"
+ "hello"
+ (literal-value (make-literal "hello")))
+
+(test-end "xsd:string")
+
+(test-begin "xsd:integer")
+
+(test-assert "integer is cast to a literal"
+ (literal? (make-literal 42)))
+
+(test-assert "integer is cast to a xsd:integer"
+ (is-a? (make-literal 42) <xsd:integer>))
+
+(test-equal "datatype is xsd:integer"
+ (xsd "integer") (literal-datatype (make-literal 42)))
+
+(test-equal "value of xsd:integer can be refed"
+ 42
+ (literal-value (make-literal 42)))
+
+(test-equal "lexical value is string representatoin"
+ "42"
+ (literal-lexical (make-literal 42)))
+
+(test-end "xsd:integer")