Mercurial > feed

annotate src/ur/feed.ur @ 21:7275f59cab61

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
tagAOR and a Reddit example of using it
author Adam Chlipala <adam@chlipala.net>
date Sat, 29 Sep 2012 10:30:00 -0400
parents f641cfcd5153
children
rev   line source
adam@0 1 task initialize = fn () => FeedFfi.init
adam@0 2
adam@4 3 con pattern internal output = {Initial : internal,
adam@4 4 EnterTag : {Tag : string, Attrs : list (string * string), Cdata : option string} -> internal -> option internal,
adam@4 5 ExitTag : internal -> option internal,
adam@4 6 Finished : internal -> option (output * bool)}
adam@4 7
adam@4 8 val null : pattern unit (variant []) =
adam@4 9 {Initial = (),
adam@4 10 EnterTag = fn _ () => Some (),
adam@4 11 ExitTag = fn () => Some (),
adam@4 12 Finished = fn () => None}
adam@1 13
adam@6 14 con tagInternal (attrs :: {Unit}) = option {Attrs : $(mapU (option string) attrs), Cdata : option string}
adam@1 15
adam@6 16 fun tagG [attrs ::: {Unit}] [t ::: Type] (fl : folder attrs) (accept : {Attrs : $(mapU (option string) attrs), Cdata : option string} -> option t)
adam@3 17 (name : string) (attrs : $(mapU string attrs))
adam@3 18 : pattern (tagInternal attrs) t =
adam@4 19 {Initial = None,
adam@4 20 EnterTag = fn tinfo _ =>
adam@4 21 if tinfo.Tag <> name then
adam@4 22 None
adam@4 23 else
adam@6 24 let
adam@6 25 val v = {Attrs = @mp [fn _ => string] [fn _ => option string]
adam@6 26 (fn [u] aname => List.assoc aname tinfo.Attrs)
adam@6 27 fl attrs,
adam@6 28 Cdata = tinfo.Cdata}
adam@6 29 in
adam@6 30 case accept v of
adam@6 31 None => None
adam@6 32 | Some _ => Some (Some v)
adam@6 33 end,
adam@4 34 ExitTag = fn _ => None,
adam@4 35 Finished = fn state => case state of
adam@4 36 None => None
adam@4 37 | Some state =>
adam@4 38 case accept state of
adam@4 39 None => None
adam@4 40 | Some v => Some (v, False)}
adam@3 41
adam@6 42 fun allPresent [attrs ::: {Unit}] (fl : folder attrs) (attrs : $(mapU (option string) attrs)) : option $(mapU string attrs) =
adam@6 43 @foldUR [option string] [fn attrs => option $(mapU string attrs)]
adam@6 44 (fn [nm ::_] [r ::_] [[nm] ~ r] os acc =>
adam@6 45 case (os, acc) of
adam@6 46 (Some s, Some acc) => Some ({nm = s} ++ acc)
adam@6 47 | _ => None)
adam@6 48 (Some {}) fl attrs
adam@6 49
kkallio@9 50 fun allPresentE [attrs ::: {Unit}] (fl : folder attrs) (vs : $(mapU (option string) attrs)) (attrs : $(mapU (option string) attrs))
kkallio@9 51 : option $(mapU string attrs) =
kkallio@9 52 @foldUR2 [option string] [option string] [fn attrs => option $(mapU string attrs)]
kkallio@9 53 (fn [nm ::_] [r ::_] [[nm] ~ r] os os' acc =>
kkallio@9 54 case (os, os', acc) of
kkallio@9 55 (Some s, Some s', Some acc) => if s = s' then Some ({nm = s'} ++ acc) else None
kkallio@9 56 | (None, Some s', Some acc) => Some ({nm = s'} ++ acc)
kkallio@9 57 | _ => None)
kkallio@9 58 (Some {}) fl vs attrs
kkallio@9 59
adam@3 60 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
adam@3 61 : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} =
adam@6 62 @tagG fl (fn r =>
adam@6 63 case @allPresent fl r.Attrs of
adam@6 64 None => None
adam@6 65 | Some attrs => Some (r -- #Attrs ++ {Attrs = attrs}))
adam@6 66 name attrs
adam@3 67
adam@3 68 fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
adam@3 69 : pattern (tagInternal attrs) $(mapU string attrs) =
adam@6 70 @tagG fl (fn r => @allPresent fl r.Attrs) name attrs
kkallio@9 71
kkallio@9 72 fun tagAV [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU (string * option string) attrs))
kkallio@9 73 : pattern (tagInternal attrs) $(mapU string attrs) =
kkallio@9 74 let
kkallio@9 75 val as = @mp [fn _ => (string * option string)] [fn _ => string] (fn [u] (x, _) => x) fl attrs
kkallio@9 76 val vs = @mp [fn _ => (string * option string)] [fn _ => option string] (fn [u] (_, x) => x) fl attrs
kkallio@9 77 in
kkallio@9 78 @tagG fl (fn r => @allPresentE fl vs r.Attrs) name as
kkallio@9 79 end
kkallio@9 80
adam@6 81 fun tagAO [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
adam@6 82 : pattern (tagInternal attrs) $(mapU (option string) attrs) =
adam@21 83 @tagG fl (fn r => Some r.Attrs) name attrs
adam@21 84
adam@21 85 fun tagAOR [optional ::: {Unit}] [required ::: {Unit}] [optional ~ required]
adam@21 86 (ofl : folder optional) (rfl : folder required)
adam@21 87 (name : string) (required : $(mapU string required)) (optional : $(mapU string optional))
adam@21 88 : pattern (tagInternal (optional ++ required)) $(mapU string required ++ mapU (option string) optional) =
adam@21 89 @tagG (@Folder.concat ! ofl rfl)
adam@21 90 (fn r => case @allPresent rfl (r.Attrs --- mapU (option string) optional) of
adam@21 91 None => None
adam@21 92 | Some req => Some (r.Attrs --- mapU (option string) required ++ req))
adam@21 93 name (required ++ optional)
adam@3 94
adam@3 95 fun tagC (name : string) : pattern (tagInternal []) string =
adam@3 96 tagG (fn r => r.Cdata) name {}
adam@1 97
adam@4 98 datatype status a = Initial | Pending of a | Matched of a
adam@1 99
adam@1 100 con childrenInternal (parent :: Type) (children :: {Type}) = option (parent * int * $(map status children))
adam@1 101
adam@6 102 fun childrenG [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}] [t ::: Type]
adam@6 103 (ready : $(map (fn (i, d) => option d) children) -> option t)
adam@6 104 (parent : pattern parentI parent) (children : $(map (fn (i, d) => pattern i d) children)) (fl : folder children)
adam@6 105 : pattern (childrenInternal parentI (map fst children)) (parent * t) =
adam@4 106 {Initial = None,
adam@4 107 EnterTag = fn tinfo state =>
adam@4 108 case state of
adam@4 109 None =>
adam@4 110 (case parent.EnterTag tinfo parent.Initial of
adam@4 111 None => None
adam@4 112 | Some pstate => Some (Some (pstate, 1, @map0 [status] (fn [t ::_] => Initial)
adam@4 113 (@@Folder.mp [fst] [_] fl))))
adam@4 114 | Some (pstate, depth, cstates) =>
adam@6 115 if depth = 0 then
adam@6 116 case parent.EnterTag tinfo parent.Initial of
adam@6 117 None => None
adam@6 118 | Some pstate => Some (Some (pstate, 1, @map0 [status] (fn [t ::_] => Initial)
adam@6 119 (@@Folder.mp [fst] [_] fl)))
adam@6 120 else
adam@6 121 Some (Some (pstate,
adam@6 122 depth+1,
adam@6 123 @map2 [fn (i, d) => pattern i d] [fn (i, d) => status i] [fn (i, d) => status i]
adam@6 124 (fn [p] (ch : pattern p.1 p.2) (cstate : status p.1) =>
adam@6 125 case cstate of
adam@6 126 Initial =>
adam@6 127 (case ch.EnterTag tinfo ch.Initial of
adam@6 128 None => Initial
adam@6 129 | Some v =>
adam@6 130 case ch.Finished v of
adam@6 131 None => Pending v
adam@6 132 | _ => Matched v)
adam@6 133 | Pending cstate =>
adam@6 134 (case ch.EnterTag tinfo cstate of
adam@6 135 None => Initial
adam@6 136 | Some v =>
adam@6 137 case ch.Finished v of
adam@6 138 None => Pending v
adam@6 139 | _ => Matched v)
adam@6 140 | v => v)
adam@6 141 fl children cstates)),
adam@4 142 ExitTag = fn state =>
adam@4 143 case state of
adam@4 144 None => None
adam@6 145 | Some (pstate, 1, cstates) => Some (Some (pstate, 0, cstates))
adam@4 146 | Some (pstate, depth, cstates) =>
adam@4 147 Some (Some (pstate, depth-1,
adam@4 148 @map2 [fn (i, d) => pattern i d] [fn (i, d) => status i] [fn (i, d) => status i]
adam@4 149 (fn [p] (ch : pattern p.1 p.2) (cstate : status p.1) =>
adam@4 150 case cstate of
adam@4 151 Pending cstate =>
adam@4 152 (case ch.ExitTag cstate of
adam@4 153 None => Initial
adam@4 154 | Some cstate' =>
adam@4 155 case ch.Finished cstate' of
adam@4 156 None => Pending cstate'
adam@4 157 | _ => Matched cstate')
adam@4 158 | _ => cstate)
adam@4 159 fl children cstates)),
adam@4 160 Finished = fn state =>
adam@4 161 case state of
adam@6 162 Some (pstate, 0, cstates) =>
adam@4 163 (case parent.Finished pstate of
adam@4 164 None => None
adam@4 165 | Some (pdata, pcont) =>
adam@6 166 case ready (@map2 [fn (i, d) => status i] [fn (i, d) => pattern i d] [fn (i, d) => option d]
adam@6 167 (fn [p] (cstate : status p.1) (ch : pattern p.1 p.2) =>
adam@6 168 case cstate of
adam@6 169 Matched v => Option.mp (fn p => p.1) (ch.Finished v)
adam@6 170 | _ => None) fl cstates children) of
adam@4 171 None => None
adam@4 172 | Some cdata => Some ((pdata, cdata), pcont))
adam@4 173 | _ => None}
adam@1 174
adam@6 175 fun children [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
adam@6 176 (parent : pattern parentI parent) (children : $(map (fn (i, d) => pattern i d) children)) (fl : folder children)
adam@6 177 : pattern (childrenInternal parentI (map fst children)) (parent * $(map snd children)) =
adam@6 178 @childrenG (@foldR [fn (i, d) => option d] [fn cs => option $(map snd cs)]
adam@6 179 (fn [nm ::_] [p ::_] [r ::_] [[nm] ~ r] (cstate : option p.2) acc =>
adam@6 180 case (cstate, acc) of
adam@6 181 (Some cstate, Some acc) => Some ({nm = cstate} ++ acc)
adam@6 182 | _ => None)
adam@6 183 (Some {}) fl) parent children fl
adam@6 184
adam@6 185 fun childrenO [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
adam@6 186 (parent : pattern parentI parent) (children : $(map (fn (i, d) => pattern i d) children)) (fl : folder children)
adam@6 187 : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
adam@6 188 @childrenG Some parent children fl
adam@6 189
kkallio@11 190 datatype required t = Required of t | Optional of t
kkallio@11 191
kkallio@11 192 fun childrenO' [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
kkallio@11 193 (parent : pattern parentI parent) (children : $(map (fn (i, d) => required (pattern i d)) children)) (fl : folder children)
kkallio@11 194 : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
kkallio@11 195 let
kkallio@11 196 val os = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => bool]
kkallio@11 197 (fn [u] pat => case pat of
kkallio@11 198 Required _ => False
kkallio@11 199 | Optional _ => True) fl children
kkallio@11 200 val vs = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => pattern i d]
kkallio@11 201 (fn [u] pat => case pat of
kkallio@11 202 Required pat' => pat'
kkallio@11 203 | Optional pat' => pat') fl children
kkallio@11 204 in
kkallio@11 205 @childrenG (@foldR2 [fn _ => bool] [fn (i, d) => option d] [fn r => option $(map (fn (i, d) => option d) r)]
kkallio@11 206 (fn [nm ::_] [p ::_] [r ::_] [[nm] ~ r] (isO : bool) (cstate : option p.2) acc =>
kkallio@11 207 case acc of
kkallio@11 208 None => None
kkallio@11 209 | Some acc =>
kkallio@11 210 if isO then
kkallio@11 211 Some ({nm = cstate} ++ acc)
kkallio@11 212 else
kkallio@11 213 case cstate of
kkallio@11 214 None => None
kkallio@11 215 | Some _ => Some ({nm = cstate} ++ acc))
kkallio@11 216 (Some {}) fl os) parent vs fl
kkallio@11 217 end
kkallio@11 218
adam@4 219 con treeInternal (parent :: Type) (child :: Type) = option (parent * int * option child)
adam@4 220
adam@4 221 fun tree [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type]
adam@4 222 (parent : pattern parentI parent) (child : pattern childI child)
adam@4 223 : pattern (treeInternal parentI childI) (parent * child) =
adam@4 224 {Initial = None,
adam@4 225 EnterTag = fn tinfo state =>
adam@4 226 case state of
adam@4 227 None =>
adam@4 228 (case parent.EnterTag tinfo parent.Initial of
adam@4 229 None => None
adam@4 230 | Some pstate => Some (Some (pstate, 1, None)))
adam@4 231 | Some (pstate, depth, cstate) =>
adam@4 232 Some (Some (pstate,
adam@4 233 depth+1,
adam@4 234 child.EnterTag tinfo (Option.get child.Initial cstate))),
adam@4 235 ExitTag = fn state =>
adam@4 236 case state of
adam@4 237 None => None
adam@6 238 | Some (_, 1, _) => None
adam@4 239 | Some (pstate, depth, cstate) =>
adam@4 240 Some (Some (pstate, depth-1, Option.bind child.ExitTag cstate)),
adam@4 241 Finished = fn state =>
adam@4 242 case state of
adam@4 243 None => None
adam@4 244 | Some (pstate, _, cstate) =>
adam@4 245 case parent.Finished pstate of
adam@4 246 None => None
adam@4 247 | Some (pdata, _) =>
adam@4 248 case cstate of
adam@4 249 None => None
adam@4 250 | Some cstate =>
adam@4 251 case child.Finished cstate of
adam@4 252 None => None
adam@4 253 | Some (cdata, _) => Some ((pdata, cdata), True)}
adam@4 254
kkallio@14 255 con gatherInternal (parent :: Type) (child :: Type) (data :: Type) = option (parent * bool * int * option child * list data)
kkallio@14 256
kkallio@14 257 fun gather [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type]
kkallio@14 258 (parent : pattern parentI parent) (child : pattern childI child)
kkallio@14 259 : pattern (gatherInternal parentI childI child) (parent * list child) =
kkallio@14 260 {Initial = None,
kkallio@14 261 EnterTag = fn tinfo state =>
kkallio@14 262 case state of
kkallio@14 263 None =>
kkallio@14 264 (case parent.EnterTag tinfo parent.Initial of
kkallio@14 265 None => None
kkallio@14 266 | Some pstate => Some (Some (pstate, False, 1, None, Nil)))
kkallio@14 267 | Some (pstate, return, depth, cstate, clist) =>
kkallio@14 268 let
kkallio@14 269 val cstate' = child.EnterTag tinfo (Option.get child.Initial cstate)
kkallio@14 270 in
kkallio@14 271 case child.Finished (Option.get child.Initial cstate') of
kkallio@14 272 None =>
kkallio@14 273 Some (Some (pstate, return, depth+1, cstate', clist))
kkallio@14 274 | Some (cdata, _) =>
kkallio@14 275 Some (Some (pstate, return, depth+1, None, cdata :: clist))
kkallio@14 276 end,
kkallio@14 277 ExitTag = fn state =>
kkallio@14 278 case state of
kkallio@14 279 None => None
kkallio@14 280 | Some (pstate, _, 1, cstate, clist) =>
kkallio@14 281 Some (Some (pstate, True, 1, cstate, clist))
kkallio@14 282 | Some (pstate, return, depth, cstate, clist) =>
kkallio@14 283 let
kkallio@14 284 val cstate' = child.ExitTag (Option.get child.Initial cstate)
kkallio@14 285 in
kkallio@14 286 case child.Finished (Option.get child.Initial cstate') of
kkallio@14 287 None =>
kkallio@14 288 Some (Some (pstate, return, depth-1, cstate', clist))
kkallio@14 289 | Some (cdata, _) =>
kkallio@14 290 Some (Some (pstate, return, depth-1, None, cdata :: clist))
kkallio@14 291 end,
kkallio@14 292 Finished = fn state =>
kkallio@14 293 case state of
kkallio@14 294 None => None
kkallio@14 295 | Some (pstate, return, _, _, clist) =>
kkallio@14 296 case parent.Finished pstate of
kkallio@14 297 None => None
kkallio@14 298 | Some (pdata, _) =>
kkallio@14 299 if return then
kkallio@14 300 Some ((pdata, List.rev clist), False)
kkallio@14 301 else
kkallio@14 302 None}
kkallio@14 303
adam@5 304 type document = string
adam@7 305 val show_document = _
adam@5 306
adam@5 307 val fetch = FeedFfi.fetch
adam@5 308
kkallio@10 309 fun app' [internal ::: Type] [data ::: Type] [acc ::: Type] (p : pattern internal data) (f : data -> acc -> transaction acc)
kkallio@10 310 (doc : document) (acc : acc) : transaction acc =
adam@1 311 let
kkallio@10 312 fun recur xml acc state =
adam@4 313 case String.seek xml #"<" of
kkallio@10 314 None => return acc
adam@4 315 | Some xml =>
adam@1 316 if xml <> "" && String.sub xml 0 = #"/" then
adam@4 317 case String.seek xml #"\x3E" of
kkallio@10 318 None => return acc
adam@4 319 | Some xml =>
adam@1 320 case p.ExitTag state of
kkallio@10 321 None => recur xml acc p.Initial
adam@1 322 | Some state =>
adam@1 323 case p.Finished state of
kkallio@10 324 None => recur xml acc state
adam@4 325 | Some (data, cont) =>
kkallio@10 326 acc <- f data acc;
kkallio@10 327 recur xml acc (if cont then state else p.Initial)
adam@1 328 else if xml <> "" && String.sub xml 0 = #"?" then
adam@4 329 case String.seek xml #"\x3E" of
kkallio@10 330 None => return acc
kkallio@10 331 | Some xml => recur xml acc state
adam@1 332 else if xml <> "" && String.sub xml 0 = #"!" then
adam@2 333 if String.lengthGe xml 3 && String.sub xml 1 = #"-" && String.sub xml 2 = #"-" then
adam@1 334 let
adam@1 335 fun skipper xml =
adam@4 336 case String.seek xml #"-" of
adam@1 337 None => xml
adam@4 338 | Some xml =>
adam@2 339 if String.lengthGe xml 2 && String.sub xml 0 = #"-" && String.sub xml 1 = #"\x3E" then
adam@1 340 String.suffix xml 2
adam@1 341 else
adam@1 342 skipper xml
adam@1 343 in
kkallio@10 344 recur (skipper (String.suffix xml 3)) acc state
adam@1 345 end
adam@1 346 else
adam@4 347 case String.seek xml #"]" of
kkallio@10 348 None => return acc
adam@4 349 | Some xml =>
adam@4 350 case String.seek xml #"\x3E" of
kkallio@10 351 None => return acc
kkallio@10 352 | Some xml => recur xml acc state
adam@1 353 else
adam@1 354 case String.msplit {Needle = " >/", Haystack = xml} of
kkallio@10 355 None => return acc
adam@1 356 | Some (tagName, ch, xml) =>
adam@1 357 let
adam@1 358 fun readAttrs ch xml acc =
adam@1 359 case ch of
adam@1 360 #"\x3E" => (xml, acc, False)
adam@1 361 | #"/" =>
adam@4 362 (case String.seek xml #"\x3E" of
adam@1 363 None => (xml, acc, True)
adam@4 364 | Some xml => (xml, acc, True))
adam@1 365 | _ =>
adam@2 366 if String.lengthGe xml 2 && Char.isSpace (String.sub xml 0) then
adam@1 367 readAttrs (String.sub xml 0) (String.suffix xml 1) acc
adam@1 368 else if xml <> "" && String.sub xml 0 = #"\x3E" then
adam@1 369 (String.suffix xml 1, acc, False)
adam@1 370 else if xml <> "" && String.sub xml 0 = #"/" then
adam@4 371 (case String.seek xml #"\x3E" of
adam@1 372 None => (xml, acc, True)
adam@4 373 | Some xml => (xml, acc, True))
adam@1 374 else
adam@1 375 case String.split xml #"=" of
adam@1 376 None => (xml, acc, False)
adam@1 377 | Some (aname, xml) =>
adam@6 378 if xml = "" || (String.sub xml 0 <> #"\"" && String.sub xml 0 <> #"'") then
adam@1 379 (xml, (aname, "") :: acc, False)
adam@1 380 else
adam@6 381 case String.split (String.suffix xml 1) (String.sub xml 0) of
adam@1 382 None => (xml, (aname, "") :: acc, False)
adam@1 383 | Some (value, xml) =>
adam@1 384 if xml = "" then
adam@1 385 (xml, (aname, value) :: acc, False)
adam@1 386 else
adam@1 387 readAttrs (String.sub xml 0) (String.suffix xml 1) ((aname, value) :: acc)
adam@1 388
adam@1 389 val (xml, attrs, ended) = readAttrs ch xml []
adam@1 390
adam@1 391 fun skipSpaces xml =
adam@1 392 if xml <> "" && Char.isSpace (String.sub xml 0) then
adam@1 393 skipSpaces (String.suffix xml 1)
adam@1 394 else
adam@1 395 xml
adam@1 396
adam@1 397 val xml = skipSpaces xml
adam@1 398
adam@1 399 val (xml, cdata) =
adam@1 400 if ended then
adam@1 401 (xml, None)
adam@1 402 else if String.isPrefix {Prefix = "<![CDATA[", Full = xml} then
adam@1 403 let
adam@1 404 fun skipper xml acc =
adam@1 405 case String.split xml #"]" of
adam@1 406 None => (acc ^ xml, None)
adam@1 407 | Some (pre, xml) =>
adam@2 408 if String.lengthGe xml 2 && String.sub xml 0 = #"]" && String.sub xml 1 = #"\x3E" then
adam@1 409 (String.suffix xml 2, Some (acc ^ pre))
adam@1 410 else
adam@1 411 skipper xml (acc ^ "]" ^ pre)
adam@1 412 in
adam@1 413 skipper (String.suffix xml 9) ""
adam@1 414 end
adam@1 415 else
adam@4 416 case String.split' xml #"<" of
adam@1 417 None => (xml, None)
adam@4 418 | Some (cdata, xml) => (xml, Some cdata)
adam@1 419 in
adam@1 420 case p.EnterTag {Tag = tagName, Attrs = attrs, Cdata = cdata} state of
kkallio@10 421 None => recur xml acc p.Initial
adam@1 422 | Some state =>
adam@4 423 case p.Finished state of
adam@4 424 None =>
adam@4 425 (case (if ended then p.ExitTag state else Some state) of
kkallio@10 426 None => recur xml acc p.Initial
adam@4 427 | Some state =>
adam@4 428 case p.Finished state of
kkallio@10 429 None => recur xml acc state
adam@4 430 | Some (data, cont) =>
kkallio@10 431 acc <- f data acc;
kkallio@10 432 recur xml acc (if cont then state else p.Initial))
adam@4 433 | Some (data, cont) =>
kkallio@10 434 acc <- f data acc;
kkallio@13 435 state <- return (if ended then
kkallio@13 436 Option.get p.Initial (p.ExitTag state)
kkallio@13 437 else
kkallio@13 438 state);
kkallio@13 439
kkallio@10 440 recur xml acc (if cont then state else p.Initial)
adam@1 441 end
adam@1 442 in
kkallio@10 443 recur doc acc p.Initial
adam@1 444 end
kkallio@10 445
kkallio@10 446 fun app [internal ::: Type] [data ::: Type] (p : pattern internal data) (f : data -> transaction {}) (doc : document) : transaction {} =
kkallio@10 447 app' p (fn data acc => f data) doc ()