relocate path assertion definitions for more appropriate organisation

palps.rkt

@@ -9,14 +9,10 @@
 ;; directory of the current user of the program
 (define call-dir (make-parameter (string->path "/nobody")))
 
-(struct exn:assert exn ()
-  #:extra-constructor-name make-exn:assert
-  #:transparent)
-
 ;; raised by assert-confined-to-call-dir when attemping to traverse
 ;; outside of (call-dir)
-(struct exn:assert:illegal-path exn:assert ()
-  #:extra-constructor-name make-exn:assert:illegal-path
+(struct exn:fail:contract:illegal-path exn:fail:contract ()
+  #:extra-constructor-name make-exn:fail:contract:illegal-path
   #:transparent)
 
 ;; check if path, once resolved, is a child of base
@@ -28,50 +24,9 @@
 ;; asserts that path is within (call-dir), and raises
 ;; exn:fail:contract:illegal-path otherwise.
 (define (assert-confined-to-call-dir path)
-  (when (string? path)
-    (set! path (string->path path)))
-
   (when (not (confined-path? (call-dir) path))
-    (raise (make-exn:assert:illegal-path
-            (format (string-append "assert-confined-to-call-dir: traversed outside of root~n"
-                                   "  path: ~a")
-                    (path->string path))
-            (current-continuation-marks)))))
-
-(struct exn:assert:no-such-directory exn:assert ()
-  #:extra-constructor-name make-exn:assert:no-such-directory
-  #:transparent)
-
-(define (assert-directory-exists path)
-  (when (string? path)
-    (set! path (string->path path)))
-
-  ;; path-only returns #f when path is a single element. this is taken
-  ;; to mean that path is in the root (current-directory), which
-  ;; necessarily exists. this is structured to short circuit such that
-  ;; (directory-exists? #f) is never called (which would raise an
-  ;; exception).
-  (when (not (or (not (path-only path))
-                 (directory-exists? (path-only path))))
-    (raise (make-exn:assert:no-such-directory
-            (format (string-append "assert-directory-exists: directory does not exist~n"
-                                   "  path: ~a")
-                    (path->string (find-relative-path (call-dir) path)))
-            (current-continuation-marks)))))
-
-(struct exn:assert:no-such-file exn:assert ()
-  #:extra-constructor-name make-exn:assert:no-such-file
-  #:transparent)
-
-(define (assert-file-exists path)
-  (when (string? path)
-    (set! path (string->path path)))
-
-  (when (not (file-exists? path))
-    (raise (make-exn:assert:no-such-file
-            (format (string-append "assert-file-exists: file does not exist~n"
-                                   "  path: ~a")
-                    (path->string (find-relative-path (call-dir) path)))
+    (raise (make-exn:fail:contract:illegal-path
+            "assert-confined-to-call-dir: traversed outside of root"
             (current-continuation-marks)))))
 
 (define (call-valid? call)
@@ -167,9 +122,9 @@
 
 (define (session)
   (with-handlers
-    ([exn:assert?
+    ([exn:fail:contract:illegal-path?
       (λ (exn)
-        (displayln (exn-message exn)))])
+        (displayln "cannot traverse higher than root"))])
 
     (display "palps > ")
     (flush-output)
@@ -183,7 +138,6 @@
 
       [(list _ "ed" name)
        (assert-confined-to-call-dir name)
-       (assert-directory-exists name)
 
        (let ([path (if (file-exists? name)
                        (ed (our-make-temporary-file name))
@@ -192,7 +146,6 @@
 
       [(list _ "rm" name)
        (assert-confined-to-call-dir name)
-       (assert-file-exists name)
 
        (if (file-exists? name)
            (delete-file name)