#lang scheme

(require scheme/sandbox
         "private/unbound.ss")

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

;; 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)))))