Back to Questions
6.3k
views4
comments
Parsing XML with System.Xml.XmlReader
f#parsinghtml

I've developed a small example script which parses a toy XML document description language into an abstract syntax tree using the XmlReader class from .net. The script also contains a printer function that produces html output from the syntax tree. I hope it is of use to other F# users.

XmlReader is an XML reader that provides fast, non-cached, forward-only access to XML data. Although it is normally a bit less convenient to use than the DOM-based XmlDocument it seems to be the proper choice for a parser which builds its own document tree. Due to the expressive power of F# the direct use of its interface is confined to a few lines.

The parser is combined from smaller parser functions that call each other recursively. The pattern matching and function currying capabilities of F# make the definition of the parser particularly easy. I hope the approach is general enough to be easily extended to cope with more complex XML markup.

HashMultiMaps or System.Collections.Generic.Dictionary might be more appropiate data structures for what I'm currently using Map for, but swapping out the data structure should be trivial.

Any comment or criticism on the code is very welcome. I'd especially appreciate any suggestion on how I could conveniently get rid of the impure use of refs in parseDocument [I'm using the ref's to circumvent F# restrictions on recursive data definitions].

Stephan

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

// We want to read XML documents similar to the following snippet...
let xmldoc = 
 "<document>
    <section id=\"Section 1\">
        
            The first <bold>paragraph</bold> in <underline>the</underline> <italic>first</italic> section
        
        
            <anchor id=\"SecondPara\"/>The second paragraph in the first section
        
        <orderedlist>
            <listitem>First list item in ordered list.</listitem>
            <listitem>Second list item in ordered list.</listitem>            
            <unorderedlist>
                <listitem><anchor id=\"NestedList\"/>First item in nested <italic>unordered</italic> list.</listitem>
                <listitem>Second item in nested <bold>unordered</bold> list.</listitem>
            </unorderedlist>            
        </orderedlist>
    </section>
    <section id=\"Section 2\">
        Introduction to second section.
        <section id=\"Section 2.1\">
            Links to second <link ref=\"SecondPara\">paragraph</link> and <link ref=\"NestedList\">nested list</link>
            <heading level=\"1\">Heading 1</heading>
            <heading level=\"2\">Heading <underline>2</underline></heading>
            <heading level=\"3\">Heading <italic>3</italic></heading>
            <heading level=\"3\">Another heading 3</heading>
        </section>    
    </section>
 </document>"
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

//==============================================================================
 
// ... into an abstract syntax tree with the following data types
type phrase =
    | Italic of phrase list
    | Bold of phrase list
    | Underline of phrase list    
    | Anchor of string    
    | Link of string * (phrase list)
    | Text of string 
 
type listitem = 
    | ListItem of phrase list    
    | NestedOrderedList of listitem list
    | NestedUnorderedList of listitem list
    
type block =
    | Section of string * block list
    | Heading of int * (phrase list)
    | OrderedList of listitem list
    | UnorderedList of listitem list    
    | Paragraph of phrase list    
 
type document = Document of block list
 
//==============================================================================
 
// the parser is based on the following functions that
// pull XML elements from the passed System.Xml.XmlReader object
 
/// report error message (and position if 2nd argument supports IXmlLineInfo)
let error msg optReader =
    match box(optReader) with
    | :? System.Xml.IXmlLineInfo as li ->         
           failwith (sprintf "%s at Line: %d, Column: %d" 
                             msg li.LineNumber li.LinePosition)
    | _ -> failwith msg
    
 
/// read attribute of XML element 
let readXmlAttrib (attribName : string) attribConv (reader :> System.Xml.XmlReader) =    
    let s  = match reader.get_Item(attribName) with // F# can't cope with reader.["attribName"]                    
             | null -> error ("could not find attribute " ^ attribName) reader
             | s -> s
    attribConv s
 
type NodeType = System.Xml.XmlNodeType
 
