bike shaving :3

.envrc

@@ -0,0 +1 @@
+PATH_add scripts

scripts/.gitignore

@@ -0,0 +1 @@
+/secrets.rktd

scripts/writefreely-cli

@@ -0,0 +1,111 @@
+#!/usr/bin/env racket
+#lang racket/base
+
+(require json
+         net/url
+         net/uri-codec
+         racket/cmdline
+         racket/file
+         racket/match
+         racket/port
+         racket/runtime-path
+         racket/system)
+
+
+;; client configuration
+
+(struct app-config [instance token] #:prefab)
+
+(define (config-from-file filename)
+  (if (file-exists? filename)
+    (with-input-from-file filename read)
+    (app-config #f #f)))
+
+(define current-config (make-parameter #f))
+
+
+;; http request functions
+
+(define (make-header k v)
+  (string-append k ": " v))
+
+(define (get-authorization)
+  (string-append "Token " (app-config-token (current-config))))
+
+(define (make-api-url path #:query [query '()])
+  (url "https"
+       #f (app-config-instance (current-config))
+       #f #t
+       `(,(path/param "api" '())
+          ,@(map (λ (x) (path/param x '())) path))
+       query #f))
+
+(define (api-req method path data #:authorization [auth? #t])
+  (define-values (status headers rsp)
+    (http-sendrecv/url (make-api-url path)
+                       #:method method
+                       #:headers `(,@(if auth?
+                                       `(,(make-header "Authorization" (get-authorization)))
+                                       '())
+                                   ,(make-header "Content-Type" "application/json"))
+                       #:data (jsexpr->string data)))
+  (string->jsexpr (port->string rsp)))
+
+
+;; writefreely api functions
+
+(define (login-user username password)
+  (api-req "POST" '("auth" "login") (hash 'alias username 'pass password)))
+
+(define (update-post id title content)
+  (api-req "POST" `("posts" ,id) (hash 'body content 'title title)))
+
+
+;; script toplevel
+
+(module+ main
+  (define-runtime-path *default-config-file* "secrets.rktd")
+
+  (define (read-password)
+    (system "stty -echo")
+    (begin0
+      (read-line)
+      (system "stty echo")
+      (newline)))
+
+  (current-config (config-from-file *default-config-file*))
+
+  (unless (and (app-config-instance (current-config)) (app-config-token (current-config)))
+    (printf "instance: ")
+    (define instance (read-line))
+    (current-config (app-config instance #f))
+    (printf "username: ")
+    (define username (read-line))
+    (printf "password: ")
+    (define password (read-password))
+    (define token
+      (match (login-user username password)
+        [(hash-table ('data (hash-table ('access_token token) _ ...)) _ ...) token]
+        [resp (error "failed to log in" resp)]))
+    (current-config (app-config instance token))
+    (with-output-to-file *default-config-file* (λ () (write (current-config)))))
+
+  (command-line
+    #:program "writefreely-cli"
+    #:args (post-id post-file)
+
+    (define-values [title content]
+      (with-input-from-file post-file
+        (λ ()
+           (values
+             (match (read-line)
+               [(pregexp #px"^# (.+)$" (list _ title)) title]
+               [_ (error "post has no title")])
+             (port->string)))))
+
+    (match (update-post post-id title content)
+      [(hash-table ('code 200) _ ...)
+       (printf "https://~a/posts/~a\n" (app-config-instance (current-config)) post-id)]
+      [resp (error "failed to post" resp)]))
+
+  (void))

scripts/writefreely-validate

@@ -0,0 +1,39 @@
+#!/usr/bin/env racket
+#lang racket/base
+
+(require json
+         racket/list
+         racket/port
+         racket/pretty)
+
+(define current-header (make-parameter #f))
+
+(define (check-block blk)
+  (define c (hash-ref blk 'c))
+  (define t (hash-ref blk 't))
+
+  (when (equal? t "Header")
+    (current-header (first (second c))))
+
+  (when (equal? t "CodeBlock")
+    (define content (second c))
+    (for ([line (in-lines (open-input-string content))])
+      (when (> (string-length line) 80)
+        (eprintf "WARNING: [#~a] found code line > 80\n" (current-header))))))
+
+(define (check-any thing)
+  (when (list? thing)
+    (for-each check-any thing))
+  (when (hash? thing)
+    (when (and (hash-has-key? thing 'c) (hash-has-key? thing 't))
+      (check-block thing))
+    (for-each check-any (hash-values thing))))
+
+(define (check-ast doc-ast)
+  (check-any (hash-ref doc-ast 'blocks)))
+
+(module+ main
+  (define doc-ast (read-json))
+  (current-header "<top level>")
+  (check-ast doc-ast)
+  (write-json doc-ast))