(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 (* "")) (tset pegs :doctype (* "")) ;; 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 (* "")) contents) (^ pegs.space 0) ;; closing 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}