diff --git a/modify.rkt b/modify.rkt index e8bc76a..af07d2a 100644 --- a/modify.rkt +++ b/modify.rkt @@ -1,7 +1,7 @@ #lang cli (require (only-in racket/date current-date date->string date-display-format) - (only-in racket/string string-join non-empty-string?) + (only-in racket/string string-join string-split non-empty-string?) (only-in racket/list first second third fourth fifth last take drop flatten add-between) (only-in racket/format ~a) (only-in racket/exn exn->string) @@ -27,7 +27,7 @@ ;; example ;; modify -input-file in-progress/beginning-latl.scm --resource-type unsettled -;; --headline "Beginning LATL" +;; --headline "Beginning LATL" ;; publish -i in-progress/beginning-latl.scm -r unsettled -l "Beginning LATL" (help (usage "modify is here to update existing posts with new content.")) @@ -40,7 +40,7 @@ [(equal? t "unsettled") "unsettled"] [(equal? t "root") "root"] [else (error 'failure "couldn't recognize resource. please use one of 'settled' 'unsettled' 'root'")]))) - + (flag (input #:param [input ""] i) ("-i" "--input-file" "file to publish") (input (if (file-exists? i) @@ -66,8 +66,8 @@ [update-time (date->string (current-date) (date-display-format 'iso-8601))] [rollback-thunks (list)]) (displayln "running modify") - - + + ;; getting existing file ports ;; --------------------------- ;; if any of these fail to match, exit modify @@ -75,19 +75,19 @@ ;; this throws an exception if the file does not exist, but it must be manually ;; truncated. using #:exists 'must-truncate guarantees file exists, but truncates ;; prior to data being read from file - + ;; locate existing post in source ;; (. -> . input-port? output-port?) (define (get-source-ports) - (let ([file-handle (path-add-extension - (if (equal? r-type "root") - (if x-test - (build-path "publish-test" "source" l-head) - (build-path "source" l-head)) - (if x-test - (build-path "publish-test" "source" r-type l-head) - (build-path "source" r-type l-head))) - #".scm")]) + (let* + ([file-id (last (string-split n-in "/"))] + [file-handle (if (equal? r-type "root") + (if x-test + (build-path "publish-test" "source" file-id) + (build-path "source" file-id)) + (if x-test + (build-path "publish-test" "source" r-type file-id) + (build-path "source" r-type file-id)))]) (values (open-input-file file-handle) (open-output-file file-handle #:exists 'update)))) @@ -137,8 +137,8 @@ (build-path "data" "make-atom")) #".scm")]) (open-input-file file-handle))) - - + + (define (handle-error-getting-file expn) (displayln "handle-error-getting-file") (displayln expn) @@ -175,9 +175,9 @@ (lambda (tag-row) (member match-id tag-row)) tag-table)))) - + ;; ------------------------------ - + ;; rollback execution ;; ------------------ ;; all handlers of any exception raised after writes start occurring must evaluate @@ -243,7 +243,7 @@ (write-to-file-with-retries out-port content is-print))]) (write-to-file out-port content #:print-mode? is-print))) ;; ------------ - + ;; resource-replacement ;; -------------------- ;; replace resource in source//id @@ -265,7 +265,7 @@ res-table) 3)]) (append-post-footer new-content-sans-footer (source-url r-type id) tag-list history-list))))) - + ;; replace-resource compose chain expression (define (replace-resource source-input-port source-output-port make-new-content id) @@ -300,7 +300,7 @@ (define (get-publish-time res-table id) (last (findf (lambda (row) (equal? (first row) id)) res-table))) - + ;; update-res-table compose chain expression (define (update-res-table old-table rt-output-port id) (let* ([new-table (update-res-table-with-modification old-table id)] @@ -321,7 +321,7 @@ ;; atom-table update ;; ----------------- (define (update-atom-table at-input-port at-output-port res-link) - (let ([old-table (csv->list at-input-port)]) + (let ([old-table (csv->list at-input-port)]) (lambda (accumulator) (let* ([res-row (hash-ref accumulator 'resource)] [desc (third res-row)] @@ -355,7 +355,7 @@ (define (compose-accumulator rb-thunks) (hash 'rb-thunks rb-thunks)) - + ;; run modify with exception handlers ;; ----------------------------------