-
Notifications
You must be signed in to change notification settings - Fork 0
/
TemplateViewEngine.fs
230 lines (211 loc) · 11.9 KB
/
TemplateViewEngine.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
module TemplateViewEngine
open System.IO
open System.Text
open System.Net
/////////// Testing
type CompiledNode<'T> =
| CText of byte []
| CAttr of ('T -> string * string)
| CBind of ('T -> string)
| CBindIf of ('T -> bool) * CompiledNode<'T> [] * CompiledNode<'T> []
| CBindFor of ('T * Stream -> unit)
type XmlAttr<'T> =
| KeyValue of string * string
| BindAttr of ('T -> string * string)
type XmlNode<'T> =
| ParentNode of string * XmlAttr<'T> list * XmlNode<'T> list
| VoidNode of string * XmlAttr<'T> list
| EncodedText of string
| RawText of string
| Bind of ('T -> string)
| BindIf of ('T -> bool) * CompiledNode<'T> [] * CompiledNode<'T> []
| BindFor of ('T * Stream -> unit)
//let inline (+>) (str:string) (ls: byte []) = Encoding.UTF8.GetBytes str
let inline toUTF8 (v:string) = Encoding.UTF8.GetBytes v
let writeFlush (sb:StringBuilder,acc:CompiledNode<'T> list) =
if sb.Length > 0
then
let nacc = (sb.ToString() |> toUTF8 |> CText) :: acc
sb.Clear() |> ignore
nacc
else acc
let compile (raw:XmlNode<'T>) : CompiledNode<'T> [] =
let rec go node (sb:StringBuilder) acc =
match node with
| ParentNode (name,attrs,children) ->
let mutable acc = acc
sb.Append("<" + name) |> ignore
for attr in attrs do
match attr with
| KeyValue (key,value) -> sb.Append(key + "=" + value) |> ignore
| BindAttr (fn) ->
acc <- CAttr fn :: writeFlush(sb,acc)
//| add bool flag
sb.Append ">" |> ignore
for child in children do
acc <- go child sb acc
sb.Append("</" + name + ">") |> ignore
acc
| VoidNode (name,attrs) ->
let mutable acc = acc
sb.Append("<" + name) |> ignore
for attr in attrs do
match attr with
| KeyValue (key,value) -> sb.Append(key + "=" + value) |> ignore
| BindAttr (fn) ->
acc <- CAttr fn :: writeFlush(sb,acc)
//| add bool flag
sb.Append(" />") |> ignore
acc
| EncodedText txt -> sb.Append (WebUtility.HtmlEncode txt) |> ignore ; acc
| RawText txt -> sb.Append txt |> ignore; acc
| Bind fn -> CBind fn :: writeFlush(sb,acc)
| BindIf (p,t,f) -> CBindIf(p,t,f) :: writeFlush(sb,acc)
| BindFor fn -> CBindFor(fn) :: writeFlush(sb,acc)
let sb = StringBuilder() // re-usable stringbuilder for building string parts
let acc = go raw sb [] // node list in reverse order so position backwards down array
let acc' = writeFlush(sb,acc)
let result = Array.zeroCreate<_>(acc'.Length)
let rec roll (ls,index) =
match ls, index with
| [] , -1 -> ()
| h :: t, i -> result.[i] <- h ; roll (t,i - 1)
| _,_ -> failwith "unexpected unroll error"
roll (acc',result.Length - 1)
result
let rec processNodes (item:'T,sw:Stream,nodes:CompiledNode<'T> [] ) =
for node in nodes do
match node with
| CText v -> sw.Write(v,0,v.Length) //.Write v
| CBind fn -> let ba = item |> fn |> toUTF8 in sw.Write (ba,0,ba.Length)
| CBindIf (pred,trueFns,falseFns) ->
if pred item then
processNodes(item,sw,trueFns)
else
processNodes(item,sw,falseFns)
| CBindFor (fn) -> fn(item,sw)
let inline bindFor<'T> (enumFn:'T -> #seq<'U>) (template:XmlNode<'U>) =
let compiledNodes = compile template
BindFor (fun (model:'T,sw:Stream) ->
for item in enumFn model do
processNodes(item,sw,compiledNodes)
)
let inline bindIf<'T> (predicate:'T -> bool,trueTemplate:XmlNode<'T>,falseTemplate:XmlNode<'T>) =
let trueNodes = compile trueTemplate
let falseNodes = compile falseTemplate
BindIf(predicate,trueNodes,falseNodes)
let inline bind<'T>(map:'T -> string) = Bind(map)
let inline html attrs children = ParentNode("html",attrs,children )
let inline ``base`` attrs = VoidNode("base",attrs )
let inline head attrs children = ParentNode("head",attrs,children )
let inline link attrs = VoidNode("link",attrs )
let inline meta attrs = VoidNode("meta",attrs )
let inline style attrs children = ParentNode("style",attrs,children )
let inline title attrs children = ParentNode("title",attrs,children )
let inline body attrs children = ParentNode("body",attrs,children )
let inline address attrs children = ParentNode("address",attrs,children )
let inline article attrs children = ParentNode("article",attrs,children )
let inline aside attrs children = ParentNode("aside",attrs,children )
let inline footer attrs children = ParentNode("footer",attrs,children )
let inline hgroup attrs children = ParentNode("hgroup",attrs,children )
let inline h1 attrs children = ParentNode("h1",attrs,children )
let inline h2 attrs children = ParentNode("h2",attrs,children )
let inline h3 attrs children = ParentNode("h3",attrs,children )
let inline h4 attrs children = ParentNode("h4",attrs,children )
let inline h5 attrs children = ParentNode("h5",attrs,children )
let inline h6 attrs children = ParentNode("h6",attrs,children )
let inline header attrs children = ParentNode("header",attrs,children )
let inline nav attrs children = ParentNode("nav",attrs,children )
let inline section attrs children = ParentNode("section",attrs,children )
let inline dd attrs children = ParentNode("dd",attrs,children )
let inline div attrs children = ParentNode("div",attrs,children )
let inline dl attrs children = ParentNode("dl",attrs,children )
let inline dt attrs children = ParentNode("dt",attrs,children )
let inline figcaption attrs children= ParentNode("figcaption",attrs,children )
let inline figure attrs children = ParentNode("figure",attrs,children )
let inline hr attrs = VoidNode("hr",attrs )
let inline li attrs children = ParentNode("li",attrs,children )
let inline main attrs children = ParentNode("main",attrs,children )
let inline ol attrs children = ParentNode("ol",attrs,children )
let inline p attrs children = ParentNode("p",attrs,children )
let inline pre attrs children = ParentNode("pre",attrs,children )
let inline ul attrs children = ParentNode("ul",attrs,children )
let inline a attrs children = ParentNode("a",attrs,children )
let inline abbr attrs children = ParentNode("abbr",attrs,children )
let inline b attrs children = ParentNode("b",attrs,children )
let inline bdi attrs children = ParentNode("bdi",attrs,children )
let inline bdo attrs children = ParentNode("bdo",attrs,children )
let inline br attrs = VoidNode("br",attrs )
let inline cite attrs children = ParentNode("cite",attrs,children )
let inline code attrs children = ParentNode("code",attrs,children )
let inline data attrs children = ParentNode("data",attrs,children )
let inline dfn attrs children = ParentNode("dfn",attrs,children )
let inline em attrs children = ParentNode("em",attrs,children )
let inline i attrs children = ParentNode("i",attrs,children )
let inline kbd attrs children = ParentNode("kbd",attrs,children )
let inline mark attrs children = ParentNode("mark",attrs,children )
let inline q attrs children = ParentNode("q",attrs,children )
let inline rp attrs children = ParentNode("rp",attrs,children )
let inline rt attrs children = ParentNode("rt",attrs,children )
let inline rtc attrs children = ParentNode("rtc",attrs,children )
let inline ruby attrs children = ParentNode("ruby",attrs,children )
let inline s attrs children = ParentNode("s",attrs,children )
let inline samp attrs children = ParentNode("samp",attrs,children )
let inline small attrs children = ParentNode("small",attrs,children )
let inline span attrs children = ParentNode("span",attrs,children )
let inline strong attrs children = ParentNode("strong",attrs,children )
let inline sub attrs children = ParentNode("sub",attrs,children )
let inline sup attrs children = ParentNode("sup",attrs,children )
let inline time attrs children = ParentNode("time",attrs,children )
let inline u attrs children = ParentNode("u",attrs,children )
let inline var attrs children = ParentNode("var",attrs,children )
let inline wbr attrs = VoidNode("wbr",attrs )
let inline area attrs = VoidNode("area",attrs )
let inline audio attrs children = ParentNode("audio",attrs,children )
let inline img attrs = VoidNode("img",attrs )
let inline map attrs children = ParentNode("map",attrs,children )
let inline track attrs = VoidNode("track",attrs )
let inline video attrs children = ParentNode("video",attrs,children )
let inline embed attrs = VoidNode("embed",attrs )
let inline object attrs children = ParentNode("object",attrs,children )
let inline param attrs = VoidNode("param",attrs )
let inline source attrs = VoidNode("source",attrs )
let inline canvas attrs children = ParentNode("canvas",attrs,children )
let inline noscript attrs children = ParentNode("noscript",attrs,children )
let inline script attrs children = ParentNode("script",attrs,children )
let inline del attrs children = ParentNode("del",attrs,children )
let inline ins attrs children = ParentNode("ins",attrs,children )
let inline caption attrs children = ParentNode("caption",attrs,children )
let inline col attrs = VoidNode("col",attrs )
let inline colgroup attrs children = ParentNode("colgroup",attrs,children )
let inline table attrs children = ParentNode("table",attrs,children )
let inline tbody attrs children = ParentNode("tbody",attrs,children )
let inline td attrs children = ParentNode("td",attrs,children )
let inline tfoot attrs children = ParentNode("tfoot",attrs,children )
let inline th attrs children = ParentNode("th",attrs,children )
let inline thead attrs children = ParentNode("thead",attrs,children )
let inline tr attrs children = ParentNode("tr",attrs,children )
let inline button attrs children = ParentNode("button",attrs,children )
let inline datalist attrs children = ParentNode("datalist",attrs,children )
let inline fieldset attrs children = ParentNode("fieldset",attrs,children )
let inline form attrs children = ParentNode("form",attrs,children )
let inline input attrs = VoidNode("input",attrs )
let inline label attrs children = ParentNode("label",attrs,children )
let inline legend attrs children = ParentNode("legend",attrs,children )
let inline meter attrs children = ParentNode("meter",attrs,children )
let inline optgroup attrs children = ParentNode("optgroup",attrs,children )
let inline option attrs children = ParentNode("option",attrs,children )
let inline output attrs children = ParentNode("output",attrs,children )
let inline progress attrs children = ParentNode("progress",attrs,children )
let inline select attrs children = ParentNode("select",attrs,children )
let inline textarea attrs children = ParentNode("textarea",attrs,children )
let inline details attrs children = ParentNode("details",attrs,children )
let inline dialog attrs children = ParentNode("dialog",attrs,children )
let inline menu attrs children = ParentNode("menu",attrs,children )
let inline menuitem attrs = VoidNode("menuitem",attrs )
let inline summary attrs children = ParentNode("summary",attrs,children )
let inline encodedText txt = EncodedText(txt)
let inline rawText txt = RawText(txt)
let inline comment txt = RawText("<!-- " + txt + " -->")
let inline renderHtmlDocument (model:'T) ( document : CompiledNode<'T> []) (writer : #Stream) =
processNodes(model,writer,document)