diff options
| author | unwox <me@unwox.com> | 2024-09-26 17:46:38 +0600 |
|---|---|---|
| committer | unwox <me@unwox.com> | 2024-09-26 17:46:38 +0600 |
| commit | 9b82db238f9e2e02a76f95c793f8d6ef2387ecfd (patch) | |
| tree | cdb2a16d01f09553b560ab1034d53392d07bae42 /parser.fnl | |
init
Diffstat (limited to 'parser.fnl')
| -rw-r--r-- | parser.fnl | 108 |
1 files changed, 108 insertions, 0 deletions
diff --git a/parser.fnl b/parser.fnl new file mode 100644 index 0000000..314476c --- /dev/null +++ b/parser.fnl @@ -0,0 +1,108 @@ +(import-macros {: map} :lib.macro) +(local peg + (if (pick-values 1 (pcall require :lpeg)) + (require :lpeg) + (require :vendor.lpeglj))) + +(fn pnot [p] + (- (peg.P 1) (peg.P p))) + +(fn till [p] + (^ (pnot p) 1)) + +(fn maybe [p] + (^ (peg.P p) 0)) + +(fn anywhere [p] + (peg.P [(+ p (* 1 (peg.V 1)))])) + +(local pegs {}) +(tset pegs :number (^ (peg.R "09") 1)) +(tset pegs :letters (^ (+ (peg.R "az") (peg.R "AZ")) 1)) +(tset pegs :space (peg.S "\n\t ")) +(tset pegs :spaces (^ (peg.S "\n\t ") 1)) +(tset pegs :tag-name (+ pegs.letters pegs.number)) +(tset pegs :attr + (peg.Ct (* (peg.Cg (^ (+ pegs.letters "-") 1) :name) + (maybe (* "=\"" (peg.Cg (till "\"") :value) "\""))))) +(tset pegs :self-closing-tag + (* "<" + (peg.Cg + (+ (peg.P "area") "base" "br" "col" "embed" "hr" + "img" "input" "link" "meta" "param" "source" + "track" "wbr") ;; should be case insensitive + :tag) + (peg.Cg (peg.Ct (^ (+ pegs.space (peg.Cg pegs.attr)) 0)) :attrs) + (maybe "/") ">")) +(tset pegs :opening-tag + (* "<" (peg.Cg pegs.tag-name :tag) + (peg.Cg (peg.Ct (^ (+ pegs.space (peg.Cg pegs.attr)) 0)) :attrs) + ">")) +(tset pegs :closing-tag (* "</" pegs.tag-name ">")) +(tset pegs :doctype + (* "<!DOCTYPE HTML" (^ pegs.attr 0) ">")) ;; should be case insensitive +(tset pegs :tag + (peg.P [(peg.Ct (+ pegs.self-closing-tag + (* pegs.opening-tag + (peg.Cg + (peg.Ct + (^ (+ (+ pegs.space (peg.V 1)) + (peg.Cg (till pegs.closing-tag))) + 0)) + :nodes) + pegs.closing-tag)))])) +(tset pegs :html + (* pegs.doctype (peg.Ct (^ (+ pegs.space (peg.Cg pegs.tag)) 0)))) + +(fn tag [tag attrs contents] + (local tag (peg.P tag)) + (local attrs-count (accumulate [sum 0 _ _ (pairs attrs)] (+ 1 sum))) + (local attr-peg + (fn [name value] (* (^ (peg.P name) 1) + (if (~= value "") + (* "=\"" + ;; wildcard for any value + (if (= value "*") + (till "\"") + (peg.P value)) + "\"") + (maybe (.. "=\" name \"")))))) + (local attrs-peg + (accumulate [sum pegs.spaces + _ rule + (pairs (icollect [k v (pairs attrs)] + (attr-peg k v)))] + (+ rule sum))) + (if contents + (peg.P (* + (^ pegs.space 0) + ;; opening tag + (* "<" tag (^ pegs.space 0) + (^ attrs-peg (- (* attrs-count 2) 1)) + (^ pegs.space 0) ">") + ;; tag contents + (^ pegs.space 0) + (if (= contents "*") + (till (* "</" tag ">")) + contents) + (^ pegs.space 0) + ;; closing tag + (* "</" tag ">"))) + (peg.P (* + (^ pegs.space 0) + ;; opening tag + (* "<" tag (^ pegs.space 0) + (^ attrs-peg (- (* attrs-count 2) 1)) + (^ pegs.space 0) (maybe "/") ">"))))) + +(fn match-many [html tag] + (: (peg.Ct (^ (peg.Ct tag) 1)) + :match html)) + +{: match-many + : tag + : anywhere + : till + : maybe + : pegs + :not pnot} |