/utils.rkt

http://github.com/elibarzilay/rudybot · Racket · 63 lines · 50 code · 7 blank · 6 comment · 8 complexity · f1a1ce8701a530de6a8321c41f5cbb9f MD5 · raw file

  1. #lang racket/base
  2. (require scheme/match scheme/system scheme/promise
  3. (for-syntax scheme/base syntax/boundmap))
  4. (provide from-env run-command call-with-PATH defmatcher domatchers defautoloads)
  5. ;; this is used when this module is loaded, before `clearenv' is called
  6. (define (from-env var default [split #f])
  7. (let ([val (getenv var)])
  8. (if (and val (> (string-length val) 0))
  9. (if split (regexp-split split val) val)
  10. default)))
  11. ;; Capture the initial path for all kinds of things that need it
  12. (define default-path (getenv "PATH"))
  13. (define (call-with-PATH thunk)
  14. (dynamic-wind
  15. (lambda () (putenv "PATH" default-path))
  16. thunk
  17. (lambda () (putenv "PATH" "")))) ; no way to actually delete a var
  18. ;; Conveniently running an external process (given its name and string args)
  19. ;; and return the stdout in a string
  20. (define (run-command cmd . args)
  21. (define exe (call-with-PATH (lambda () (find-executable-path cmd))))
  22. (define out (open-output-string))
  23. (parameterize ([current-output-port out])
  24. (if (and exe (apply system* exe args))
  25. (get-output-string out)
  26. "unknown")))
  27. ;; Allows defining matchers separately, easier to maintain code.
  28. (define-for-syntax matcher-patterns (make-free-identifier-mapping))
  29. (define-syntax (defmatcher stx)
  30. (syntax-case stx ()
  31. [(_ name pattern body ...)
  32. (begin (free-identifier-mapping-put!
  33. matcher-patterns #'name
  34. (cons #'[pattern body ...]
  35. (free-identifier-mapping-get matcher-patterns #'name
  36. (lambda () '()))))
  37. #'(begin))]))
  38. (define-syntax (domatchers stx)
  39. (syntax-case stx ()
  40. [(_ name val)
  41. #`(match val #,@(reverse (free-identifier-mapping-get matcher-patterns
  42. #'name)))]))
  43. ;; used to delay loading libraries
  44. (define-syntax defautoloads
  45. (syntax-rules ()
  46. [(_ [lib var])
  47. (begin (define hidden (delay (dynamic-require 'lib 'var)))
  48. (define-syntax var
  49. (syntax-id-rules (set!)
  50. [(set! . _) (error 'var "cannot mutate")]
  51. [(x . xs) ((force hidden) . xs)]
  52. [_ (force hidden)])))]
  53. [(_ [lib var ...])
  54. (begin (defautoloads (lib var)) ...)]
  55. [(_ [lib var ...] ...)
  56. (begin (defautoloads (lib var ...)) ...)]))