Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Extend check-location to also compare basenames #3

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
59 changes: 43 additions & 16 deletions Problem Sets/extras.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
rackunit/log)
(provide begin-for-test)
(provide provide rename-out struct-out check-error)
(provide check-location)
(provide check-location check-location-actual)
(provide check-within)

(define extras-version "Wed Sep 14 08:52:19 2016")
Expand Down Expand Up @@ -90,39 +90,66 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; check-location : String String -> Void
;; GIVEN: a 2 digit problem set number NN and the name of the file
;; being qualified.
;; EFFECT: throws an error if this file is not a directory of the form
;; pdp-*./setNN
(define (check-location NN correct-file-name)
(define path-elements (explode-path (current-directory)))
;; (check-location NN correct-file-name) : module-level form
(define-syntax (check-location stx)
(syntax-case stx ()
[(_ NN correct-file-name)
(case (syntax-local-context)
[(module)
#`(check-location-actual (#%expression NN)
(#%expression correct-file-name)
(quote #,(syntax-source stx)))
]
[(top-level)
(raise-syntax-error #f
"`check-location' may only be used inside a module"
stx)]
[else
(raise-syntax-error #f
"found a use of `check-location' that is not at the top level"
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Might want to say something more like "in an unexpected location"

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

While it is true, that message would not offer any guidance on how to fix the problem.

stx)])]))

;; check-location-actual : String String Path -> Void
;; GIVEN: a 2 digit problem set number NN, the expected name of the file
;; being qualified, and the actual path to the file
;; EFFECT: throws an error if this file is not in a directory of the form
;; pdp-*./setNN or does not have the correct name.
(define (check-location-actual NN correct-file-name actual-file-path)
(define path-elements (explode-path actual-file-path))
(define path-len (length path-elements))
(define correct-folder-name (string-append "set" NN))
(cond
[(>= path-len 2)
(define set-folder (path->string (last path-elements)))
(define pdp-folder (path->string (list-ref path-elements (- path-len 2))))
[(>= path-len 3)
(define actual-file-name (path->string (last path-elements)))
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Consider (list-ref path-elements (- path-len 1)) for symmetry with the others instead of (last path-elements).

(define set-folder (path->string (list-ref path-elements (- path-len 2))))
(define pdp-folder (path->string (list-ref path-elements (- path-len 3))))
(define set-regexp (regexp correct-folder-name))
(define pdp-regexp (regexp "pdp-.*"))
(match* ((regexp-match? set-regexp set-folder)
(match* ((string=? actual-file-name correct-file-name)
(regexp-match? set-regexp set-folder)
(regexp-match? pdp-regexp pdp-folder))
[(_ #f)
[(_ _ #f)
(error
(format
"File is in folder \"~a/~a\", which does not appear to be a local repo"
pdp-folder set-folder))]
[(#f _)
[(_ #f _)
(error
(format
"File should be in a folder named ~a, but is in a folder named ~a"
correct-folder-name
set-folder))]
[(#t #t)
[(#f _ _)
(error
(format
"File should be named ~a, but is named ~a"
correct-file-name
actual-file-name))]
[(#t #t #t)
(printf
"~a appears to be in a correctly named folder. Running tests...~n"
correct-file-name)]
[(_ _) (void)])]
[(_ _ _) (void)])]
[else
(error
(format
Expand Down