|
| 1 | +/- |
| 2 | +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. |
| 3 | +Released under Apache 2.0 license as described in the file LICENSE. |
| 4 | +Authors: Wojciech Nawrocki |
| 5 | +-/ |
| 6 | +module |
| 7 | + |
| 8 | +prelude |
| 9 | +public import Init.Data.Array.GetLit |
| 10 | +public import Init.Data.Array.Mem |
| 11 | +public import Init.Dynamic |
| 12 | + |
| 13 | +public import Lean.Data.Json.Elab |
| 14 | + |
| 15 | +set_option doc.verso true |
| 16 | + |
| 17 | +public section |
| 18 | + |
| 19 | +namespace Lean |
| 20 | + |
| 21 | +/-! # HTML trees -/ |
| 22 | + |
| 23 | +/-- A forest of HTML trees. |
| 24 | +
|
| 25 | +Analogous to React's [Fragment](https://react.dev/reference/react/Fragment). -/ |
| 26 | +inductive Html where |
| 27 | + /-- An element with the given tag, attributes, and children. -/ |
| 28 | + | element (tag : String) (attrs : Array (String × String)) (children : Html) |
| 29 | + /-- Textual content. -/ |
| 30 | + | text : String → Html |
| 31 | + /-- Unescaped, raw HTML content. -/ |
| 32 | + | raw : String → Html |
| 33 | + /-- A sequence of HTML values. -/ |
| 34 | + | seq : Array Html → Html |
| 35 | + deriving Repr, Inhabited, BEq, Hashable, TypeName |
| 36 | + |
| 37 | +namespace Html |
| 38 | + |
| 39 | +/-- The empty HTML forest. -/ |
| 40 | +@[suggest_for Lean.Html.nil Lean.Html.none] |
| 41 | +def empty : Html := .seq #[] |
| 42 | + |
| 43 | +/-- If {name}`escape` is {lean}`true`, |
| 44 | +then characters such as {lean}`'&'` are escaped |
| 45 | +to entities such as {lean}`"&"` during rendering.-/ |
| 46 | +def ofString (escape : Bool) : String → Html := |
| 47 | + if escape then text else raw |
| 48 | + |
| 49 | +instance : Coe String Html := ⟨.text⟩ |
| 50 | + |
| 51 | +/-- Append two HTML forests. -/ |
| 52 | +def append : Html → Html → Html |
| 53 | + | .seq #[], h => h |
| 54 | + | h, .seq #[] => h |
| 55 | + | .seq xs, .seq ys => .seq (xs ++ ys) |
| 56 | + | .seq xs, other => .seq (xs.push other) |
| 57 | + | other, .seq ys => .seq (#[other] ++ ys) |
| 58 | + | x, y => .seq #[x, y] |
| 59 | + |
| 60 | +instance : Append Html := ⟨.append⟩ |
| 61 | + |
| 62 | +/-- Merges an array of HTML values by appending them. |
| 63 | +
|
| 64 | +Equivalent to {name}`Html.seq`, but may produce a more compact representation. -/ |
| 65 | +def ofArray (hs : Array Html) : Html := Id.run do |
| 66 | + let mut out := .empty |
| 67 | + for h in hs do |
| 68 | + out := out ++ h |
| 69 | + return out |
| 70 | + |
| 71 | +/-- Merges a list of HTML values by appending them. |
| 72 | +
|
| 73 | +Equivalent to {lean}`Html.seq hs.toArray`, but may produce a more compact representation. -/ |
| 74 | +def ofList (hs : List Html) : Html := Id.run do |
| 75 | + let mut out := .empty |
| 76 | + for h in hs do |
| 77 | + out := out ++ h |
| 78 | + return out |
| 79 | + |
| 80 | +instance : Coe (Array Html) Html := ⟨ofArray⟩ |
| 81 | +instance : Coe (List Html) Html := ⟨ofList⟩ |
| 82 | + |
| 83 | +/-- A compact JSON encoding of {name}`Html`. -/ |
| 84 | +instance : ToJson Html where |
| 85 | + toJson := to |
| 86 | +where |
| 87 | + to |
| 88 | + | .text t => .str t |
| 89 | + | .raw r => json%{r: $r} |
| 90 | + | .element tag attrs children => |
| 91 | + let attrs : Array Json := attrs.map fun (k, v) => .arr #[.str k, .str v] |
| 92 | + json%{t: $tag, a: $attrs, c: $(to children)} |
| 93 | + | .seq hs => .arr (hs.map to) |
| 94 | + |
| 95 | +partial instance : FromJson Html where |
| 96 | + fromJson? j := |
| 97 | + try |
| 98 | + from? j |
| 99 | + catch e => |
| 100 | + throw s!"Failed to deserialize HTML from JSON {j.compress}: {e}" |
| 101 | +where |
| 102 | + from? |
| 103 | + | .str s => return .text s |
| 104 | + | .arr j => return .seq (← j.mapM from?) |
| 105 | + | j@(.obj o) => do |
| 106 | + if let some tag := o["t"]? then |
| 107 | + let .str tag := tag | throw s!"Expected a string, got: {tag.compress}" |
| 108 | + let attrs ← j.getObjValAs? (Array Json) "a" |
| 109 | + let attrs ← attrs.mapM fun kv => do |
| 110 | + let .arr #[.str k, .str v] := kv |
| 111 | + | throw s!"Expected an array of two strings, got: {kv.compress}" |
| 112 | + return (k, v) |
| 113 | + let children ← j.getObjVal? "c" >>= from? |
| 114 | + return .element tag attrs children |
| 115 | + else if let some r := o["r"]? then |
| 116 | + let .str r := r | throw s!"Expected a string, got: {r.compress}" |
| 117 | + return .raw r |
| 118 | + else |
| 119 | + throw s!"Expected key \"t\" or key \"r\" in: {j.compress}" |
| 120 | + | j => throw s!"Expected a string, an object, or an array, got: {j.compress}" |
| 121 | + |
| 122 | +open Syntax in |
| 123 | +partial instance : Quote Html `term where |
| 124 | + quote := q |
| 125 | +where |
| 126 | + q |
| 127 | + | .element tag attrs children => |
| 128 | + let : Quote Html := ⟨q⟩ |
| 129 | + mkCApp ``Html.element #[quote tag, quote attrs, quote children] |
| 130 | + | .text t => |
| 131 | + mkCApp ``Html.text #[quote t] |
| 132 | + | .raw r => |
| 133 | + mkCApp ``Html.raw #[quote r] |
| 134 | + | .seq s => |
| 135 | + letI : Quote Html `term := ⟨q⟩ |
| 136 | + mkCApp ``Html.seq #[quote s] |
| 137 | + |
| 138 | +/-- Visit the entire tree, applying rewrites in some monad. |
| 139 | +{name}`element` and {name}`seq` are applied post-traversal, receiving already-visited children. |
| 140 | +Return {lean (type := "Option Html")}`none` to signal that no rewrite is to be performed. -/ |
| 141 | +partial def visitM [Monad m] |
| 142 | + (element : (tag : String) → (attrs : Array (String × String)) → (children : Html) → |
| 143 | + m (Option Html) := fun _ _ _ => pure none) |
| 144 | + (text : String → m (Option Html) := fun _ => pure none) |
| 145 | + (raw : String → m (Option Html) := fun _ => pure none) |
| 146 | + (seq : Array Html → m (Option Html) := fun _ => pure none) |
| 147 | + (html : Html) : m Html := |
| 148 | + match html with |
| 149 | + | .element tag attrs children => do |
| 150 | + let children' ← visitM element text raw seq children |
| 151 | + return (← element tag attrs children').getD (.element tag attrs children') |
| 152 | + | .text t => return (← text t).getD html |
| 153 | + | .raw r => return (← raw r).getD html |
| 154 | + | .seq s => do |
| 155 | + let s' ← s.mapM (visitM element text raw seq) |
| 156 | + return (← seq s').getD (.seq s') |
| 157 | + |
| 158 | +end Lean.Html |
0 commit comments