From 4b6e56ebb435f16374cebf38923393dc2f27f3ce Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Sat, 9 Jan 2021 11:57:23 +0100
Subject: Initial commit

---
 ldp/resource/sxml.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 ldp/resource/sxml.scm

(limited to 'ldp/resource/sxml.scm')

diff --git a/ldp/resource/sxml.scm b/ldp/resource/sxml.scm
new file mode 100644
index 0000000..d1e4420
--- /dev/null
+++ b/ldp/resource/sxml.scm
@@ -0,0 +1,51 @@
+(define-module (ldp resource sxml)
+  #:use-module (ldp resource)
+  #:use-module (ldp path)
+  #:use-module (sxml match))
+
+(define-public (sxml->resource res)
+  (sxml-match
+   res
+   ((*TOP* (*PI* . ,whatever) . ,rest)
+    (sxml->resource `(*TOP* ,@rest)))
+   ((*TOP* ,rest)
+    (sxml->resource rest))
+   ((https://linked-data-platform.planete-kraus.eu/ns:resource
+     (@ (container "no")
+	(uri-path ,uri-path)
+	(etag ,etag)
+	(content-type ,content-type)))
+    (make-resource (string->path uri-path)
+		   etag
+		   (string->symbol content-type)
+		   #f))
+   ((https://linked-data-platform.planete-kraus.eu/ns:resource
+     (@ (container "yes")
+	(uri-path ,uri-path)
+	(etag ,etag)
+	(content-type ,content-type))
+     (https://linked-data-platform.planete-kraus.eu/ns:contains
+      (@ (path ,contents)))
+     ...)
+    (make-resource (string->path uri-path)
+		   etag
+		   (string->symbol content-type)
+		   (map string->path contents)))
+   (,otherwise
+    (scm-error 'wrong-type-arg
+	       "sxml->resource"
+	       "Expected a SXML fragment with the correct schema, not ~s."
+	       (list res)
+	       (list res)))))
+
+(define-public (resource->sxml x)
+  `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+	  (resource
+	   (@ (xmlns "https://linked-data-platform.planete-kraus.eu/ns")
+	      (container ,(if (container? x) "yes" "no"))
+	      (uri-path ,(path->string (resource-path x)))
+	      (etag ,(resource-etag x))
+	      (content-type ,(symbol->string (resource-content-type x))))
+	   ,@(map (lambda (p)
+		    `(contains (@ (path ,(path->string p)))))
+		  (or (resource-contained x) '())))))
-- 
cgit v1.2.3