~williewillus/r16

dbc900f8135e933b792c7535528eee8876478bb8 — eutro 3 months ago 22c0e27
Fix read-args and improve typing indicator
2 files changed, 46 insertions(+), 18 deletions(-)

M backend.rkt
M frontends/discord.rkt
M backend.rkt => backend.rkt +1 -1
@@ 45,7 45,7 @@
            (raise (make-exn:fail:contract (~a "Trick " name " doesn't exist!")))))

      (define (read-args)
        (with-handlers ([exn:fail:read? #f])
        (with-handlers ([exn:fail:read? (const #f)])
          (sequence->list (in-producer read eof (open-input-string args)))))

      (define base

M frontends/discord.rkt => frontends/discord.rkt +45 -17
@@ 39,16 39,51 @@
    (init-field bot-prefix)
    (init-field trick-prefix)

    (define typing-thread
      (thread
       (thunk
        (let loop ([data #hash()])
          (match-let ([(list val client channel) (thread-receive)])
            (let* ([key (cons (hash-ref (rc:client-user client) 'id) channel)]
                   [newval (+ val (hash-ref data key 0))])
              (unless (zero? newval)
                (with-handlers ([exn:fail? (const #f)]) (http:trigger-typing-indicator client channel)))
              (loop (hash-set data key newval))))))))
    (define with-typing-indicator ;; (_ proc)
      (let ()
        ;; channel -> active typing counter
        (define counters-box (box (make-immutable-hash)))

        (define (counters-swap! proc)
          (define old (unbox counters-box))
          (define newv (proc old))
          (if (box-cas! counters-box old newv)
              newv
              (counters-swap! proc)))

        (define (change-counter channel delta)
          (counters-swap!
           (lambda (counters)
             (~> (hash-ref counters channel 0)
                 (+ delta)
                 (match _
                   [0 (hash-remove counters channel)]
                   [v (hash-set counters channel v)]))))
          (maybe-trigger-typing channel))

        (define (maybe-trigger-typing channel)
          (when (hash-ref (unbox counters-box) channel #f)
            (trigger-typing channel)))

        (define (trigger-typing channel)
          (with-handlers ([exn:fail? void])
            (http:trigger-typing-indicator client channel)))

        (define _typing-thread
          (thread
           (thunk
            (let loop ()
              (for ([(channel _) (unbox counters-box)])
                (trigger-typing channel))
              (sleep 5)
              (loop)))))

        (lambda (proc)
          (define channel (hash-ref (current-message) 'channel_id))
          (dynamic-wind
            (thunk (change-counter channel 1))
            proc
            (thunk (change-counter channel -1))))))

    (define deleter-thread
      (thread


@@ 259,13 294,6 @@
                           #:reply-to reference
                           #:allowed-mentions (hash 'parse '())))

    (define (with-typing-indicator thunk)
      (let ([payload (list client (hash-ref (current-message) 'channel_id))])
        (thread-send typing-thread (cons 1 payload))
        (let ([result (call-with-values thunk list)])
          (thread-send typing-thread (cons -1 payload))
          (apply values result))))

    (define parse-command
      (let ()
        (define (split-once str)