wjak56@gmail.com 10 years ago
parent
commit
af88410221
  1. 93
      create_post.rkt

93
create_post.rkt

@ -33,6 +33,8 @@
(hash-set! config 'password password)] (hash-set! config 'password password)]
[(list "username" username) [(list "username" username)
(hash-set! config 'username username)] (hash-set! config 'username username)]
[(list "url" url)
(hash-set! config 'url url)]
[val (error [val (error
(format "Invalid configuration line: ~a" val))])) (format "Invalid configuration line: ~a" val))]))
(curry hash-ref config)))) (curry hash-ref config))))
@ -48,11 +50,14 @@
(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)])
(close-input-port out) (close-input-port out)
(close-output-port in) (close-output-port in)
(close-input-port errport) (close-input-port errport)
result)])) (cond
[(not (string=? "" (string-trim result))) result]
[else #f]))]))
; XML-RPC string ; XML-RPC string
(define (xstring str) (define (xstring str)
@ -146,7 +151,7 @@
(get-post-id (get-post-id
(port->string (port->string
(post-pure-port (post-pure-port
(string->url "https://primop.me/blog/xmlrpc.php") (string->url (your-config 'url))
(string->bytes/utf-8 (string->bytes/utf-8
(xexpr->string (xexpr->string
(cond (cond
@ -184,48 +189,86 @@
; Get a list of all commit refs ; Get a list of all commit refs
(define (get-commits) (define (get-commits)
(string-split (string-split
(system-result "git rev-list master") (match (system-result "git rev-list master")
[#f ""]
[str str])
"\n")) "\n"))
; Convert a commit ref into its post ID number (if it exists) ; Convert a commit ref into its post ID number (if it exists)
(define (commit->post-id post-name) (define (commit->post-id post-name commit-ref)
(compose1 (string->number
string->number (string-trim
string-trim (system-result
system-result (format "git notes --ref=~a show ~a" post-name commit-ref)))))
(curry format "git notes --ref=~a show ~a" post-name)))
(define (git-notes-ref post-name commit-ref)
(let ([result
(string-trim
(match
(system-result
(format "git notes --ref=~a show ~a"
post-name
commit-ref))
[#f ""]
[str str]))
])
(displayln (format "git notes ref result: ~a" result))
result))
; Grab a post id given a post name ; Grab a post id given a post name
; Return false if it does not exist ; Return false if it does not exist
(define (git-href post-name) (define git-href
(let ([convert-commit (commit->post-id post-name)]) (let ([def-val (gensym)])
(displayln (map convert-commit (current-commits))) (lambda (post-name [default def-val])
(match (match
(memf (memf
convert-commit (lambda (commit-ref)
(displayln (format "checking commit ~a" commit-ref))
(let ([notes (git-notes-ref post-name commit-ref)])
(match notes
["" (displayln (format "commit ~a did not have anything" commit-ref)) #f]
[result (displayln (format "found ~a in commit ~a" result commit-ref)) #t])))
(current-commits)) (current-commits))
[(list-rest post-id _) [(list-rest commit-id _) commit-id]
(convert-commit post-id)] [_
[x #f]))) (cond
[(eq? def-val default)
(raise
(exn:fail
(format
"git-href: no value found for key\n\t~a" post-name)
(current-continuation-marks)))]
[else default])]))))
; Add or refresh a post id associated with that post name ; Add or refresh a post id associated with that post name
(define (git-set! post-name post-id) (define (git-set! post-name post-id)
(displayln (format "git setting ~a ~a" post-name post-id)) ;(displayln (format "git setting ~a ~a" post-name post-id))
(system (system
(format (format
"git notes --ref=~a add HEAD -fm \"~a\"" "git notes --ref=~a add HEAD -fm \"~a\""
post-name post-name
post-id))) post-id)))
(parameterize ([current-commits (get-commits)]) (parameterize ([current-commits (get-commits)])
(displayln (format "these are the current commits: ~a" (current-commits)))
(for ([post (get-files)]) (for ([post (get-files)])
(match (git-href post) ;(call-with-values (lambda () (split-path (string->path post))) (compose1 displayln list))
(match (git-href post #f)
[#f (displayln "new post!") [#f (displayln "new post!")
(when (empty? (current-commits)) (when (empty? (current-commits))
; 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\""))
(let ([post-id (handle-post post #f)])
(git-set! post post-id))] (git-set! post (handle-post post #f))]
[post-id
(displayln (format "updating post ~a" post-id)) [commit-id
(displayln (format "updating post ~a" post))
(displayln (format "the commit ref I got is ~a" commit-id))
(let ([post-id (commit->post-id post commit-id)])
(displayln post-id)
(displayln (format "the commit ref is ~a" commit-id))
(git-set! post post-id) (git-set! post post-id)
(handle-post post post-id)]))) (handle-post post post-id))])))

Loading…
Cancel
Save