blob: d9b34e849f1c7a26d2f29057b5b05906576e68c0 [file] [log] [blame]
#lang racket/base
;; requires racket >= 5.3 because of submodules
;; 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))
(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)])
(define root (loop sexpr))
(register-finalizer root cmark_node_free)
;; 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))
(register-finalizer root cmark_node_free)
(provide cmark-render-html)
(define (cmark-render-html root [options '(normalize smart)])
(cmark_render_html root options)))
#; ;; sample use
(require 'high-level racket/string)
(string-join '("foo"
"> blah"
"> blah *blah* `bar()` blah:"
"> function foo() {"
"> bar();"
"> }")