Add/refactor channel-add! and channel-cleanup!

chatdir.scm

@@ -75,30 +75,30 @@
 				 "all/" hostmask))
 
 
-;; Tidies up a channel directory; removes `online` and `offline` user links, etc.
-(define (cleanup-channel conn channel)
-  (let ([users-dir (channel-users-directory-path conn channel)])
+;; Tidies up a channel directory: Removes `online` and `offline` user links.
+(define (channel-cleanup! root channel)
+  (let ([users-dir (subpath root channel ".users")])
 	(map
 	 (lambda (state-dir)
 	   (if (not (substring-index state-dir "/all"))
 		   (map
 			(lambda (link)
-			  (let ([link-path (string-append users-dir state-dir "/" link)])
+			  (let ([link-path (subpath users-dir state-dir link)])
 				(if (symbolic-link? link-path)
 					(delete-file link-path))))
-			(directory (string-append users-dir state-dir)))))
+			(directory (subpath users-dir state-dir)))))
 	   (directory users-dir))))
 
 
-;; Creates a channel's file hierarchy, if need be
-(define (make-channel conn channel)
-  (let* ([path (channel-directory-path conn channel)]
-		 [subpath (lambda (leaf) (string-append path leaf))])
-	(create-directory (subpath ".in") #t)
-	(create-directory (subpath ".users/online") #t)
-	(create-directory (subpath ".users/offline") #t)
-	(create-directory (subpath ".users/all") #t)
-	(cleanup-channel conn channel)))
+;; Creates a channel's file hierarchy; safe to run, even if the channel
+;; has already been created.
+(define (channel-add! root channel)
+  (let* ([path (subpath root channel)])
+	(create-directory (subpath path ".in") #t)
+	(create-directory (subpath path ".users" "online") #t)
+	(create-directory (subpath path ".users" "offline") #t)
+	(create-directory (subpath path ".users" "all") #t)
+	(channel-cleanup! root channel)))
 
 
 ;; Creates a user's info files in the given channel, if need bee

tests/tests.scm

@@ -1,4 +1,4 @@
-(import srfi-78)
+(import (chicken sort) srfi-78)
 (load "../chatdir.scm")
 
 (define *dir* "test chatdir")
@@ -21,8 +21,9 @@
 	   "/etc/systemd/user/momma")
 
 
+
 ;; ——————————————————————————————————————————————————
-;; File sets/gets [rooms, users, general]
+;; Room metadata sets/gets
 ;; ——————————————————————————————————————————————————
 (define *room* "dining room")
 (define *room-path* "test chatdir/dining room")
@@ -35,7 +36,6 @@
 (check (directory-file-get *room-meta-path* "topic")
 	   =>
 	   *room-topic*)
-
 (check (directory-file-get* *room-meta-path* "topic")
 	   =>
 	   (cons *room-topic* *room-topic-xattrs*))
@@ -43,23 +43,28 @@
 
 (define *room-topic-2* (randomize-string *room-topic*))
 (define *room-topic-xattrs-2* (alist-update 'user.chat.user "admin-mom" *room-topic-xattrs*))
+
 (channel-metadata-set! *dir* *room* "topic"
 					   *room-topic-2*
 					   *room-topic-xattrs-2*)
 (check (channel-metadata-get *dir* *room* "topic")
 	   =>
 	   *room-topic-2*)
-
 (check (channel-metadata-get* *dir* *room* "topic")
 	   =>
 	   (cons *room-topic-2* *room-topic-xattrs-2*))
 
 
+
+;; ——————————————————————————————————————————————————
+;; Message creating/reading
+;; ——————————————————————————————————————————————————
 (define *msg-sender* "maya")
 (define *msg-text* "eee… hiya, papaya!")
 (define *msg-date* (current-date))
 (define *msg-xattr* '(user.bovo . "muuuu"))
 (define *msg-name* (message-file-leaf *dir* *room* *msg-date*))
+
 (channel-message-add! *dir* *room* *msg-text* *msg-sender* *msg-date* `(,*msg-xattr*))
 (check (directory-file-get* (subpath *dir* *room*) *msg-name*)
 	   =>
@@ -69,14 +74,13 @@
 			 (cons 'user.chat.sender *msg-sender*)
 			 (cons 'user.chat.channel *room*)))
 
+
 (define *msg-sender-2* "bildinto")
 (define *msg-text-2* "he? ĉu vi bonsanas?")
 (define *msg-date-2* *msg-date*)
-(print "uwu")
 (define *msg-name-2* (message-file-leaf *dir* *room* *msg-date-2*))
-(print "YAY")
-(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*)
 
+(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*)
 (check (directory-file-get* (subpath *dir* *room*) *msg-name-2*)
 	   =>
 	   (list *msg-text-2*
@@ -84,4 +88,37 @@
 			 (cons 'user.chat.sender *msg-sender-2*)
 			 (cons 'user.chat.channel *room*)))
 
+
+
+;; ——————————————————————————————————————————————————
+;; Channel creation/management
+;; ——————————————————————————————————————————————————
+(define *new-room* "living room")
+(define *new-room-path* (subpath *dir* *new-room*))
+(define *new-room-all* (subpath *new-room-path* ".users" "all"))
+(if (directory-exists? *new-room-path*)
+	(delete-directory (subpath *dir* *new-room*) #t))
+(channel-add! *dir* *new-room*)
+(check (and (directory-exists? *new-room-path*)
+			(directory-exists? *new-room-all*))
+	   =>
+	   *new-room-all*)
+
+
+(define *new-room-online* (subpath *new-room-path* ".users" "online"))
+(create-symbolic-link "./" (subpath *new-room-online* "birdo"))
+(create-symbolic-link "./" (subpath *new-room-online* "mondo"))
+(check (sort (directory *new-room-online*) string<)
+	   =>
+	   '("birdo" "mondo"))
+
+
+(channel-cleanup! *dir* *new-room*)
+(check (directory *new-room-online*)
+	   =>
+	   '())
+
+
+
+;; ——————————————————————————————————————————————————
 (check-report)