#lang scheme

(require scheme/sandbox)

(provide make-trusted-evaluator
         make-trusted-module-evaluator
         make-scribble-evaluator
         make-scribble-module-evaluator)

;; Simpler than version-case
(define-syntax (define-if-unbound stx)
  (syntax-case stx ()
    [(form (header . rest) . body)
     (syntax/loc stx (form header (lambda rest . body)))]
    [(_ name expr)
     (if (identifier-binding #'name)
         (syntax/loc stx (begin))
         (syntax/loc stx (define name expr)))]))

;; Needed for legacy versions of scheme/sandbox
(define-if-unbound (call-with-trusted-sandbox-configuration thunk)
  (parameterize ([sandbox-propagate-breaks    #t]
                 [sandbox-override-collection-paths '()]
                 [sandbox-security-guard      (current-security-guard)]
                 [sandbox-make-inspector      current-inspector]
                 [sandbox-make-logger         current-logger]
                 [sandbox-eval-limits         #f])
    (thunk)))

(define make-trusted-evaluator
  (make-keyword-procedure
   (lambda (keys vals . args)
     (call-with-trusted-sandbox-configuration
      (lambda ()
        (keyword-apply make-evaluator keys vals args))))))

(define make-trusted-module-evaluator
  (make-keyword-procedure
   (lambda (keys vals . args)
     (call-with-trusted-sandbox-configuration
      (lambda ()
        (keyword-apply make-module-evaluator keys vals args))))))

(define make-scribble-evaluator
  (make-keyword-procedure
   (lambda (keys vals . args)
     (parameterize ([sandbox-output 'string]
                    [sandbox-error-output 'string])
       (keyword-apply make-trusted-evaluator keys vals args)))))

(define make-scribble-module-evaluator
  (make-keyword-procedure
   (lambda (keys vals . args)
     (parameterize ([sandbox-output 'string]
                    [sandbox-error-output 'string])
       (keyword-apply make-trusted-module-evaluator keys vals args)))))