From 7bc26d08641848084c188e65df99e13c9febabbb Mon Sep 17 00:00:00 2001
From: sorrel <git@sorrel.dev>
Date: Thu, 18 Jan 2024 13:15:30 -0500
Subject: [PATCH] fix bugs in modify and publish

file-writing bugs caused problems on file-read depending on wether print or display
was used. publish was not overwriting existing feed.
---
 modify.rkt  | 18 +++++++++---------
 publish.rkt |  4 ++--
 utils.rkt   |  4 ++--
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/modify.rkt b/modify.rkt
index ac1824b..16235c9 100644
--- a/modify.rkt
+++ b/modify.rkt
@@ -80,7 +80,7 @@
    ;; (. -> . input-port? output-port?)
    (define (get-source-ports)
      (let ([file-handle  (path-add-extension
-       (if (eq? r-type "root")
+       (if (equal? r-type "root")
            (if x-test
                (build-path "publish-test" "source" l-head)
                (build-path "source" l-head))
@@ -212,8 +212,8 @@
 
    ;; write-to-file must manually truncate since out-ports do not truncate
    ;; (output-port? xexpr? xexpr? rb-thunks? . -> . rb-thunks?)
-   (define (write-to-file out-port new-content old-content accumulator)
-     (let ([rb-thunks (cons (thunk (write-to-file-with-retries out-port old-content))
+   (define (write-to-file out-port new-content old-content accumulator #:print-mode? (is-print #f))
+     (let ([rb-thunks (cons (thunk (write-to-file-with-retries out-port old-content is-print))
                             (hash-ref accumulator 'rb-thunks))])
        (if (port-try-file-lock? out-port 'exclusive)
            ;; wrap in handler that raises file-write-exception
@@ -225,7 +225,7 @@
                                              rb-thunks)))
               (thunk
                (file-truncate out-port 0)
-               (display new-content out-port)
+               ((if is-print print display) new-content out-port)
                (port-file-unlock out-port)
                (close-output-port out-port)))
              (hash-update accumulator 'rb-thunks
@@ -235,13 +235,13 @@
                    (current-continuation-marks)
                    rb-thunks)))))
 
-   (define (write-to-file-with-retries out-port content)
+   (define (write-to-file-with-retries out-port content is-print)
      (with-handlers
          ([file-write-exception? (lambda (expn)
                                    (displayln "filewrite failed with" expn)
                                    (displayln "retrying")
-                                   (write-to-file-with-retries out-port content))])
-       (write-to-file out-port content)))
+                                   (write-to-file-with-retries out-port content is-print))])
+       (write-to-file out-port content #:print-mode? is-print)))
    ;; ------------
     
    ;; resource-replacement
@@ -277,7 +277,7 @@
           (write-to-file
            source-output-port
            (make-new-content res-table)
-           old-content accumulator)
+           old-content accumulator #:print-mode? #t)
           'res-table)
          'resource
          identity
@@ -390,7 +390,7 @@
         (compose-accumulator rollback-thunks))
 
        ;; only archive after everything else is done
-       (archive-file n-in x-test)
+       (archive-file n-in x-test #:modify-mode #t)
 
        (displayln "modify was successful")))))
 
diff --git a/publish.rkt b/publish.rkt
index df4fe0d..b641a3d 100644
--- a/publish.rkt
+++ b/publish.rkt
@@ -287,7 +287,7 @@
    ;; write to file
    (if (port-try-file-lock? out 'exclusive)
        (begin
-         (write resource out)
+         (print resource out)
          (port-file-unlock out)
          (close-output-port out))
        (error "couldn't obtain file lock on ~a" out))
@@ -321,7 +321,7 @@
      (open-output-file (if x "publish-test/source/feed.atom"
                            "source/feed.atom")
                        ;; need to remove this and just replace once testing is done
-                       #:exists (if x 'replace 'error)))
+                       #:exists 'replace ))
    (if (port-try-file-lock? feed-out 'exclusive)
        (begin
          (display
diff --git a/utils.rkt b/utils.rkt
index b05b3b4..a03a077 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -24,10 +24,10 @@
       (build-path hp (~a resource-id))
       (build-path hp resource-type (~a resource-id))))
 
-(define (archive-file input-file test)
+(define (archive-file input-file test #:modify-mode (exists-ok #f))
   (if test
       (copy-file input-file (string-replace input-file "in-progress" "publish-test/archive") #t)
-      (rename-file-or-directory input-file (string-replace input-file "in-progress" "archive"))))
+      (rename-file-or-directory input-file (string-replace input-file "in-progress" "archive") exists-ok)))
 
 
 ;; atom-table utils