#!/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 "") (check-ast doc-ast) (write-json (transform-ast doc-ast))))