suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

made file structures transparent for now to work with testing.ss

Browse Source 
svn: r8258
This commit is contained in:
Matthias Felleisen 2008-01-08 17:40:21 +00:00
parent 4c1856f189
commit 4e6af69364
2 changed files with 87 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/htdp/Test/dir.ss
View File

@ -1,6 +1,6 @@
;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname dir) (read-case-sensitive #t) (teachpacks ((lib "dir.ss" "teachpack" "htdp"))) (htdp-settings #8(#t constructor repeating-decimal #f #t none #f ((lib "dir.ss" "teachpack" "htdp")))))
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname dir) (read-case-sensitive #t) (teachpacks ((lib "dir.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "dir.ss" "teachpack" "htdp")))))
;; TeachPack: dir.ss
;; Language: Intermediate with Lambda
@ -16,3 +16,8 @@
(map (lambda (x) (format "in Test, not in Teachpacks: ~s" x))
(filter (lambda (x) (not (member x teachps-files))) current-files)))
(require (lib "testing.ss" "htdp"))
(check-expect (make-file 'a 1 2) (make-file 'a 1 2))
(generate-report)

163
collects/htdp/dir.ss
View File

@ -1,82 +1,81 @@
#cs(module dir mzscheme
(require (lib "error.ss" "htdp")
(lib "list.ss")
(lib "etc.ss")
(lib "prim.ss" "lang"))
(provide
create-dir ; path -> Directory
; structure
dir?
make-dir
dir-name
dir-dirs
dir-files
; structure
file?
make-file
file-name
file-content
(rename file--size file-size)
)
;; Structures:
(define-struct dir (name dirs files))
(define-struct file (name -size content))
(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-file
(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 (string? 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 (file--size f)
(open-input-file (symbol->string (file-name f)))))
)
#lang scheme
(require (lib "error.ss" "htdp")
(lib "prim.ss" "lang"))
(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 (string? 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)))))