From 16e1c2e03364b20f402be75788b68410efb5b95d Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Thu, 6 Jan 2022 11:21:05 -0600 Subject: [PATCH 1/1] Initial commit --- .candle | 8 +++ honey.asd | 10 ++++ src/main/package.lisp | 5 ++ src/main/parse.lisp | 126 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 149 insertions(+) create mode 100644 .candle create mode 100644 honey.asd create mode 100644 src/main/package.lisp create mode 100644 src/main/parse.lisp diff --git a/.candle b/.candle new file mode 100644 index 0000000..3e36ab2 --- /dev/null +++ b/.candle @@ -0,0 +1,8 @@ +(:packages :honey :wolf :sheep) +(:name :honey + :tasks + ((:name :wolf :directions + (wolf:pretty-print-check-directory "src")) + (:name :sheep :directions + (sheep:pretty-print-validate-packages :honey)))) +; vim:ft=lisp diff --git a/honey.asd b/honey.asd new file mode 100644 index 0000000..94eacaf --- /dev/null +++ b/honey.asd @@ -0,0 +1,10 @@ +(asdf:defsystem honey + :name "Markdown processor that exports to Weave html forms" + :version "0.0" + :maintainer "Frank Duncan (frank@consxy.com)" + :author "Frank Duncan (frank@consxy.com)" + :serial t + :pathname "src/main" + :components ((:file "package") + (:file "parse")) + :depends-on (:webthiteth :herbie-utility)) diff --git a/src/main/package.lisp b/src/main/package.lisp new file mode 100644 index 0000000..d1c5091 --- /dev/null +++ b/src/main/package.lisp @@ -0,0 +1,5 @@ +(defpackage #:honey (:use :common-lisp :webthiteth-html) (:export #:parse) + (:documentation "Main honey package. + +Honey is a simple markdown parse that translates to weave style html, +which can then be inserted into pages.")) diff --git a/src/main/parse.lisp b/src/main/parse.lisp new file mode 100644 index 0000000..b64cb22 --- /dev/null +++ b/src/main/parse.lisp @@ -0,0 +1,126 @@ +(in-package #:honey) + +(defparameter *line-parsers* nil) +(defparameter *inline-parsers* nil) + +(defun parse (str) + "PARSE STR => HTML + +ARGUMENTS AND VALUES: + + STR: a string, representing the markdown + HTML: a weave style html form + +DESCRIPTION: + + Parses the actual markdown, returing the html. This is the main + function for the honey package." + (let + ((lines (cl-ppcre:split "\\n" str))) + (mapcar + #'parse-texts + (parse-lines (append lines (list "")))))) + +(defun textp (x) (and (listp x) (eql 'text (car x)))) +(defun as-text (x) (list 'text x)) + +(defun parse-lines (lines &optional prev) + (if + (not lines) + (list prev) + (let* + ((line (car lines)) + (parser (getf (cadr (find-if #1'(funcall (getf $1 :checker) line) (reverse *line-parsers*) :key #'cadr)) :parser))) + (when (not parser) (error "Weird! Couldn't find a match for ~A" line)) + (multiple-value-bind (parsed-line squash-prev) (funcall (funcall parser line) prev) + (if squash-prev + (parse-lines (cdr lines) parsed-line) + (cons prev (parse-lines (cdr lines) parsed-line))))))) + +(defun parse-texts (line) + (cond + ((textp line) (parse-inline (cadr line))) + ((listp line) (mapcar #'parse-texts line)) + (t line))) + +(defun parse-inline (str) + (let + ((parser (getf (cadr (find-if #1'(funcall (getf $1 :checker) str) (reverse *inline-parsers*) :key #'cadr)) :parser))) + (if parser (funcall parser str) str))) + +(defmacro defline-parser (regex handler) + (let + ((regex (format nil "^~A$" regex))) + `(progn + (when (not (utils:strassoc ,regex *line-parsers*)) (push (list ,regex nil) *line-parsers*)) + (setf (utils:strassoc ,regex *line-parsers*) + (list + :checker (lambda (str) (cl-ppcre:scan ,regex str)) + :parser (lambda (str) + (apply + (function ,handler) + (mapcar + #'as-text + (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list))))))))) + +(defmacro definline-parser (regex handler) + (let + ((regex (format nil "^~A$" regex))) + `(progn + (when (not (utils:strassoc ,regex *inline-parsers*)) (push (list ,regex nil) *inline-parsers*)) + (setf (utils:strassoc ,regex *inline-parsers*) + (list + :checker (lambda (str) (cl-ppcre:scan ,regex str)) + :parser (lambda (str) + (apply (function ,handler) + (mapcar + #'parse-inline + (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list))))))))) + +; each parser function needs to return a function that takes the previous line and returns either +; +; a single element being the new element, and optionally a second values option about whether +; the previous line should be consumed + +(defun prev-h2 () + (lambda (prev) + (if (textp prev) (values (h2 prev) t) (hr)))) + +(defun prev-h1 () + (lambda (prev) + (if (textp prev) (values (h1 prev) t) (hr)))) + +(defun list-item (text) + (lambda (prev) + (let + ((li (li text))) + (if (and prev (listp prev) (eql 'ul (car prev))) + (values (append prev (list li)) t) + (ul li))))) + +(defun emptiness () + (lambda (prev) + (cond + ((textp prev) (values (p prev) t))))) + +(defun default (text) + (lambda (prev) (declare (ignore prev)) text)) + +(defline-parser "-+" prev-h2) +(defline-parser "=+" prev-h1) +(defline-parser " *\\* *(.*)" list-item) +(defline-parser " *" emptiness) +(defline-parser "(.*)" default) + +(defun strength (before during after) + (list before (span :style-font-weight "bold" during) after)) + +(defun emphasis (before during after) + (list before (span :style-font-style "italic" during) after)) + +(defun md-link (before text md-link after) + (list before (a :href md-link (parse-texts text)) after)) + +(definline-parser "(.*)\\[([^\\]]*)\\]\\(([^)]*)\\)(.*)" md-link) +(definline-parser "(.*)\\*\\*(.*)\\*\\*(.*)" strength) +(definline-parser "(.*)\\*(.*)\\*(.*)" emphasis) -- 2.25.1