User count; define/query-count
This commit is contained in:
parent
9c5d9768b4
commit
7e2284ac11
|
@ -16,6 +16,9 @@
|
||||||
(field [topic #f])
|
(field [topic #f])
|
||||||
(assert (ircd-channel-topic Ch (topic)))
|
(assert (ircd-channel-topic Ch (topic)))
|
||||||
|
|
||||||
|
(define/query-count user-count (ircd-channel-member Ch $who) 'any)
|
||||||
|
(assert (ircd-channel-user-count Ch (hash-ref (user-count) 'any 0)))
|
||||||
|
|
||||||
(on (message (ircd-action $who (irc-message _ "MODE" (list Ch "b") _)))
|
(on (message (ircd-action $who (irc-message _ "MODE" (list Ch "b") _)))
|
||||||
(send! (ircd-event who (irc-message server-prefix 368 (list (lookup-nick who) Ch)
|
(send! (ircd-event who (irc-message server-prefix 368 (list (lookup-nick who) Ch)
|
||||||
"End of Channel Ban List"))))
|
"End of Channel Ban List"))))
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
(struct-out ircd-channel)
|
(struct-out ircd-channel)
|
||||||
(struct-out ircd-channel-member)
|
(struct-out ircd-channel-member)
|
||||||
(struct-out ircd-channel-topic)
|
(struct-out ircd-channel-topic)
|
||||||
|
(struct-out ircd-channel-user-count)
|
||||||
|
|
||||||
(struct-out ircd-action)
|
(struct-out ircd-action)
|
||||||
(struct-out ircd-event)
|
(struct-out ircd-event)
|
||||||
|
@ -22,6 +23,7 @@
|
||||||
(assertion-struct ircd-channel (channel))
|
(assertion-struct ircd-channel (channel))
|
||||||
(assertion-struct ircd-channel-member (channel conn))
|
(assertion-struct ircd-channel-member (channel conn))
|
||||||
(assertion-struct ircd-channel-topic (channel topic))
|
(assertion-struct ircd-channel-topic (channel topic))
|
||||||
|
(assertion-struct ircd-channel-user-count (channel count))
|
||||||
|
|
||||||
(message-struct ircd-action (conn message))
|
(message-struct ircd-action (conn message))
|
||||||
(message-struct ircd-event (conn message))
|
(message-struct ircd-event (conn message))
|
||||||
|
|
|
@ -32,17 +32,17 @@
|
||||||
query-set
|
query-set
|
||||||
query-hash
|
query-hash
|
||||||
;; query-hash-set
|
;; query-hash-set
|
||||||
;; query-count
|
query-count
|
||||||
query-value*
|
query-value*
|
||||||
query-set*
|
query-set*
|
||||||
query-hash*
|
query-hash*
|
||||||
;; query-hash-set*
|
;; query-hash-set*
|
||||||
;; query-count*
|
query-count*
|
||||||
define/query-value
|
define/query-value
|
||||||
define/query-set
|
define/query-set
|
||||||
define/query-hash
|
define/query-hash
|
||||||
;; define/query-hash-set
|
;; define/query-hash-set
|
||||||
;; define/query-count
|
define/query-count
|
||||||
immediate-query
|
immediate-query
|
||||||
|
|
||||||
send!
|
send!
|
||||||
|
@ -69,6 +69,7 @@
|
||||||
(require "skeleton.rkt")
|
(require "skeleton.rkt")
|
||||||
(require "pattern.rkt")
|
(require "pattern.rkt")
|
||||||
|
|
||||||
|
(require racket/match)
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require syndicate/dataflow)
|
(require syndicate/dataflow)
|
||||||
(require syndicate/protocol/instance)
|
(require syndicate/protocol/instance)
|
||||||
|
@ -554,38 +555,38 @@
|
||||||
;; (F (hashset-remove (F) K V)))))
|
;; (F (hashset-remove (F) K V)))))
|
||||||
;; F))]))
|
;; F))]))
|
||||||
|
|
||||||
;; (define-syntax (query-count stx)
|
(define-syntax (query-count stx)
|
||||||
;; (syntax-parse stx
|
(syntax-parse stx
|
||||||
;; [(_ field-name args ...)
|
[(_ field-name args ...)
|
||||||
;; (quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
;; (let ()
|
(let ()
|
||||||
;; (field [field-name (hash)])
|
(field [field-name (hash)])
|
||||||
;; (query-count* field-name args ...)))]))
|
(query-count* field-name args ...)))]))
|
||||||
|
|
||||||
;; (define-syntax (query-count* stx)
|
(define-syntax (query-count* stx)
|
||||||
;; (syntax-parse stx
|
(syntax-parse stx
|
||||||
;; [(_ field-name P expr on-add:on-add on-remove:on-remove)
|
[(_ field-name P expr on-add:on-add on-remove:on-remove)
|
||||||
;; (quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
;; (let ((F field-name))
|
(let ((F field-name))
|
||||||
;; (on (asserted P) #:priority *query-priority*
|
(on (asserted P) #:priority *query-priority*
|
||||||
;; (let ((E expr))
|
(let ((E expr))
|
||||||
;; #,@(schedule-query-handler-stxs (attribute on-add.expr))
|
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||||
;; (F (hash-set (F) E (+ 1 (hash-ref (F) E 0))))))
|
(F (hash-set (F) E (+ 1 (hash-ref (F) E 0))))))
|
||||||
;; (on (retracted P) #:priority *query-priority-high*
|
(on (retracted P) #:priority *query-priority-high*
|
||||||
;; (let ((E expr))
|
(let ((E expr))
|
||||||
;; #,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||||
;; (let ((F0 (F)))
|
(let ((F0 (F)))
|
||||||
;; (F (match (hash-ref F0 E 0)
|
(F (match (hash-ref F0 E 0)
|
||||||
;; [0 F0] ;; huh
|
[0 F0] ;; huh
|
||||||
;; [1 (hash-remove F0 E)]
|
[1 (hash-remove F0 E)]
|
||||||
;; [n (hash-set F0 E (- n 1))])))))
|
[n (hash-set F0 E (- n 1))])))))
|
||||||
;; F))]))
|
F))]))
|
||||||
|
|
||||||
(define-syntax-rule (define/query-value id ae P x ...) (define id (query-value id ae P x ...)))
|
(define-syntax-rule (define/query-value id ae P x ...) (define id (query-value id ae P x ...)))
|
||||||
(define-syntax-rule (define/query-set id P x ...) (define id (query-set id P x ...)))
|
(define-syntax-rule (define/query-set id P x ...) (define id (query-set id P x ...)))
|
||||||
(define-syntax-rule (define/query-hash id P x ...) (define id (query-hash id P x ...)))
|
(define-syntax-rule (define/query-hash id P x ...) (define id (query-hash id P x ...)))
|
||||||
;; (define-syntax-rule (define/query-hash-set id P x ...) (define id (query-hash-set id P x ...)))
|
;; (define-syntax-rule (define/query-hash-set id P x ...) (define id (query-hash-set id P x ...)))
|
||||||
;; (define-syntax-rule (define/query-count id P x ...) (define id (query-count id P x ...)))
|
(define-syntax-rule (define/query-count id P x ...) (define id (query-count id P x ...)))
|
||||||
|
|
||||||
(define-syntax (immediate-query stx)
|
(define-syntax (immediate-query stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
|
Loading…
Reference in New Issue