/// read sub elements of XML element and pull next element
let readXmlSubs (subMapR : Map<string, 'a -> 'b> ref) 
                (reader :> System.Xml.XmlReader) : 'b list =
    let subMap = !subMapR    
    let d = reader.Depth
    let mutable lst = [] // we use a mutable list to collect the result list
    try 
        let isEmpty = reader.IsEmptyElement    
        reader.ReadStartElement()        
        while reader.Depth = d + 1 do
            // the nested "sub elements" are parsed by dispatching to the functions in subMap        
            match reader.NodeType with
                | NodeType.Element -> 
                    lst <- (subMap.[reader.Name] reader) :: lst                
                | NodeType.Text
                | NodeType.Whitespace when subMap.ContainsKey("TEXT") ->       
                    lst <- (subMap.["TEXT"] reader) :: lst
                | _ -> ignore (reader.Read());
        if not isEmpty then reader.ReadEndElement() // pull next element
    with 
        | Not_found  ->
            let elem = if reader.NodeType = NodeType.Element then 
                           "XML Element " ^ reader.Name
                       else "XML Textnode"
            error ("unexpected " ^ elem) reader
        | :? System.Xml.XmlException as e ->
            error ("XMLReader error [" ^ e.Message ^ "]") ()
    List.rev lst    
    
/// read XML text node and pull next element
let readXmlText (reader :> System.Xml.XmlReader) =    
    let s = reader.Value
    let _ = reader.Read() // pull next element
    Text(s)
 
/// read XML element with one attribute (but no sub elements) and pull next element
let readXmlElemA constr attribName attribConv reader =     
    let a = readXmlAttrib attribName attribConv reader
    let isEmpty = reader.IsEmptyElement    
    reader.ReadStartElement()
    try 
        if not isEmpty then reader.ReadEndElement()
    with 
        :? System.Xml.XmlException as e -> error "unexpected xml node" reader
    constr(a)
 
/// read XML element with sub elements (but no attributes) and pull next element
let readXmlElemS constr subMapR reader =     
    constr(readXmlSubs subMapR reader)
 
/// read XML element with attribute and sub elements and pull next element
let readXmlElemAS constr attribName attribConv subMapR reader =
    let a = readXmlAttrib attribName attribConv reader    
    constr(a, readXmlSubs subMapR reader)
 
//==============================================================================
 
/// the main parser function, constructed by combining recursive element parsers    
let parseDocument =    
        
    // s2x are helper functions converting attribute strings to the respective values
    let s2s (x : string) = x
    let s2i (x : string) = Int32.of_string x
    
    // name of tag  // function for // data type   // attrib // s2x // map of 
                   // reading xml  // constructor // name   // s2x // nested elements          
    let phraseMapR = ref Map.empty
    let phraseMap =
        ["italic",        readXmlElemS  Italic                       phraseMapR;
         "bold",          readXmlElemS  Bold                         phraseMapR;
         "underline",     readXmlElemS  Underline                    phraseMapR;         
         "anchor",        readXmlElemA  Anchor        "id"    s2s              ;         
         "link",          readXmlElemAS Link          "ref"   s2s    phraseMapR;         
         "TEXT",          readXmlText                                          ;
        ] |> Map.of_list   
    // the reference assignment in the following line lets all the map refs in 
    phraseMapR:= phraseMap; // the curried functions point back to phraseMap   
                            
    let listitemMapR = ref Map.empty
    let listitemMap =
        ["listitem",      readXmlElemS  ListItem                     phraseMapR;
         "orderedlist",   readXmlElemS  NestedUnorderedList        listitemMapR;
         "unorderedlist", readXmlElemS  NestedOrderedList          listitemMapR;
        ] |> Map.of_list
    listitemMapR:= listitemMap;
    
    let blockMapR = ref Map.empty
    let blockMap =
        ["section",       readXmlElemAS Section       "id"    s2s     blockMapR;
         "heading",       readXmlElemAS Heading       "level" s2i    phraseMapR;
         "orderedlist",   readXmlElemS  OrderedList                listitemMapR;          
         "unorderedlist", readXmlElemS  UnorderedList              listitemMapR;           
         "para",          readXmlElemS  Paragraph                    phraseMapR;
        ] |> Map.of_list
    blockMapR:= blockMap;  
    
    readXmlElemS Document blockMapR // return a curried function
 
