Mercurial > feed

comparison src/ur/feed.ur @ 10:edc2b467f818

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add a version of Feed.app which threads state.
author Karn Kallio <kkallio@eka>
date Thu, 09 Jun 2011 12:59:27 -0430
parents f19beef42ceb
children 43c3fbd8527a
comparison
equal deleted inserted replaced
9:f19beef42ceb 10:edc2b467f818
216 type document = string 216 type document = string
217 val show_document = _ 217 val show_document = _
218 218
219 val fetch = FeedFfi.fetch 219 val fetch = FeedFfi.fetch
220 220
221 fun app [internal ::: Type] [data ::: Type] (p : pattern internal data) (f : data -> transaction {}) (doc : document) : transaction {} = 221 fun app' [internal ::: Type] [data ::: Type] [acc ::: Type] (p : pattern internal data) (f : data -> acc -> transaction acc)
222 (doc : document) (acc : acc) : transaction acc =
222 let 223 let
223 fun recur xml state = 224 fun recur xml acc state =
224 case String.seek xml #"<" of 225 case String.seek xml #"<" of
225 None => return () 226 None => return acc
226 | Some xml => 227 | Some xml =>
227 if xml <> "" && String.sub xml 0 = #"/" then 228 if xml <> "" && String.sub xml 0 = #"/" then
228 case String.seek xml #"\x3E" of 229 case String.seek xml #"\x3E" of
229 None => return () 230 None => return acc
230 | Some xml => 231 | Some xml =>
231 case p.ExitTag state of 232 case p.ExitTag state of
232 None => recur xml p.Initial 233 None => recur xml acc p.Initial
233 | Some state => 234 | Some state =>
234 case p.Finished state of 235 case p.Finished state of
235 None => recur xml state 236 None => recur xml acc state
236 | Some (data, cont) => 237 | Some (data, cont) =>
237 f data; 238 acc <- f data acc;
238 recur xml (if cont then state else p.Initial) 239 recur xml acc (if cont then state else p.Initial)
239 else if xml <> "" && String.sub xml 0 = #"?" then 240 else if xml <> "" && String.sub xml 0 = #"?" then
240 case String.seek xml #"\x3E" of 241 case String.seek xml #"\x3E" of
241 None => return () 242 None => return acc
242 | Some xml => recur xml state 243 | Some xml => recur xml acc state
243 else if xml <> "" && String.sub xml 0 = #"!" then 244 else if xml <> "" && String.sub xml 0 = #"!" then
244 if String.lengthGe xml 3 && String.sub xml 1 = #"-" && String.sub xml 2 = #"-" then 245 if String.lengthGe xml 3 && String.sub xml 1 = #"-" && String.sub xml 2 = #"-" then
245 let 246 let
246 fun skipper xml = 247 fun skipper xml =
247 case String.seek xml #"-" of 248 case String.seek xml #"-" of
250 if String.lengthGe xml 2 && String.sub xml 0 = #"-" && String.sub xml 1 = #"\x3E" then 251 if String.lengthGe xml 2 && String.sub xml 0 = #"-" && String.sub xml 1 = #"\x3E" then
251 String.suffix xml 2 252 String.suffix xml 2
252 else 253 else
253 skipper xml 254 skipper xml
254 in 255 in
255 recur (skipper (String.suffix xml 3)) state 256 recur (skipper (String.suffix xml 3)) acc state
256 end 257 end
257 else 258 else
258 case String.seek xml #"]" of 259 case String.seek xml #"]" of
259 None => return () 260 None => return acc
260 | Some xml => 261 | Some xml =>
261 case String.seek xml #"\x3E" of 262 case String.seek xml #"\x3E" of
262 None => return () 263 None => return acc
263 | Some xml => recur xml state 264 | Some xml => recur xml acc state
264 else 265 else
265 case String.msplit {Needle = " >/", Haystack = xml} of 266 case String.msplit {Needle = " >/", Haystack = xml} of
266 None => return () 267 None => return acc
267 | Some (tagName, ch, xml) => 268 | Some (tagName, ch, xml) =>
268 let 269 let
269 fun readAttrs ch xml acc = 270 fun readAttrs ch xml acc =
270 case ch of 271 case ch of
271 #"\x3E" => (xml, acc, False) 272 #"\x3E" => (xml, acc, False)
327 case String.split' xml #"<" of 328 case String.split' xml #"<" of
328 None => (xml, None) 329 None => (xml, None)
329 | Some (cdata, xml) => (xml, Some cdata) 330 | Some (cdata, xml) => (xml, Some cdata)
330 in 331 in
331 case p.EnterTag {Tag = tagName, Attrs = attrs, Cdata = cdata} state of 332 case p.EnterTag {Tag = tagName, Attrs = attrs, Cdata = cdata} state of
332 None => recur xml p.Initial 333 None => recur xml acc p.Initial
333 | Some state => 334 | Some state =>
334 case p.Finished state of 335 case p.Finished state of
335 None => 336 None =>
336 (case (if ended then p.ExitTag state else Some state) of 337 (case (if ended then p.ExitTag state else Some state) of
337 None => recur xml p.Initial 338 None => recur xml acc p.Initial
338 | Some state => 339 | Some state =>
339 case p.Finished state of 340 case p.Finished state of
340 None => recur xml state 341 None => recur xml acc state
341 | Some (data, cont) => 342 | Some (data, cont) =>
342 f data; 343 acc <- f data acc;
343 recur xml (if cont then state else p.Initial)) 344 recur xml acc (if cont then state else p.Initial))
344 | Some (data, cont) => 345 | Some (data, cont) =>
345 f data; 346 acc <- f data acc;
346 recur xml (if cont then state else p.Initial) 347 recur xml acc (if cont then state else p.Initial)
347 end 348 end
348 in 349 in
349 recur doc p.Initial 350 recur doc acc p.Initial
350 end 351 end
352
353 fun app [internal ::: Type] [data ::: Type] (p : pattern internal data) (f : data -> transaction {}) (doc : document) : transaction {} =
354 app' p (fn data acc => f data) doc ()