|
@ -35,21 +35,28 @@ |
|
|
(define (new-config path) |
|
|
(define (new-config path) |
|
|
(with-handlers |
|
|
(with-handlers |
|
|
([exn:fail:filesystem:errno? (curry create-config path)]) |
|
|
([exn:fail:filesystem:errno? (curry create-config path)]) |
|
|
|
|
|
|
|
|
(let* ([config-file (open-input-file path)] |
|
|
(let* ([config-file (open-input-file path)] |
|
|
[lines (string-split |
|
|
[lines (string-split |
|
|
(port->string config-file) |
|
|
(port->string config-file) |
|
|
"\n")] |
|
|
"\n")] |
|
|
[config (make-hash)]) |
|
|
[config (make-hash)]) |
|
|
|
|
|
|
|
|
(for ([line lines] |
|
|
(for ([line lines] |
|
|
#:unless (string=? line "")) |
|
|
#:unless (string=? line "")) |
|
|
|
|
|
|
|
|
(match (map string-trim |
|
|
(match (map string-trim |
|
|
(string-split line "=")) |
|
|
(string-split line "=")) |
|
|
[(list key val) |
|
|
[(list key val) |
|
|
(cond |
|
|
(cond |
|
|
[(valid-key? key) (hash-set! config (string->symbol key) val)] |
|
|
[(valid-key? key) |
|
|
|
|
|
(hash-set! config |
|
|
|
|
|
(string->symbol key) |
|
|
|
|
|
val)] |
|
|
[else |
|
|
[else |
|
|
(error |
|
|
(error |
|
|
(format "Invalid configuration line: ~a" val))])])) |
|
|
(format "Invalid configuration line: ~a" val))])])) |
|
|
|
|
|
|
|
|
(curry hash-ref config)))) |
|
|
(curry hash-ref config)))) |
|
|
|
|
|
|
|
|
; The current list of commits (as a dynamically scoped name) |
|
|
; The current list of commits (as a dynamically scoped name) |
|
@ -63,8 +70,10 @@ |
|
|
(match |
|
|
(match |
|
|
(process command) |
|
|
(process command) |
|
|
[(list out in pid errport _) |
|
|
[(list out in pid errport _) |
|
|
|
|
|
|
|
|
(let ([result (port->string out)] |
|
|
(let ([result (port->string out)] |
|
|
[err-result (port->string out)]) |
|
|
[err-result (port->string out)]) |
|
|
|
|
|
|
|
|
(close-input-port out) |
|
|
(close-input-port out) |
|
|
(close-output-port in) |
|
|
(close-output-port in) |
|
|
(close-input-port errport) |
|
|
(close-input-port errport) |
|
@ -215,14 +224,22 @@ |
|
|
; Writes a new post and returns its post id |
|
|
; Writes a new post and returns its post id |
|
|
(define (handle-post status post post-id) |
|
|
(define (handle-post status post post-id) |
|
|
(match status |
|
|
(match status |
|
|
[(? (lambda (x) (ormap (curry equal? x) (list "A" "M")))) |
|
|
|
|
|
|
|
|
[(? (lambda (x) |
|
|
|
|
|
(ormap |
|
|
|
|
|
(curry equal? x) |
|
|
|
|
|
(list "A" "M")))) |
|
|
(call-with-values |
|
|
(call-with-values |
|
|
(lambda () |
|
|
(lambda () |
|
|
(parse-post |
|
|
(parse-post |
|
|
(port->string |
|
|
(port->string |
|
|
(open-input-file post)))) |
|
|
(open-input-file post)))) |
|
|
(curry write-post post-id))] |
|
|
(curry write-post post-id))] |
|
|
["D" (rm-post post-id)])) |
|
|
|
|
|
|
|
|
["D" (rm-post post-id)] |
|
|
|
|
|
|
|
|
|
|
|
[m (error |
|
|
|
|
|
(format "Unimplemented mode ~a" m))])) |
|
|
|
|
|
|
|
|
; Get a list of all commit refs |
|
|
; Get a list of all commit refs |
|
|
(define (get-commits) |
|
|
(define (get-commits) |
|
@ -248,6 +265,7 @@ |
|
|
post-name |
|
|
post-name |
|
|
commit-ref)) |
|
|
commit-ref)) |
|
|
[#f ""] |
|
|
[#f ""] |
|
|
|
|
|
|
|
|
[str str]))]) |
|
|
[str str]))]) |
|
|
result)) |
|
|
result)) |
|
|
|
|
|
|
|
@ -265,7 +283,9 @@ |
|
|
["" #f] |
|
|
["" #f] |
|
|
[result #t]))) |
|
|
[result #t]))) |
|
|
(current-commits)) |
|
|
(current-commits)) |
|
|
|
|
|
|
|
|
[(list-rest commit-id _) commit-id] |
|
|
[(list-rest commit-id _) commit-id] |
|
|
|
|
|
|
|
|
[_ |
|
|
[_ |
|
|
(cond |
|
|
(cond |
|
|
[(eq? def-val default) |
|
|
[(eq? def-val default) |
|
@ -274,6 +294,7 @@ |
|
|
(format |
|
|
(format |
|
|
"git-href: no value found for key\n\t~a" post-name) |
|
|
"git-href: no value found for key\n\t~a" post-name) |
|
|
(current-continuation-marks)))] |
|
|
(current-continuation-marks)))] |
|
|
|
|
|
|
|
|
[else default])])))) |
|
|
[else default])])))) |
|
|
|
|
|
|
|
|
; Add or refresh a key associated with that value |
|
|
; Add or refresh a key associated with that value |
|
@ -289,14 +310,19 @@ |
|
|
; Run when a commit of one or more posts occurs |
|
|
; Run when a commit of one or more posts occurs |
|
|
(define (commit-posts) |
|
|
(define (commit-posts) |
|
|
(for ([post-file (get-files)]) |
|
|
(for ([post-file (get-files)]) |
|
|
|
|
|
|
|
|
(let ([post-status (car post-file)] |
|
|
(let ([post-status (car post-file)] |
|
|
[post (cadr post-file)]) |
|
|
[post (cadr post-file)]) |
|
|
|
|
|
|
|
|
(match (git-href post #f) |
|
|
(match (git-href post #f) |
|
|
|
|
|
|
|
|
[#f |
|
|
[#f |
|
|
(when (empty? (current-commits)) |
|
|
(when (empty? (current-commits)) |
|
|
; Add a first commit if there are none so it can store the note properly! |
|
|
; Add a first commit if there are none so it can store the note properly! |
|
|
(system "git commit -n --allow-empty -m \"bootstrap blog\"")) |
|
|
(system "git commit -n --allow-empty -m \"bootstrap blog\"")) |
|
|
|
|
|
|
|
|
(git-set! post (handle-post post-status post #f))] |
|
|
(git-set! post (handle-post post-status post #f))] |
|
|
|
|
|
|
|
|
[commit-id |
|
|
[commit-id |
|
|
(let ([post-id (commit->post-id post commit-id)]) |
|
|
(let ([post-id (commit->post-id post commit-id)]) |
|
|
(git-set! post post-id) |
|
|
(git-set! post post-id) |
|
|