What kind of `with`s have you come up with?

General
1

Hi, Racket Discourse.

Lol, I accidentally posted the deleted entry prematurely trying to start this one. Such embarrass. Much wow.

Never the mind. I read a post the other day regarding a with-gunzip helper, which I ended up modifying a bit because I am trying to read gzip data from emails, and I didn't like all of the explicit thunkery. I ended up with:

#lang racket

(require file/gunzip)

(provide with-gunzip)

; adapted from:
; https://blog.jverkamp.com/2013/08/06/adventures-in-racket-gzip/
(define-syntax with-gunzip
  (syntax-rules ()
    [(with-gunzip #:path gzip-path
       body ...)
     (with-input-from-file gzip-path
       (thunk (with-gunzip () body ...)))]

    [(with-gunzip #:pipe gzip-proc
       body ...)
     (let-values ([(pipe-read-gzip pipe-write-gzip) (make-pipe #false)]
                  [(pipe-read-data pipe-write-data) (make-pipe #false)])
       (dynamic-wind
        void
        (thunk (thread
                (thunk (gzip-proc pipe-write-gzip)
                       (gunzip-through-ports pipe-read-gzip pipe-write-data)
                       (close-output-port pipe-write-gzip)
                       (close-input-port  pipe-read-gzip)
                       (close-output-port pipe-write-data)))
               (parameterize ([current-input-port pipe-read-data])
                 body ...))
        (thunk
         (unless (port-closed? pipe-write-gzip) (close-output-port pipe-write-gzip))
         (unless (port-closed? pipe-read-gzip)  (close-input-port  pipe-read-gzip))
         (unless (port-closed? pipe-write-data) (close-output-port pipe-write-data))
         (unless (port-closed? pipe-read-data)  (close-input-port  pipe-read-data)))))]
    
    [(with-gunzip () body ...)
     (let-values ([(pipe-read-gzip pipe-write-data) (make-pipe #false)])
       (dynamic-wind
        void
        (thunk (thread
                (thunk (gunzip-through-ports {current-input-port} pipe-write-data)
                       (close-output-port pipe-write-data)))
               (parameterize ([current-input-port pipe-read-gzip])
                 body ...))
        (thunk
         (unless (port-closed? pipe-write-data) (close-output-port pipe-write-data))
         (unless (port-closed? pipe-read-gzip)  (close-input-port  pipe-read-gzip)))))]))

;;
; example of a usage shape (I actually haven't tested this, the horror)
(with-gunzip #:pipe '(output -> void)
  (define gunzipped (port->bytes))
  (with-output-to-file 'unzipped
    (thunk (write-bytes gunzipped))))

I also have a little syntax-rule I like to use for logging over "blocks" of code:

; I think I also saw this `me:*` in a @bogdan snippet, if I recall correctly
(define (me:log-message logger [topic #false])
  (if topic
      (lambda (#:data [data #false] level message . fmt-args)
        (log-message
         logger level topic (format message . apply . fmt-args) data))
    #;(not topic)
      (lambda (#:data [data #false] level topic message . fmt-args)
        (log-message
         logger level topic (format message . apply . fmt-args) data))))

(define-syntax-rule
  (with-logging ([logging (logger topic ...)] ...)
    body ...)
  #;becomes
  (let ([logging (me:log-message logger topic ...)] ...)
    body ...))

;;
; which might look something like this
(with-logging ([mailbox-clean-up-logs {database-logger 'clean-up}])
  (mailbox-clean-up-logs 'info "starting")
      
  (try-use-mailbox
   'clean-up
   (thunk (mailbox-clean-up-logs 'info "searching messages")
              
          (match/values* (find-redundant-messages events-mailbox)
            [(_)
             (mailbox-clean-up-logs
              'warning "search returned an unexpected result")]
                  
            [(total-fetched total-found positions)
             (mailbox-clean-up-logs
              'info "found ~a redundant messages in ~a total messages"
              total-found total-fetched)
                   
             (cond
               [((allow-delete?) . nand . (pair? positions))
                (mailbox-clean-up-logs 'info "skipping delete")]
               [else
                (mailbox-clean-up-logs
                 'info "deleting redundant messages from mailbox")
                (send events-mailbox delete-messages positions)])])))
        
  (mailbox-clean-up-logs 'info "finished"))

I also have one for database connections in the same app, which looks something like this:

(define-syntax (with-db-connection stx)
  (syntax-parse stx
    [(_ connection:expr #:as conn:id
        body ...)
     #'(let ([conn connection])
         (define result (call-with-values (thunk body ...) list))
         (disconnect conn)
         (apply values result))]

    ; implicit `conn` identifier in scope
    [(_ connection:expr body ...)
     #:with conn (format-id stx "~a" #'conn)
     #'(with-db-connection connection #:as conn
         body ...)]))

;;
; looking something like this
(with-db-connection (app-db:connect)
  (app-db:insert-log conn now (~a level) (~a topic) message))

So, what kinds have you come up with, besides all of the great ones already in the standard libraries?

2 Likes
2

This is tangetial, but I like to start with a call-with-* procedure before I make a with-* macro that expands to it. This makes the macro generate a lot less code, and sometimes a procedure is more convenient than a macro. For example, koyo provides both call-with-database-{connection,transaction} procedures and with-database-{connection,transaction} macros.

8 Likes
3

This is a great tip. I could even see--although I don't know if it would necessarily be as generally applicable--a form like define-sequence-syntax which takes a call-with-* procedure-variant, and the with-* syntax-variant of the with expression.

1 Like
4

this remind me a bad experience with database in Clojure accessed by macros. Starting from a working example with macros , i was not really able to adapt it to my needs because there was so much hidden undocumented expansion that i did not know what was expanding in what and the way to use it. Just to say to try avoid macro if you can do it with procedure and always try to be simple in code.But it was in Clojure...

1 Like
5

One never knows when your code might cause trauma-flashes to stream before the eyes of others :sweat_smile:.

Jokes aside, I agree with your sentiment. The happy path should allow for enough freedom of expression, or at least follow some conventions, to help guide the user to its attractor.

I tend to look at shapes more than I "read" the code. So, I often resort to "shaping" for visual accordance, as opposed to its composability, for example. Although, I find that this sometimes leads to "uncovering" the right shape precisely because it makes things awkward.

As Paul said, "Beproef alle dinge; behou die goeie." :grin:

3 Likes
6

I would say that with-disposable is one of the more interesting cases of this that I've written. It's intended to generalize over the pattern, after all.

3 Likes
7

Would you look at that... Thanks for bringing this to my attention!

8

I made a version of the Common Lisp with-slots macro for Racket structs recently that I'm proud of.

(require soup-lib/struct)
(struct demo (a b c) #:transparent #:mutable)
(define x (demo 1 2 3))
(with-slots demo (a b) x
  (set! b (+ a b))
  (print x)) ; (demo 1 3 3)

Vital to the implementation are make-variable-like-transformer and the struct-id syntax class.

1 Like
9

Very nice :heart:. The pattern before the body seemed odd at first, but it makes sense once you've read it a couple of times.

+1 for the links, thank you.

10

A small and simple macro for evaluating code within the namespace of a module:

(define-syntax (with-namespace stx)
  (syntax-case stx ()
    [(_ filepath exprs ...)
     #'(call-with-namespace filepath
                         (thunk exprs ...))]))

(define (call-with-namespace filepath proc)
  (namespace-require filepath)
  (parameterize ([current-namespace (module->namespace filepath)])
    (proc)))

We use this in our autograder library for an HTDP course when we want to evaluate code within the context of a student's submission.

We also have a with-wrapped-language macro that depends on with-namespace and exists for two main reasons:

  • Evaluating student code in restricted student languages (e.g. preventing filesystem access and arbitrary module requires)
  • Creating a new temporary file with the student's code -- this is to get around namespace-require not instantiating/loading modules twice, which doesn't work well with how we use test-engine.

Here's one snippet (below) where we use the with-wrapped-language macro, for testing a student's submission. It runs our checks (check-expects) against the student's code and gives us the number of tests that passed.

(with-wrapped-language filepath
  (initialize-test-object!)
  (when setup
    (setup))
  (for ([check checks])
    (eval check))
  (define test-obj (run-tests!))
  (debug-test-obj test-obj)
  (define passing-tests-amt (length (test-object-successful-tests test-obj)))
  passing-tests-amt)

I have plans to cover this and more in deeper detail in a blog post, once I get around to open-sourcing our autograder library. We made interesting design decisions that are distinct from Gregor Kiczales's autograder, but we did take some inspiration from it. :smile: