/utils.rkt
http://github.com/elibarzilay/rudybot · Racket · 63 lines · 50 code · 7 blank · 6 comment · 8 complexity · f1a1ce8701a530de6a8321c41f5cbb9f MD5 · raw file
- #lang racket/base
- (require scheme/match scheme/system scheme/promise
- (for-syntax scheme/base syntax/boundmap))
- (provide from-env run-command call-with-PATH defmatcher domatchers defautoloads)
- ;; this is used when this module is loaded, before `clearenv' is called
- (define (from-env var default [split #f])
- (let ([val (getenv var)])
- (if (and val (> (string-length val) 0))
- (if split (regexp-split split val) val)
- default)))
- ;; Capture the initial path for all kinds of things that need it
- (define default-path (getenv "PATH"))
- (define (call-with-PATH thunk)
- (dynamic-wind
- (lambda () (putenv "PATH" default-path))
- thunk
- (lambda () (putenv "PATH" "")))) ; no way to actually delete a var
- ;; Conveniently running an external process (given its name and string args)
- ;; and return the stdout in a string
- (define (run-command cmd . args)
- (define exe (call-with-PATH (lambda () (find-executable-path cmd))))
- (define out (open-output-string))
- (parameterize ([current-output-port out])
- (if (and exe (apply system* exe args))
- (get-output-string out)
- "unknown")))
- ;; Allows defining matchers separately, easier to maintain code.
- (define-for-syntax matcher-patterns (make-free-identifier-mapping))
- (define-syntax (defmatcher stx)
- (syntax-case stx ()
- [(_ name pattern body ...)
- (begin (free-identifier-mapping-put!
- matcher-patterns #'name
- (cons #'[pattern body ...]
- (free-identifier-mapping-get matcher-patterns #'name
- (lambda () '()))))
- #'(begin))]))
- (define-syntax (domatchers stx)
- (syntax-case stx ()
- [(_ name val)
- #`(match val #,@(reverse (free-identifier-mapping-get matcher-patterns
- #'name)))]))
- ;; used to delay loading libraries
- (define-syntax defautoloads
- (syntax-rules ()
- [(_ [lib var])
- (begin (define hidden (delay (dynamic-require 'lib 'var)))
- (define-syntax var
- (syntax-id-rules (set!)
- [(set! . _) (error 'var "cannot mutate")]
- [(x . xs) ((force hidden) . xs)]
- [_ (force hidden)])))]
- [(_ [lib var ...])
- (begin (defautoloads (lib var)) ...)]
- [(_ [lib var ...] ...)
- (begin (defautoloads (lib var ...)) ...)]))