Sunday, March 7, 2010

HTML with the F# question mark operator

I needed to create some HTML from F#.  I wanted something where the F# looked something the the results, and I didn’t have any need for anything other than the basics (tags, attributes, text contents).

I had seen a few posts talking about the question mark operator and hadn’t used it yet.  It seemed like the obvious candidate – it means you can put tags into code without writing a whole lot of support for each and every tag name you’re going to need.

What I ended up with is syntax that looks like this:

let h = com.restphone.Qml.Builder()

let exampleWithATable =
  let a =
    h?table <- [
      h?tr <- [
        h?td <- "one"
        h?td <- "two"
  printExample "a table" a
// a table
// -----
// <table>
//   <tr>
//     <td>one</td>
//     <td>two</td>
//   </tr>
//   <tr />
// </table>

The elements after the question marks are just turned into strings then passed to a function that turns them into nodes in the HTML tree. Nesting nodes uses the <- operator followed by a list of items that can be:

  • Strings get turned into content
  • Two-element tuples are turned into key-value attributes
  • Nodes (using the same h?sometag syntax)

I like the way the syntax ends up looking quite a bit like the HTML it’s producing as the final output.

A couple more examples:

let exampleWithAttributes = 
  let a1 = 
    h?ol <- [
      h?li <- [
        "class", "formattedList"                   // Two-element tuples are attributes
        "something", "something & else"           
        {name = "class"; value = "listItemStyle"}  // Or you can use an actual Attribute object
        "this should have escapes: & < >"          // content will be escaped
      h?li <- "second"
  printExample "list items with content and attributes" a1
// list items with content and attributes
// -----
// <ol>
//   <li class="formattedList" something="something &amp; else" class="listItemStyle">this should have escapes: &amp; &lt; &gt;</li>
//   <li>second</li>
// </ol>

let exampleWithASpanInContent =
  let b =
    h?foo <- [
      "content text"
      h?span <- "something in a span"
      "more text"
  printExample "content containing a span" b
// content containing a span
// -----
// <foo>content text<span>something in a span</span>more text</foo>

And here’s the code:

namespace com.restphone.Qml

open System.Xml

// Name-value pairs
type Attribute =
  {name: string;
   value: string}

type Element =
  {tag: string;                   // The html tag; table, p, etc
   attributes: Attribute list;
   children: Node list}
and Node =
  | Element of Element
  | Content of string

type Builder() =
  static let emptyAttribute = {name = ""; value = ""}

  static let tupleToAttribute (t: System.Tuple<string, string>) =
    {emptyAttribute with name = t.Item1; value = t.Item2}

  static let builder(builder, tag, things: obj list) =
    let rec appendThings (element: Element) (xs: obj list) =
      match xs with
      | (:? Element as nextElement)::t -> appendThings {element with children = (List.append element.children [Element nextElement])} t
      | (:? string as content)::t -> appendThings {element with children = (List.append element.children [Content content])} t
      | (:? List<Attribute> as attrs)::t -> appendThings {element with attributes = List.append element.attributes attrs} t
      | (:? Attribute as attr)::t -> appendThings element ([attr] :> obj::t)
      | (:? System.Tuple<string, string> as p)::t -> appendThings element ((tupleToAttribute p) :> obj::t)
      | [] -> element
      | x -> element
    appendThings ((?) builder tag) things
  static let printAttribute (x: System.Xml.XmlWriter) (attr: Attribute) =
    x.WriteAttributeString(, attr.value)
  static let printAttributes x attrs =
    List.iter (printAttribute x) attrs

  static let rec printContent (x: System.Xml.XmlWriter) s =
    x.WriteString s

  static let rec printElements x e =
    let pe = function
      | Content c -> printContent x c
      | Element el -> printElement x el
    List.iter pe e
    printElement (x: System.Xml.XmlWriter) e =
      x.WriteStartElement e.tag
      printAttributes x e.attributes
      printElements x e.children
      x.WriteEndElement ()
  static member (?) (a: Builder, tag) =
    {tag = tag; attributes = []; children = []}
  static member (?<-) (a: Builder, tag, things: obj list) = builder(a, tag, things)
  static member (?<-) (a: Builder, tag, content: string) = builder(a, tag, [content])
  static member (?<-) (a: Builder, tag, attributePair: string * string) = builder(a, tag, [attributePair])
  static member (?<-) (a: Builder, tag, attr: Attribute) = builder(a, tag, [attr])
  static member (?<-) (a: Builder, tag, e: Element) = builder(a, tag, [e])
  static member write elements x =
    Seq.iter (printElement x) elements

  static member ElementSeqToString (h: Element seq) = 
    let sw = new System.IO.StringWriter()
    let xtw = new XmlTextWriter(sw)
    xtw.Formatting <- Formatting.Indented
    Builder.write h xtw |> ignore

  static member ElementToString (h: Element) = 
    Builder.ElementSeqToString [h]

No comments: