diff options
| -rw-r--r-- | wrappers/wrapper.rkt | 188 |
1 files changed, 188 insertions, 0 deletions
diff --git a/wrappers/wrapper.rkt b/wrappers/wrapper.rkt new file mode 100644 index 0000000..91714ae --- /dev/null +++ b/wrappers/wrapper.rkt @@ -0,0 +1,188 @@ +#lang racket/base + +;; Lowlevel interface + +(module low-level racket/base + + (require ffi/unsafe ffi/unsafe/define) + + (provide (all-defined-out)) + + (define-ffi-definer defcmark (ffi-lib "libcmark")) + + (define _cmark_node_type + (_enum '(none + ;; Block + document block-quote list item code-block + html paragraph header hrule + ;; Inline + text softbreak linebreak code inline-html + emph strong link image))) + (define _cmark_list_type + (_enum '(no_list bullet_list ordered_list))) + (define _cmark_delim_type + (_enum '(no_delim period_delim paren_delim))) + (define _cmark_opts + (_bitmask '(sourcepos = 1 hardbreaks = 2 normalize = 4 smart = 8))) + + (define-cpointer-type _node) + + (defcmark cmark_markdown_to_html + (_fun [bs : _bytes] [_int = (bytes-length bs)] _cmark_opts + -> [r : _bytes] -> (begin0 (bytes->string/utf-8 r) (free r)))) + + (defcmark cmark_parse_document + (_fun [bs : _bytes] [_int = (bytes-length bs)] _cmark_opts + -> _node)) + + (defcmark cmark_render_html + (_fun _node _cmark_opts + -> [r : _bytes] -> (begin0 (bytes->string/utf-8 r) (free r)))) + + (defcmark cmark_node_new (_fun _cmark_node_type -> _node)) + (defcmark cmark_node_free (_fun _node -> _void)) + + (defcmark cmark_node_next (_fun _node -> _node/null)) + (defcmark cmark_node_previous (_fun _node -> _node/null)) + (defcmark cmark_node_parent (_fun _node -> _node/null)) + (defcmark cmark_node_first_child (_fun _node -> _node/null)) + (defcmark cmark_node_last_child (_fun _node -> _node/null)) + + (defcmark cmark_node_get_user_data (_fun _node -> _racket)) + (defcmark cmark_node_set_user_data (_fun _node _racket -> _bool)) + (defcmark cmark_node_get_type (_fun _node -> _cmark_node_type)) + (defcmark cmark_node_get_type_string (_fun _node -> _bytes)) + (defcmark cmark_node_get_literal (_fun _node -> _string)) + (defcmark cmark_node_set_literal (_fun _node _string -> _bool)) + (defcmark cmark_node_get_header_level (_fun _node -> _int)) + (defcmark cmark_node_set_header_level (_fun _node _int -> _bool)) + (defcmark cmark_node_get_list_type (_fun _node -> _cmark_list_type)) + (defcmark cmark_node_set_list_type (_fun _node _cmark_list_type -> _bool)) + (defcmark cmark_node_get_list_delim (_fun _node -> _cmark_delim_type)) + (defcmark cmark_node_set_list_delim (_fun _node _cmark_delim_type -> _bool)) + (defcmark cmark_node_get_list_start (_fun _node -> _int)) + (defcmark cmark_node_set_list_start (_fun _node _int -> _bool)) + (defcmark cmark_node_get_list_tight (_fun _node -> _bool)) + (defcmark cmark_node_set_list_tight (_fun _node _bool -> _bool)) + (defcmark cmark_node_get_fence_info (_fun _node -> _string)) + (defcmark cmark_node_set_fence_info (_fun _node _string -> _bool)) + (defcmark cmark_node_get_url (_fun _node -> _string)) + (defcmark cmark_node_set_url (_fun _node _string -> _bool)) + (defcmark cmark_node_get_title (_fun _node -> _string)) + (defcmark cmark_node_set_title (_fun _node _string -> _bool)) + (defcmark cmark_node_get_start_line (_fun _node -> _int)) + (defcmark cmark_node_get_start_column (_fun _node -> _int)) + (defcmark cmark_node_get_end_line (_fun _node -> _int)) + (defcmark cmark_node_get_end_column (_fun _node -> _int)) + + (defcmark cmark_node_unlink (_fun _node -> _void)) + (defcmark cmark_node_insert_before (_fun _node _node -> _bool)) + (defcmark cmark_node_insert_after (_fun _node _node -> _bool)) + (defcmark cmark_node_prepend_child (_fun _node _node -> _bool)) + (defcmark cmark_node_append_child (_fun _node _node -> _bool)) + (defcmark cmark_consolidate_text_nodes (_fun _node -> _void)) + + ) + +;; Rackety interface + +(module high-level racket/base + + (require (submod ".." low-level) ffi/unsafe) + + (provide cmark-markdown-to-html) + (define (cmark-markdown-to-html str [options '(normalize smart)]) + (cmark_markdown_to_html (if (bytes? str) str (string->bytes/utf-8 str)) + options)) + + (require (for-syntax racket/base racket/syntax)) + (define-syntax (make-getter+setter stx) + (syntax-case stx () + [(_ name) (with-syntax ([(getter setter) + (map (λ(op) (format-id #'name "cmark_node_~a_~a" + op #'name)) + '(get set))]) + #'(cons getter setter))])) + (define-syntax-rule (define-getters+setters name [type field ...] ...) + (define name (list (list 'type (make-getter+setter field) ...) ...))) + (define-getters+setters getters+setters + [header header_level] [code-block fence_info] + [link url title] [image url title] + [list list_type list_delim list_start list_tight]) + + (provide cmark->sexpr) + (define (cmark->sexpr node) + (define text (cmark_node_get_literal node)) + (define type (cmark_node_get_type node)) + (define children + (let loop ([node (cmark_node_first_child node)]) + (if (not node) '() + (cons (cmark->sexpr node) (loop (cmark_node_next node)))))) + (define info + (cond [(assq type getters+setters) + => (λ(gss) (map (λ(gs) ((car gs) node)) (cdr gss)))] + [else '()])) + (define (assert-no what-not b) + (when b (error 'cmark->sexpr "unexpected ~a in ~s" what-not type))) + (cond [(memq type '(document paragraph header block-quote list item + emph strong link image)) + (assert-no 'text text) + (list type info children)] + [(memq type '(text code code-block html inline-html + softbreak linebreak hrule)) + (assert-no 'children (pair? children)) + (list type info text)] + [else (error 'cmark->sexpr "unknown type: ~s" type)])) + + (provide sexpr->cmark) + (define (sexpr->cmark sexpr) ; assumes valid input, as generated by the above + (define (loop sexpr) + (define type (car sexpr)) + (define info (cadr sexpr)) + (define data (caddr sexpr)) + (define node (cmark_node_new type)) + (let ([gss (assq type getters+setters)]) + (when gss + (unless (= (length (cdr gss)) (length info)) + (error 'sexpr->cmark "bad number of info values in ~s" sexpr)) + (for-each (λ(gs x) ((cdr gs) node x)) (cdr gss) info))) + (cond [(string? data) (cmark_node_set_literal node data)] + [(not data) (void)] + [(list? data) + (for ([child (in-list data)]) + (cmark_node_append_child node (sexpr->cmark child)))] + [else (error 'sexpr->cmark "bad data in ~s" sexpr)]) + node) + (define root (loop sexpr)) + (register-finalizer root cmark_node_free) + root) + + ;; Registers a `cmark_node_free` finalizer + (provide cmark-parse-document) + (define (cmark-parse-document str [options '(normalize smart)]) + (define root (cmark_parse_document + (if (bytes? str) str (string->bytes/utf-8 str)) + options)) + (register-finalizer root cmark_node_free) + root) + + (provide cmark-render-html) + (define (cmark-render-html root [options '(normalize smart)]) + (cmark_render_html root options))) + +#; ;; sample use +(begin + (require 'high-level racket/string) + (cmark-render-html + (cmark-parse-document + (string-join '("foo" + "===" + "" + "> blah" + ">" + "> blah *blah* `bar()` blah:" + ">" + "> function foo() {" + "> bar();" + "> }") + "\n")))) |