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?
.
. The pattern before the body seemed odd at first, but it makes sense once you've read it a couple of times.
(need twenty character to get an answer validated)