Browse Source

Categories and stuff

master
wjak56@gmail.com 10 years ago
parent
commit
f318d31174
  1. 32
      api.rkt
  2. 11
      categorize.rkt
  3. 4
      rm.rkt

32
api.rkt

@ -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)

11
categorize.rkt

@ -0,0 +1,11 @@
#lang racket
(define/contract (categorize path-string)
(-> absolute-path? any)
(let-values ([(upper bottom not-root?)
(split-path path-string)])
(cond
[(not upper) '()]
[else
(cons (path->string bottom)
(categorize (path->string upper)))])))

4
rm.rkt

@ -1,4 +0,0 @@
#! /usr/bin/racket
#lang racket
Loading…
Cancel
Save