writeups/scripts/writefreely-validate

#!/usr/bin/env racket
#lang racket/base

(require json
         racket/list
         racket/match
         racket/port
         racket/pretty)

(define link-base (make-parameter #f))
(define embed-base (make-parameter #f))

(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 (hash-ref* table keys)
  (match keys
    ['() table]
    [(cons key rst) (hash-ref* (hash-ref table key #f) rst)]))

(define (check-ast doc-ast)
  (link-base (hash-ref* doc-ast '(meta wf-link-base c)))
  (embed-base (hash-ref* doc-ast '(meta wf-embed-base c)))
  (check-any (hash-ref doc-ast 'blocks)))

(define (transform-ast doc-ast)
  ;; todo
  doc-ast)

(module+ main
  (require racket/cmdline)

  (command-line
    #:program "writefreely-validate"
    #:args (doctype)
    (define doc-ast (read-json))
    (current-header "<top level>")
    (check-ast doc-ast)
    (write-json (transform-ast doc-ast))))