#lang scheme/base
(require scheme/contract
scheme/class
scheme/port
(only-in scheme/list rest)
(only-in scheme/list first second empty)
"collects/moby/runtime/stx.ss"
"compiler/helpers.ss"
"resource.ss")
(define-struct program/resources (program resources))
(define (program/resources->sexp a-program/resources)
(list (program->sexp (program/resources-program a-program/resources))
(map (lambda (a-resource)
(list (send a-resource get-name)
(send a-resource get-bytes)))
(program/resources-resources a-program/resources))))
(define (sexp->program/resources->sexp an-sexp)
(make-program/resources
(sexp->program (first an-sexp))
(map (lambda (resource-sexp)
(new named-bytes-resource%
[name (first resource-sexp)]
[bytes (second resource-sexp)]))
(second an-sexp))))
(define (program/resources-write-resources! a-program/resources dest-dir)
(for ([a-resource (program/resources-resources a-program/resources)])
(send a-resource save! dest-dir)))
(define (collect-directory-resources from-path base-path-name)
(let loop ([from-path from-path]
[base-path-name base-path-name])
(let inner-loop ([files (directory-list from-path)])
(cond
[(null? files)
'()]
[(file-exists? (build-path from-path (first files)))
(cons (new named-bytes-resource%
[name (path->string (if base-path-name (build-path base-path-name (first files))
(first files)))]
[bytes (call-with-input-file* (build-path from-path (first files))
(lambda (ip)
(port->bytes ip)))])
(inner-loop (rest files)))]
[(directory-exists? (build-path from-path (first files)))
(append (loop (build-path from-path (first files))
(if base-path-name (build-path base-path-name (first files))
(first files)))
(inner-loop (rest files)))]))))
(provide/contract [struct program/resources
([program program?]
[resources (listof (is-a?/c resource<%>))])]
[program/resources->sexp
(program/resources? . -> . any)]
[program/resources-write-resources!
(program/resources? path-string? . -> . any)]
[collect-directory-resources (path-string? (or/c path-string? #f) . -> . (listof (is-a?/c resource<%>)))])