UNFINISHED work on data stores and formats.

13 files changed, 590 insertions, 37 deletions

diff --git a/module/calp.scm b/module/calp.scm
index 81268cbb..b1952547 100644
--- a/module/calp.scm
+++ b/module/calp.scm
@@ -1,4 +1,9 @@
-(define-module (calp))
+(define-module (calp)
+  :export (version prodid))
 
 ;; Update me on new release
-(define-public version "0.6.1")
+(define version "0.6.1")
+
+(define (prodid)
+  (format #f "-//hugo//calp ~a//EN"
+          (@ (calp) version)))
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index e4982336..472c5074 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -30,6 +30,7 @@
            parameters
            properties
 
+           copy-as-orphan
            copy-vcomponent
            x-property?
            internal-field?
@@ -198,23 +199,25 @@
               ;; TODO deep-copy on parameters?
               (get-vline-parameters vline)))
 
+(define (copy-as-orphan component)
+  (make-vcomponent%
+   (type component)
+   (children component)
+   ;; properties
+   (alist->hashq-table
+    (hash-map->list (lambda (key value)
+                      (cons key (if (list? value)
+                                    (map copy-vline value)
+                                    (copy-vline value))))
+                    (get-component-properties component)))))
+
+
 (define (copy-vcomponent component)
-  (let ((ev
-         (make-vcomponent%
-          (type component)
-          (children component)
-          ;; properties
-          (alist->hashq-table
-           (hash-map->list (lambda (key value)
-                             (cons key (if (list? value)
-                                           (map copy-vline value)
-                                           (copy-vline value))))
-                           (get-component-properties component))))))
+  (let ((ev (copy-as-orphan component)))
     (when (parent component)
       (reparent! (parent component) ev))
     ev))
 
-
 (define (extract field)
   (lambda (e) (prop e field)))
 
diff --git a/module/vcomponent/data-stores/caldav.scm b/module/vcomponent/data-stores/caldav.scm
new file mode 100644
index 00000000..f9ba61c1
--- /dev/null
+++ b/module/vcomponent/data-stores/caldav.scm
@@ -0,0 +1,270 @@
+(define-module (vcomponent data-stores caldav)
+  )
+
+(use-modules (srfi srfi-71)
+             (srfi srfi-88)
+             (rnrs bytevectors)
+             (rnrs io ports)
+             ((ice-9 binary-ports) :select (call-with-output-bytevector))
+             (web request)
+             (web response)
+             (web client)
+             (web uri)
+             ;; (web http)                 ;
+             (sxml simple)
+             (oop goops)
+             (vcomponent data-stores common)
+             ((hnh util) :select (->))
+             (web http dav)
+             )
+
+
+
+(define-class <caldav-data-store> (<calendar-data-store>)
+  (host init-keyword: host:
+        getter: host)
+  (user init-keyword: user:
+        getter: user)
+  (calendar-path init-keyword: calendar-path:
+                 accessor: calendar-path)
+  (password init-keyword: password:
+            getter: store-password))
+
+
+(define local-uri
+  (case-lambda ((this path)
+                (build-uri 'https
+                           host: (host this)
+                           path: path))
+               ((this)
+                (build-uri 'https
+                           host: (host this)
+                           path: (calendar-path this)))))
+
+
+(define* (make-caldav-store key: host user path password)
+  (define store
+    (make <caldav-data-store>
+      host: host
+      user: user
+      password: (string->symbol password)
+      calendar-path: path))
+
+
+  (let* ((principal-path
+           (get-principal (local-uri store "/")
+                          password: (store-password store)))
+         (calendar-home-set
+           (get-calendar-home-set (local-uri store principal-path)
+                                  password: (store-password store)))
+         (calendar-paths
+           (get-calendar-paths (local-uri store calendar-home-set)
+                               password: (store-password store))))
+    (set! (calendar-path store)
+      (car calendar-paths)))
+
+  store)
+
+(define-method (write (this <caldav-data-store>) port)
+  (write `(make-caldav-store host: ,(host this)
+                             user: ,(user this)
+                             calendar-path: ,(calendar-path this)
+                             password: ,(store-password this))
+         port))
+
+(define store
+ (make-caldav-store host: "dav.fruux.com"
+                    user: "a3298201184"
+                    password: "YjMyOTc0NjUwMDk6YXRhc3llanY2MGtu"))
+
+#;
+(define-method (calendar-base (this <caldav-data-store>))
+  (build-uri 'https
+            host: (host this)
+            path: (calendar-path this)))
+
+
+;; (define-method (get-all (this <caldav-data-store>))
+;;   )
+
+(define-method (get-by-uid (this <caldav-data-store>)
+                           (uid <string>))
+  (let ((uids
+         (dav (local-uri this)
+              method: 'REPORT
+              authorization: `(Basic ,(store-password this))
+              depth: 1
+              body:
+              `(c:calendar-query
+                (@ (xmlns:c ,caldav))
+                (d:prop (@ (xmlns:d "DAV:"))
+                        (d:getetag)
+                        #; (c:calendar-data)
+                        )
+                (c:filter
+                 (c:comp-filter
+                  (@ (name "VCALENDAR"))
+                  (c:comp-filter
+                   (@ (name "VEVENT"))
+                   (c:prop-filter
+                    (@ (name "UID"))
+                    (c:text-match (@ (collation "i;octet"))
+                                  ,uid)))))))))
+    uids))
+
+
+(define-method (search (this <caldav-data-store>)
+                       (filter <pair>))
+  (let ((uids
+         (dav (local-uri this)
+              method: 'REPORT
+              authorization: `(Basic ,(store-password this))
+              depth: 1
+              body:
+              `(c:calendar-query
+                (@ (xmlns:c ,caldav))
+                (d:prop (@ (xmlns:d "DAV:"))
+                        (d:getetag)
+                        (c:calendar-data
+                         (c:comp (@ (name "VCALENDAR"))
+                                 (c:prop (@ (name "PRODID")))))
+                        #; (c:calendar-data)
+                        )
+                ,filter))))
+    uids))
+
+(define-method (search (this <caldav-data-store>)
+                       (filter <string>)
+                       (field <string>))
+  (search store
+          `(c:filter
+            (c:comp-filter
+             (@ (name "VCALENDAR"))
+             (c:comp-filter
+              (@ (name "VEVENT"))
+              (c:prop-filter
+               (@ (name ,field))
+               (c:text-match (@ (collation "i;octet"))
+                             ,filter)))))))
+
+
+
+(define-method (list-calendars (this <caldav-data-store>))
+  )
+
+
+
+
+(get-principal) ; => "/principals/uid/a3298201184/"
+
+(get-calendar-home-set "/principals/uid/a3298201184/")
+;; => "/calendars/a3298201184/"
+
+(get-calendar-paths "/calendars/a3298201184/")
+;; => ("/calendars/a3298201184/b85ba2e9-18aa-4451-91bb-b52da930e977/")
+
+
+
+(define user "a3298201184")
+(define calendar "b85ba2e9-18aa-4451-91bb-b52da930e977")
+(define password (string->symbol "YjMyOTc0NjUwMDk6YXRhc3llanY2MGtu"))
+(define auth `(Basic ,password))
+
+
+
+
+
+
+(define uri
+  (build-uri 'https
+             host: "dav.fruux.com"
+             path: "/calendars/a3298201184/b85ba2e9-18aa-4451-91bb-b52da930e977/ff95c36c-6ae9-4aa0-b08f-c52d84bf4f26.ics"))
+
+(define-values (response body)
+  (dav uri
+       method: 'GET
+       authorization: auth))
+
+
+
+
+(define-values (response body)
+  (dav uri
+       method: 'PROPFIND
+       authorization: auth
+       body:
+       `(C:supported-collation-set (@ (xmlns:C ,caldav)))))
+
+(define-values (response body)
+  (dav uri
+       method: 'REPORT
+       authorization: auth
+       body:
+       `(C:calendar-query
+         (@ (xmlns:C ,caldav))
+         (D:prop (@ (xmlns:D "DAV:"))
+                 (D:getetac)
+                 (C:calendar-data))
+         (C:filter
+          (C:comp-filter (@ (name "VCALENDAR"))
+                         (C:comp-filter (@ (name "VEVENT"))
+                                        (C:prop-filter (@ (name "UID"))
+                                                       (C:text-match (@ (collation "i;utf-8"))
+                                                                     "Admittansen"))))))))
+
+
+
+
+
+
+(define (add)
+ ;; add new event
+ (http-request 'PUT
+               path: "/path-on-server/<filename>.ics"
+               headers:
+               ((if-none-match "*")
+                (content-type "text/calendar"))
+               body: (ics:serialize event-with-wrapping-calendar)
+               ))
+
+
+(define (get-by-time-range)
+  (http-request 'REPORT
+                path: "/calendar/<calendar-name>"
+                body:
+                ;; See RFC 4791 7.8.1
+                `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                        (C:calendar-query
+                         (@ (xmlns:D "DAV:")
+                            (xmlns:C "urn:ietf:params:xml:ns:caldav"))
+                         (D:prop
+                          (D:getetag)
+                          (C:calendar-data
+                           (C:comp
+                            (@ (name "VCALENDAR"))
+                            (C:prop (@ (name "VERSION")))
+                            (C:prop (@ name "VEVENT")
+                                    (C:prop (@ (name "SUMMARY")))
+                                    ...))))
+                         (C:filter
+                          (C:comp-filter
+                           (@ (name "VCALENDAR"))
+                           (C:comp-filter
+                            (@ (name "VEVENT"))
+                            (C:time-range
+                             (@ (start ,(datetime->string
+                                         start
+                                         "~Y~m~dT~H~M~S~Z"))
+                                (end ,(datetime->string
+                                       end
+                                       "~Y~m~dT~H~M~S~Z")))))))))))
+
+
+
+
+
+;; (use-modules (curl))
+;; (define c (curl-easy-init))
+;; (curl-easy-setopt c 'url "https://hornquist.se")
+
+;; (curl-easy-perform handle)
diff --git a/module/vcomponent/data-stores/common.scm b/module/vcomponent/data-stores/common.scm
index d6775141..2fb4422a 100644
--- a/module/vcomponent/data-stores/common.scm
+++ b/module/vcomponent/data-stores/common.scm
@@ -2,25 +2,42 @@
   :use-module ((srfi srfi-88) :select ())
   :use-module (oop goops)
   :export (<calendar-data-store>
-           path
+           ;; path
            get-all
            get-by-uid))
 
 
 (define-class <calendar-data-store> ()
-  (path init-keyword: path:
-        getter: path)
+  ;; (path init-keyword: path:
+  ;;       getter: path)
   )
 
