r16: Display almost all results in sandbox context v2 SUPERSEDED

eutro: 1
 Display almost all results in sandbox context

 2 files changed, 17 insertions(+), 18 deletions(-)
#506173 linux_buildtest.yml success
Vincent Lee writes:

Ignore this message, I didn't see your V3.
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~williewillus/public-inbox/patches/22682/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH r16 v2] Display almost all results in sandbox context Export this patch

 evaluator.rkt | 18 +++++++++++-------
 main.rkt      | 17 ++++++-----------
 2 files changed, 17 insertions(+), 18 deletions(-)

diff --git a/evaluator.rkt b/evaluator.rkt
index 3b93002..c396d13 100644
--- a/evaluator.rkt
+++ b/evaluator.rkt
@@ -5,7 +5,7 @@
  [run (string? definitions? . -> . any)]))
  [run (string? definitions? predicate/c . -> . any)]))

(define definitions? (cons/c (listof (cons/c symbol? any/c))
                             (listof module-path?)))
@@ -72,16 +72,20 @@
                 [sandbox-reader (language-morph-reader definitions)])
    (make-evaluator 'racket)))

(define (run code definitions)
(define (run code definitions pass-out?)
  (parameterize ([current-environment-variables (make-environment-variables)])
    (let* ((evaluator (init-evaluator definitions))
           (results (call-with-values
    (let* ([evaluator (init-evaluator definitions)]
           [results (call-with-values
                      (with-handlers ([(const #t) identity])
                        (evaluator code)))
           (stdout (get-output evaluator))
           (stderr (get-error-output evaluator)))
                     (lambda results
                       (for/list ([result (in-list results)])
                         (if (pass-out? result)
                             (call-in-sandbox-context evaluator (thunk (~a result)))))))]
           [stdout (get-output evaluator)]
           [stderr (get-error-output evaluator)])
      (kill-evaluator evaluator)
      (apply values
diff --git a/main.rkt b/main.rkt
index 314de4e..9a7d61d 100755
--- a/main.rkt
+++ b/main.rkt
@@ -107,7 +107,7 @@
(define (run-snippet client db message code)
  (let ([code (strip-backticks code)])
    (with-typing-indicator client message
      (thunk (ev:run code (evaluation-ctx #f client message db (context-id message) "" #f))))))
      (thunk (ev:run code (evaluation-ctx #f client message db (context-id message) "" #f) http:attachment?)))))

(define (register-trick client db message text)
@@ -139,7 +139,8 @@
                      (or body "")
         (~a "Trick " name " doesn't exist!")))))

(define (update-trick client db message text)
@@ -423,14 +424,8 @@
          (format "~a... [~a more characters]" (substring str 0 slicepos) restsize))

(define (empty-string? s)
  (and (string? s) (= (string-length s) 0)))

(define (create-message-with-contents client channel message . contents)
  (let* ([content (apply ~a #:separator "\n"
                         (~>> contents
                              (map (lambda (x) (if (custom-write? x) "#<redacted>" x)))
                              (filter-not (disjoin void? http:attachment? empty-string?))))]
(define ((create-message-with-contents client channel message) . contents)
  (let* ([content (apply ~a #:separator "\n" (filter string? contents))]
         [attachment (findf http:attachment? contents)]
         [content (if (or attachment (non-empty-string? content))
                      (truncate-string content char-cap)
@@ -449,7 +444,7 @@
      (match-let ([(cons func content) (parse-command content)])
        (when func
          (call-with-values (thunk (func client db message content))
                            (curry create-message-with-contents client channel message)))))))
                            (create-message-with-contents client channel message)))))))

(define (init-client folder token)
  (log-r16-info "Storing tricks in ~a" folder)
eutro writes:
r16/patches/linux_buildtest.yml: SUCCESS in 1m38s

[Display almost all results in sandbox context][0] v2 from [eutro][1]

[0]: https://lists.sr.ht/~williewillus/public-inbox/patches/22682
[1]: mailto:benedek.szilvasy@gmail.com

✓ #506173 SUCCESS r16/patches/linux_buildtest.yml https://builds.sr.ht/~williewillus/job/506173