Swap out JSON output with file-based output

Right about now I've completely ditched the whole
'chatd-JSON-standard-chat-format' thing. A much
cooler idea has struck me:

Chatdir! It's Maildir, but for chats! Must I
really say more?

irc-chatd.scm

@@ -16,87 +16,91 @@
 ;;
 
 (import scheme
-		(chicken file) (chicken file posix) (chicken io) (chicken keyword)
+		(chicken file) (chicken file posix) (chicken io) (chicken keyword) (chicken random)
 		(chicken pretty-print) (chicken process-context)
 		(chicken process-context posix) (chicken string)
-		srfi-1 srfi-13 srfi-69 srfi-180
+		srfi-1 srfi-13 srfi-19 srfi-69 srfi-180
 		ircc
+		xattr
 		getopt-long)
 
 
-;; Write a to-be-JSON alist to the appropriate output
+;; Returns the path of a channel's directory
-(define (chatd-json-write conn alist)
+(define (channel-directory-path conn channel)
-  (let* ([configured-output? (hash-table-exists? conn 'output)]
+  (string-append (hash-table-ref conn 'directory)
-		 [output (if configured-output?
+				 "/" channel "/"))
-					 (open-output-file (hash-table-ref conn 'output))
-					 (open-output-file* fileno/stdout))])
-	(json-write alist output)
-	(write-string "\n" #f output)
-	(if configured-output?
-		(close-output-port output))))
 
 
-;; Return a user-info in chatd-friendly alist-format, by its alist
+;; Returns the .users/ path of a channel
-(define (user-alist conn nick)
+(define (users-directory-path conn channel)
-  (let* ([ircc-alist (irc:user-alist conn nick)]
+  (string-append (channel-directory-path conn channel)
-		 [hostmask (alist-ref 'hostmask ircc-alist)])
+				 ".users/"))
-	(if (not hostmask)
-		(list (cons 'name nick))
-		(list (cons 'name nick)
-			  (cons 'id (irc:hostmask-userhost hostmask))))))
 
 
-;; Return an IRC room in chatd-amicable alist-format, using its hashtable
+;; Tidies up a channel directory; removes `online` and `offline` user links, etc.
-(define (channel-alist conn channel)
+(define (cleanup-channel conn channel)
-  (let ([channel-table (irc:channel-table conn channel)])
+  #t)
-	(filter
-	 (lambda (item) item)
-	 (list
-	  (cons 'id channel)
-	  (cons 'name channel)
-	  (cons 'topic (if (hash-table-exists? channel-table 'topic)
-					   (hash-table-ref channel-table 'topic)
-					   #f))
-	  (cons 'users
-			(map
-			 (lambda (nick)
-			   (cons 'user (user-alist conn nick)))
-			 (hash-table-ref channel-table 'users)))))))
 
 
-;; Returns a channel's chatd-friendly alist format, but solely with ID
+;; Creates a channel's file hierarchy, if need be
-(define (channel-alist-short conn channel)
+(define (make-channel conn channel)
-  (list
+  (let ([path (channel-directory-path conn channel)])
-   (cons 'id channel)
+	(create-directory (string-append path "/.users/online") #t)
-   (cons 'name channel)))
+	(create-directory (string-append path "/.users/offline") #t)
+	(create-directory (string-append path "/.users/all") #t)
+	(cleanup-channel conn channel)))
 
 
-;; Used for creating chatd-format messages
+;; Creates a user's info files in the given channel, if need bee
-;; The optional args are key-value pairs, as follows:
+(define (make-user conn channel hostmask)
-;; #:text #:id #:user #:channel #:long-channel #:additional
+  (let ([path (string-append (channel-directory-path conn channel)
-(define (compose-event-alist conn event . args)
+							 "/.users/all/"
-  (let ([text (get-keyword #:text args)]
+							 (irc:hostmask-nick hostmask) "/")])
-		[user (get-keyword #:user args)]
+	(create-directory path #t)
-		[channel (get-keyword #:channel args)]
+	(call-with-output-file (string-append path "hostmask")
-		[additional (get-keyword #:additional args)])
+	  (lambda (out-port)
-  (filter
+		(write-string hostmask #f out-port)))))
-   (lambda (item) (not (eq? #f item)))
+
-;;	(if additional additional list)
+
-	(list (cons 'event event)
+;; Removes/Adds a symbolic link to a subdirectory of users/ named `state`.
-;;		  (if additional additional #f)
+(define (user-toggle-state conn channel user state)
-		  (if text
+  #f)
-			  (cons 'content
+
-					(list (cons 'type "plain/text")
+
-						  (cons 'body text)))
+;; Returns the appropriate, non-colliding file path of a hypothetical message
-			  #f)
+(define (message-file-path conn channel #!optional (suffix ""))
-		  (if user
+  (let ([path
-			  (cons 'user (user-alist conn user))
+		 (string-append (channel-directory-path conn channel)
-			  #f)
+						(date->string (current-date) "[~m-~d] ~H:~M:~S")
-		  (if channel
+						suffix)])
-			  (if (get-keyword #:long-channel args)
+	(if (file-exists? path)
-				   (cons 'channel (channel-alist conn channel))
+		(message-file-path conn channel
-				   (cons 'channel (channel-alist-short conn channel)))
+						   (number->string (+ (or (string->number suffix) 0) .1)))
-			  #f)))))
+		path)))
+
+
+;; Create a message file; putting metadata in xattrs, and text directly in the file
+(define (make-message-file conn channel sender message)
+  (let ([file (message-file-path conn channel)])
+	(call-with-output-file file
+	  (lambda (out-port) (write-string message #f out-port)))
+	(set-xattr file "user.chat.sender" sender)
+	(set-xattr file "user.chat.date" (date->string (current-date) "~1T~2"))
+	(set-xattr file "user.chat.channel" channel)
+	(set-xattr file "user.chat.mime" "text/plain")))
+
+
+;; Sets a channel's .topic file
+(define (set-channel-topic conn channel topic #!optional (username #f) (date #f))
+  (let ([topic-path (string-append (channel-directory-path conn channel)
+								   ".topic")])
+	(if (string? topic)
+		(call-with-output-file
+			topic-path
+		  (lambda (out-port)
+			(write-string topic #f out-port))))
+	(if username
+		(set-xattr topic-path "user.chat.sender" (irc:hostmask-nick username)))))
 
 
 ;; Hook function for irc:loop; handles all IRC commands
@@ -108,26 +112,23 @@
 	(let ([target (if (irc:user-is-self? conn (car params))
 					  (irc:hostmask-nick sender)
 					  (car params))])
-	  (chatd-json-write conn
+	  (make-message-file conn target (irc:hostmask-nick sender) (last params)))]
-	   (compose-event-alist conn "message" #:channel target
-							#:text (last params) #:user (irc:hostmask-nick sender))))]
 
    [(or (string=? cmd "NOTICE")
 		(and (string=? cmd "PRIVMSG")
 			 (or (string-null? sender) (not (irc:hostmask? sender)))))
-	(chatd-json-write conn
+	(make-message-file conn ".server" "server" (last params))]
-	  (compose-event-alist conn "server-message"
+
-						   #:text (last params)))]
+   [(and (string=? cmd "JOIN") (irc:user-is-self? conn sender))
+	(make-channel conn (last params))]
 
    [(string=? cmd "JOIN")
-	(chatd-json-write conn
+	(make-user conn (last params) sender)]
-	 (compose-event-alist conn "room-join" #:channel (car params)
-						  #:user (irc:hostmask-nick sender)))]
-   [(string=? cmd "NICK")
-	(chatd-json-write conn
-	 (compose-event-alist conn "user-info" #:user (last params)))])
-)
 
+;;   [(string=? cmd "NICK")
+;;	(chatd-json-write conn
+;;	 (compose-event-alist conn "user-info" #:user (last params)))])
+))
 
 
 ;; Hook function for irc:loop; handles all IRC errors and replies
@@ -136,18 +137,26 @@
       [(eq? reply RPL_WELCOME)
 	   (irc:write-cmd conn "JOIN" "#thevoid")]
 
-	  ;; After receiving a user-list or topic update, tell the user!
+	  ;; If topic set, output to a channel's .topic file
-	  [(let ([channel (second params)])
+	  [(and (eq? reply RPL_TOPIC)
-		 (and (irc:channel? channel)
+			(irc:channel? (second params)))
-			  (or (eq? reply RPL_TOPIC)
+	   (set-channel-topic conn (second params) (last params))]
-				  (eq? reply RPL_TOPICWHOTIME)
+
-				  (and (irc:capability? conn 'userhost-in-names)
+	  [(and (eq? reply RPL_TOPICWHOTIME)
-					   (eq? reply RPL_ENDOFNAMES))
+			(irc:channel? (second params)))
-				  (eq? reply RPL_ENDOFWHO))))
+	   (set-channel-topic conn (second params) #f (third params) (last params))]
-	   (chatd-json-write conn
+
-		(compose-event-alist conn "room-info" #:channel (second params) #:long-channel #t))])
+	  ;; We've got to add users, when they join the room!
-  (chatd-json-write conn
+	  [(or (and (irc:capability? conn 'userhost-in-names)
-   (compose-event-alist conn "server-message" #:text (last params))))
+				(eq? reply RPL_ENDOFNAMES))
+		   (eq? reply RPL_ENDOFWHO))
+	   (map (lambda (nick)
+			  (make-user conn (second params)
+							   (irc:user-get conn nick 'hostmask)))
+			(irc:channel-users conn (second params)))]
+
+	  [#t
+	   (make-message-file conn ".server" "server" (last params))]))
 
 
 (define *help-msg*
@@ -181,8 +190,8 @@
 	(name
 	 "Set the realname of your connection."
 	 (value (required NAME)))
-	(output
+	(directory
-	 "Output path for messages. Defaults to standard output."
+	 "Root directory for channels and messages. Defaults to CWD."
 	 (single-char #\o)
 	 (value (required PATH)))))
 
@@ -212,7 +221,7 @@
 		 [hostname (first (string-split server ":"))]
 		 [port (or (string->number (last (string-split server ":")))
 				   6697)]
-		 [output (alist-ref 'output args)]
+		 [directory (or (alist-ref 'directory args) "./")]
 		 [connection (if server
 						 (irc:connect server port username nickname password fullname)
 						 #f)])
@@ -220,8 +229,7 @@
 	  (unless connection
 		(help))
 
-	  (if output
+	  (hash-table-set! connection 'directory directory)
-		  (hash-table-set! connection 'output output))
 
 	  (irc:loop connection
 				on-command