+
+;;; In (calp server routes)
+
+
+
+
+;;; Load - Load store into memero
+;;; Dump - Save store into "disk"
+
 
 (define-method (get-all (this <calendar-data-store>))
   (scm-error 'not-implemented "get-all"
              "Get-all is not implemented for ~s"
-             (list (class-of this))
+             (class-of this)
              #f))
 
 (define-method (get-by-uid (this <calendar-data-store>) (uid <string>))
   (scm-error 'not-implemented "get-by-uid"
              "Get-by-uid is not implemented for ~s"
-             (list (class-of this))
+             (class-of this)
              #f))
+
+
+(define-method (color (this <calendar-data-store>))
+  "")
+
+
+(define-method (displayname (this <calendar-data-store>))
+  "")
diff --git a/module/vcomponent/data-stores/file.scm b/module/vcomponent/data-stores/file.scm
index 0f09d81c..54676224 100644
--- a/module/vcomponent/data-stores/file.scm
+++ b/module/vcomponent/data-stores/file.scm
@@ -1,4 +1,32 @@
 (define-module (vcomponent data-stores file)
   :use-module (oop goops)
+  :use-module ((srfi srfi-88) :select ())
+  :use-module ((calp) :select (prodid))
   :use-module (vcomponent data-stores common)
+  :use-module ((vcomponent formats ical) :select (serialize deserialize))
+  )
+
+(define-class <file-data-store> (<calendar-data-store>)
+  (path getter: path
+        init-keyword: path:))
+
+(define (make-file-store path)
+  (make <file-store> path: path))
+
+(define-method (get-all (this <file-data-store>))
+  ;; X-WR-CALNAME ⇒ NAME
+  ;; X-WR-CALDESC
+  (call-with-input-file (path this)
+    deserialize))
+
+(define-method (get-by-uid (this <file-data-store>) (uid <string>))
+  #f
+  )
+
+(define-method (queue-write (this <file-data-store>) vcomponent)
+  )
+
+(define-method (flush (this <file-data-store>))
+  (with-atomic-output-to-file (path this)
+    (lambda () (serialize (data this) (current-output-port))))
   )
diff --git a/module/vcomponent/data-stores/meta.scm b/module/vcomponent/data-stores/meta.scm
index c670d692..8ec5f7fd 100644
--- a/module/vcomponent/data-stores/meta.scm
+++ b/module/vcomponent/data-stores/meta.scm
@@ -6,12 +6,24 @@
 (define-module (vcomponent data-stores meta)
   :use-module (oop goops)
   :use-module (vcomponent data-stores common)
+  :use-module (srfi srfi-41)
   :use-module ((srfi srfi-88) :select ())
   :export ()
   )
 
 (define-class <meta-data-store> (<calendar-data-store>)
   (stores accessor: stores
-          init-value: '()))
+          init-value: '()
+          init-keyword: stores:))
 
-(define-method (get-calendar ))
+
+
+(define-method (get-all (this <meta-data-store>))
+  (map get-all (stores this)))
+
+(define-method (get-by-uid (this <meta-data-store>) (uid <string>))
+  (stream-car
+   (stream-append
+    (steam-map (lambda (store) (get-by-uid store uid))
+               (list->stream (stores this)))
+    (stream #f))))
diff --git a/module/vcomponent/data-stores/vdir.scm b/module/vcomponent/data-stores/vdir.scm
index fca59092..f0ed0fdc 100644
--- a/module/vcomponent/data-stores/vdir.scm
+++ b/module/vcomponent/data-stores/vdir.scm
@@ -1,17 +1,87 @@
 (define-module (vcomponent data-stores vdir)
+  :use-module (hnh util)
   :use-module (oop goops)
   :use-module (vcomponent data-stores common)
+  :use-module (srfi srfi-71)
   :use-module ((srfi srfi-88) :select ())
+  :use-module (hnh util path)
+  :use-module ((vcomponent formats ical) :select (serialize deserialize))
+  :use-module ((ice-9 ftw) :select (scandir))
   :export ())
 
 (define-class <vdir-data-store> (<calendar-data-store>)
+  (path getter: path
+        init-keyword: path:)
+  (loaded-calendar accessor: loaded-calendar
+                   init-value: #f)
+  (uid-map accessor: uid-map
+           init-value: #f)
   )
 
+(define (make-vdir-store path)
+  (make <vdir-data-store> path: path))
+
+(define* (get-attribute path key key: dflt)
+  (catch 'system-error
+    (lambda () (call-with-input-file (path-append path key) read-line))
+    (const dflt)))
+
+
 (define-method (get-all (this <vdir-data-store>))
-  '())
+  (let ((files (scandir (path this) (lambda (item) (string-ci=? "ics" (filename-extension item)))))
+        (calendar (make-vcomponent 'VCALENDAR)))
+    (set! (prop calendar 'NAME)  (get-attribute (path this) "displayname")
+          (prop calendar 'COLOR) (get-attribute (path this) "color" "#FFFFFF"))
+    (for-each (lambda (item) (reparent! calendar item))
+              (append-map (lambda (file)
+                            (define cal
+                              (call-with-input-file (path-append (path this) file)
+                                deserialize))
+                            (unless (eq? 'VCALENDAR (type cal))
+                              (scm-error 'misc-error "get-all<vdir-data-store>"
+                                         "Unexpected top level component. Expected VCALENDAR, got ~a. In file ~s"
+                                         (list (type cal) file)))
+                            (for-each (lambda (child)
+                                        (set! (prop child '-X-HNH-FILENAME) file))
+                                      (children cal))
+                            )
+                          files))
+    (set! (loaded-calendar this) calendar)
+    calendar))
+
 
 (define-method (get-by-uid (this <vdir-data-store>) (uid <string>))
-  #f
-  )
+  (unless (uid-map this)
+    (let ((cal
+           (or (loaded-calendar this)
+               (get-all this))))
+      (define ht (make-hash-table))
+      (for-each (lambda (ev) (hash-set! ht (uid ev) ev))
+                (children cal))
+      (set! (uid-map this) ht)))
+  (hash-ref m uid #f))
+
+
+(define (wrap-for-output . vcomponents)
+  (let ((calendar (make-vcomponent 'VCALENDAR)))
+    (set! (prop calendar 'VERSION) "2.0"
+          (prop calendar 'PRODID) (prodid)
+          (prop calendar 'CALSCALE) "GREGORIAN")
+    (for-each (lambda (vcomponent) (reparent! calendar vcomponent))
+              vcomponents)
+    calendar))
+
+(define-method (queue-write (this <vdir-data-store>) vcomponent)
+  ;; TODO Multiple components
+  (let ((filename
+         (cond ((prop vcomponent '-X-HNH-FILENAME)
+                => identity)
+               (else
+                (format #f "~a.ics" (prop vcomponent 'UID))))))
+    (with-atomic-output-to-file (path-append (path this) filename)
+      (lambda () (serialize (wrap-for-output vcomponent) (current-output-port))))))
+
+(define-method (flush (this <vdir-data-store>))
+  (sync))
 
 ;; (define (get-in-date-interval ))
diff --git a/module/vcomponent/formats/ical.scm b/module/vcomponent/formats/ical.scm
index 294642de..dddca946 100644
--- a/module/vcomponent/formats/ical.scm
+++ b/module/vcomponent/formats/ical.scm
@@ -10,9 +10,8 @@
 
 
 (define (serialize component port)
-  (display (component->ical-string component)
-           port))
+  (with-output-to-port port
+    (lambda () (component->ical-string component))))
 
 (define (deserialize port)
-  (parse-calendar port)
-  )
+  (parse-calendar port))
diff --git a/module/vcomponent/formats/ical/output.scm b/module/vcomponent/formats/ical/output.scm
index 4d37dff6..57860d2a 100644
--- a/module/vcomponent/formats/ical/output.scm
+++ b/module/vcomponent/formats/ical/output.scm
@@ -16,6 +16,7 @@
   :use-module (vcomponent geo)
   :use-module (vcomponent formats ical types)
   :use-module (vcomponent recurrence)
+  :use-module ((calp) :select (prodid))
   :use-module (calp translation)
   :autoload (vcomponent util instance) (global-event-object)
   :export (component->ical-string
@@ -24,10 +25,6 @@
            print-events-in-interval
            ))
 
-(define (prodid)
-  (format #f "-//hugo//calp ~a//EN"
-          (@ (calp) version)))
-
 
 ;; Format value depending on key type.
 ;; Should NOT emit the key.
diff --git a/module/vcomponent/formats/sxcal.scm b/module/vcomponent/formats/sxcal.scm
index caf453ec..c02dbada 100644
--- a/module/vcomponent/formats/sxcal.scm
+++ b/module/vcomponent/formats/sxcal.scm
@@ -1,11 +1,16 @@
 (define-module (vcomponent formats sxcal)
-               :export (serialize deserialize)
-               )
+  :use-module ((vcomponent formats xcal parse)
+               :select (sxcal->vcomponent))
+  :export (serialize deserialize)
+  )
 
 
 (define (serialize component port)
-  'TODO
-  )
+  (write (serialize/object component) port))
+
+(define (serialize/object component)
+  ;; TODO where is this defined?
+  (vcomponent->sxcal component))
 
 (define (deserialize port)
   (sxcal->vcomponent port))
diff --git a/module/vcomponent/formats/xcal.scm b/module/vcomponent/formats/xcal.scm
index 2732a5a7..cfc70a92 100644
--- a/module/vcomponent/formats/xcal.scm
+++ b/module/vcomponent/formats/xcal.scm
@@ -14,6 +14,9 @@
       (sxml->xml port)
       ))
 
+(define (serialize/object component)
+  (call-with-output-string (lambda (p) (serialize component p))))
+
 
 (define (deserialize port)
   (-> (xml->sxml port)
diff --git a/module/web/http/dav.scm b/module/web/http/dav.scm
new file mode 100644
index 00000000..9adc8b87
--- /dev/null
+++ b/module/web/http/dav.scm
@@ -0,0 +1,144 @@
+(define-module (web http dav)
+  :use-module (srfi srfi-9)
+  :use-module (srfi srfi-88)
+  :use-module (rnrs bytevectors)
+  :use-module (rnrs io ports)
+  :use-module ((ice-9 binary-ports) :select (call-with-output-bytevector))
+  :use-module (web request)
+  :use-module (web response)
+  :use-module (web client)
+  :use-module (web uri)
+  :use-module (sxml simple)
+  :use-module (sxml xpath)
+  :use-module ((hnh util) :select (->))
+  :export (caldav
+           user-agent dav
+           propfind
+           get-principal
+           get-calendar-home-set
+           get-calendar-paths
+           get-calendar-name
+           )
+  )
+
+(define caldav "urn:ietf:params:xml:ns:caldav")
+(define user-agent (make-parameter ""))
+(user-agent "calp/0.1")
+
+(define-record-type <info>
+  (make-info uri-creator password)
+  info?
+  (uri-creator uri-creator)
+  (password info-password)
+  )
+
+(define (with-output-to-bytevector thunk)
+  (call-with-output-bytevector
+   (lambda (port)
+     (with-output-to-port port thunk))))
+
+;; Make a webdav HTTP request, body should be a sxml tree without the *TOP* or
+;; *PI* element.
+(define* (dav uri key: method authorization body (depth 1))
+  (define request-body
+    (if body
+        (with-output-to-bytevector
+         (lambda ()
+           (sxml->xml
+            `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                    ,body))))
+        #f))
+
+  (define headers
+    `((user-agent . ,(user-agent))
+      (depth . ,(cond (depth number? => number->string)
+                      (else depth)))
+      ;; (accept . ((*/*)))
+      (authorization . ,authorization)
+      ,@(if body
+            `((content-type . (application/xml (charset . "UTF-8")))
+              (content-length . ,(bytevector-length request-body)))
+            '())))
+
+  (http-request uri
+                method: method
+                body: request-body
+                headers: headers
+                keep-alive?: #t
+                decode-body?: #f
+                streaming?: #t))
+
+(define* (propfind uri resource key: (depth 1) password)
+  (define authorization
+    (if password
+        `(Basic ,password)
+        #f))
+  (define-values (response port)
+    (dav uri
+         method: 'PROPFIND
+         authorization: authorization
+         depth: depth
+         body: `(propfind (@ (xmlns "DAV:")
+                             (xmlns:d "DAV:")
+                             (xmlns:c ,caldav))
+                          (prop (,resource)))))
+  (unless (= 207 (response-code response))
+    (scm-error 'dav-error "propfind"
+               "HTTP error ~a: ~a"
+               (list
+                (response-code response)
+                (response-reason-phrase response))
+               (list response)))
+  (xml->sxml port
+             declare-namespaces?: #t
+             trim-whitespace?: #t
+             namespaces: `((d . "DAV:")
+                           (c . ,caldav))))
+
+
+;; (define (get-collections)
+;;   (-> (propfind "/" 'resourcetype)
+;;       ((sxpath '(// (d:response (// d:resourcetype d:collection))
+;;                     d:href *text*)))))
+
+;; => ((d:resourcetype (d:collection)))
+
+(define* (get-principal uri key: password)
+  (-> (propfind uri 'current-user-principal
+                depth: 0
+                password: password)
+      ((sxpath '(// (d:response (d:href (equal? "/")))
+                    //
+                    d:prop d:current-user-principal
+                    d:href *text*)))
+      car))
+
+(define* (get-calendar-home-set principal-uri key: password)
+  (-> (propfind principal-uri
+                'c:calendar-home-set
+                password: password)
+      ((sxpath `(// (d:response (d:href
+                                 (equal? ,(uri-path principal-uri))))
+                    // d:prop c:calendar-home-set
+                    d:href *text*
+                    )))
+      car))
+
+(define* (get-calendar-paths calendar-home-set-uri key: password)
+  (-> (propfind calendar-home-set-uri
+                'resourcetype
+                depth: "infinity"
+                password: password)
+      ((sxpath '(// (d:response (// d:resourcetype c:calendar))
+                    d:href *text*)))))
+
+;; => ("Calendar")
+(define* (get-calendar-name calendar-path
+                           key: password)
+  (-> (propfind calendar-path 'displayname
+                depth: 0
+                password: password)
+      ((sxpath '(// d:response // d:prop d:displayname *text*)))
+      car))
+
+
diff --git a/scripts/set-version b/scripts/set-version
index 6f9d694c..fef13e90 100755
--- a/scripts/set-version
+++ b/scripts/set-version
@@ -6,4 +6,4 @@ fi
 
 VERSION=$1
 sed -i "s/^pkgver=.*/pkgver=$VERSION/" system/PKGBUILD
-sed -i "s/^(define-public version.*/(define-public version \"$VERSION\")/" module/calp.scm
+sed -i "s/^(define version.*/(define version \"$VERSION\")/" module/calp.scm