#lang scheme (require htdp/error lang/prim) (provide create-dir ; path -> Directory ; structure dir? make-dir dir-name dir-dirs dir-files ; structure (rename-out (fil? file?) (make-fil make-file) (fil-name file-name) (fil-content file-content) (fil-size file-size)) ) ;; Structures: (define-struct dir (name dirs files) #:transparent) (define-struct fil (name size content) #:transparent) (define-primitive create-dir create-dir/proc) ;; Data: ;; Directory = (make-dir Symbol (listof Dir) (listof File)) ;; File = (make-file Symbol Number (union '() X)) (define (create-dir/proc a-path) (check-arg 'create-dir (string? a-path) "string" "first" a-path) (let ([a-path! (string->path a-path)]) (if (directory-exists? a-path!) (car (explore (list a-path!))) (error 'create-dir "not a directory: ~e" a-path)))) ;; explore : (listof String[directory-names]) -> (listof Directory) (define (explore dirs) (map (lambda (d) (let-values ([(fs ds) (pushd d directory-files&directories)]) (make-dir (string->symbol (path->string (my-split-path d))) (explore (map (lambda (x) (build-path d x)) ds)) (map make-fil (map (compose string->symbol path->string) fs) (map (lambda (x) (if (file-exists? x) (file-size x) 0)) (map (lambda (x) (build-path d x)) fs)) (map (lambda (x) (if (link-exists? x) 'link null)) fs))))) dirs)) ;; String -> String (define (my-split-path d) (let-values ([(base name mbd?) (split-path d)]) (if (path? base) name d))) ;; pushd : String[directory-name] (-> X) -> X (define (pushd d f) (parameterize ([current-directory d]) (f))) ;; directory-files&directories : ;; (-> (values (listof String[file-names]) (listof String[directory-names]))) (define (directory-files&directories) (let ((contents (directory-list))) (values (filter (lambda (x) (or (file-exists? x) (link-exists? x))) contents) (filter (lambda (x) (and (directory-exists? x) (not (link-exists? x)))) contents)))) ;; get-file-content : file -> (int -> string) ;; to read a file on demand as a string ;; option to expand the library ... ;; cache it ... (define (get-file-content f) (read-string (fil-size f) (open-input-file (symbol->string (fil-name f)))))