//==============================================================================
 
/// convert Document to HTML string
let toHtmlString (Document blocks) =
    // a StringBuilder is used for efficiently building a large string from many small ones
    let sb = new System.Text.StringBuilder(); 
    let print (s : string) = ignore (sb.Append(s))    
    let sectionLevel = ref 1 // the current section level
    let i2s i = Int32.to_string i
    
    let printSym tag f arg =
        print ("<" ^ tag ^ ">"); f arg; print ("</" ^ tag ^ ">")
        
    let rec printPhrases pList =
        for p in pList do            
            match p with
            | Italic(lst)    -> printSym "i" printPhrases lst
            | Bold(lst)      -> printSym "b" printPhrases lst
            | Underline(lst) -> printSym "u" printPhrases lst
            | Anchor(id)     -> print ("<a name=\"" ^ id ^ "\"></a>")
            | Link(id, lst)  -> print ("<a href=\"#" ^ id ^ "\">")
                                printPhrases lst
                                print "</a>"                                
            | Text(s)        -> print s;
                             
    let rec printListItems liList =
        for li in liList do            
            match li with
            | ListItem(lst)            -> printSym "li" printPhrases lst
            | NestedOrderedList(lst)   -> printSym "ol" printListItems lst
            | NestedUnorderedList(lst) -> printSym "ul" printListItems lst
            
    let rec printBlocks bList =
        for b in bList do
            match b with
            | Section(id, lst)   -> let slev = i2s !sectionLevel
                                    sectionLevel:= !sectionLevel + 1
                                    print ""
                                    printSym ("h" ^ slev) print id
                                    printBlocks lst
                                    print ""                                    
                                    sectionLevel:= !sectionLevel - 1                                    
            | Heading(lev, lst)  -> printSym ("h" ^ i2s lev) printPhrases lst
            | OrderedList(lst)   -> printSym "ol" printListItems lst
            | UnorderedList(lst) -> printSym "ul" printListItems lst
            | Paragraph(lst)     -> printSym "p" printPhrases lst
    
    print "<html><body>"        
    printBlocks blocks // print document into StringBuilder sb
    print "</body></html>"        
    sb.ToString()
 
//==============================================================================
        
let test xmldoc =  
    // initialize reader and scan to beginning of document
    let reader = System.Xml.XmlReader.Create(new System.IO.StringReader(xmldoc))
    if (not (reader.Read())) || reader.Name <> "document" then invalid_arg "invalid start tag"    
    let st = parseDocument reader // parse document into syntax tree    
    // print_any st // print representation of syntax tree 
    let html = toHtmlString st
    print_string (html ^ "\n") // print document as html      
 
test xmldoc
.

It's also possible to use .NET to parse an XML document into a .NET object that represents it (presuming you create a .NET class of a matching structure) using XmlSerializer ([link:msdn2.microsoft.com]). XmlSerializer is itself very C#-ish, so I'd have to think more about a natural way to do this in F#, but it is a quick and easy way to decompose XML into an AST (albeit a sort of weird one, if you're used to the OCaml/F# approach you showed).

Just a thought. :)

By on 9/28/2007 10:48 AM ()

You might like to consider using active patterns to dissect XML documents. This provides the benefits of F#'s powerful pattern matching facilities applied directly to the DOM tree, i.e. without having to copy the data.

This technique was described in one of the earlier F#.NET Journal articles.

By on 9/25/2007 8:48 PM ()

Could you maybe provide a small example demonstrating how the code would look like? Would the whole approach in your opinion be easier, terser or more efficient than the code posted above?

By on 9/26/2007 3:57 AM ()

see [link:blogs.msdn.com]

By on 9/26/2007 5:29 AM ()

    Topic tags

    IntelliFactory Offices Copyright (c) 2011-2012 IntelliFactory. All rights reserved.
    Home | Products | Consulting | Trainings | Blogs | Jobs | Contact Us | Terms of Use | Privacy Policy | Cookie Policy     		Built with WebSharper