Skip to content

Commit 6b54eee

Browse files
committed
feat: add HTML type
1 parent 16e77c4 commit 6b54eee

3 files changed

Lines changed: 168 additions & 0 deletions

File tree

‎src/Lean/Data.lean‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module
88
prelude
99
public import Lean.Data.AssocList
1010
public import Lean.Data.Format
11+
public import Lean.Data.Html
1112
public import Lean.Data.Json
1213
public import Lean.Data.JsonRpc
1314
public import Lean.Data.KVMap

‎src/Lean/Data/Html.lean‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
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 Lean.Data.Html.Basic

‎src/Lean/Data/Html/Basic.lean‎

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
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

Comments
 (0)