13 people like it.

DSL for constructing HTML

Just another DSL for creating HTML in F#. This DSL attempts to have nice syntax using curly brackets (F# computation expression blocks) for nesting. It does not use other keywords like `yield` (to keep the syntax as non-intrusive as possible), but that means the implementation relies on mutation. I think there could be nicer implementation using automatic quoting in F# 3.0.

Implementation

  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: 
// We need to disable some warnings, because the programming style is a bit tricky
#nowarn "686"   // specifying type parameters explicitly for createElement
#nowarn "20"    // ignoring returned value
#r "System.Xml.Linq.dll"

open System.Xml.Linq
open System.Collections.Generic

let xn s = XName.Get(s)

// Various types of HTML elements are represented as classes 

// This is used only for specifying content templates for
// placeholders when creating parameterized views
// See also: 'h.content' in the last example
type ContentTemplate() =
  member x.Zero() = ()
  member x.Delay(f : unit -> unit) = f

// This represents any HTML element that we're creating
// HTML elements that do not allow content (e.g. <br />, <link ... />)
// should inherit from this type
type Element() =
  let mutable name : string = ""
  let mutable pg : Page = Unchecked.defaultof<_>
  let mutable el : XElement = null

  member x.Page = pg
  member x.Init(n, p, e) =
    name <- n; pg <- p; el <- e 
  member x.AddAttr n v =
    el.Add(XAttribute(xn n, v))

// Represents HTML element with default attributes (id, style, class)
and ElementDef() = 
  inherit Element()
  member x.set(?id:string, ?style:string, ?cssclass:string) = 
    id |> Option.iter (x.AddAttr "id")
    style |> Option.iter (x.AddAttr "style")
    cssclass |> Option.iter (x.AddAttr "class")

// Represents HTML element <link> with some other required attributes
and ElementLink() = 
  inherit Element()
  member x.set(rel:string, href:string, typ:string, ?id:string, ?style:string, ?cssclass:string) = 
    x.AddAttr "rel" rel
    x.AddAttr "href" href
    x.AddAttr "type" typ
    id |> Option.iter (x.AddAttr "id")
    style |> Option.iter (x.AddAttr "style")
    cssclass |> Option.iter (x.AddAttr "class")

// TODO: We need to add other types of HTML elements...

// This represents HTML element that can contain some other elements (e.g. <div>)
// It is written as a computation builder, so we can place the content in curly braces
// All HTML elements that can contain content should inherit from this
and Container() =
  inherit Element()
  member x.Zero() = ()
  member x.Run(c) = x.Page.PopStack(); c
  member x.For(sq, b) = for e in sq do b e

// Default HTML element that can contain content (provides basic attributes only)
and ContainerDef() = 
  inherit Container()
  member x.set(?id:string, ?style:string, ?cssclass:string) = 
    id |> Option.iter (x.AddAttr "id")
    style |> Option.iter (x.AddAttr "style")
    cssclass |> Option.iter (x.AddAttr "class")
    x

// Represents HTML element <a> with requried attribute 'href'
and ContainerA() = 
  inherit Container()
  member x.set(href:string, ?id:string, ?style:string, ?cssclass:string) = 
    x.AddAttr "href" href
    id |> Option.iter (x.AddAttr "id")
    style |> Option.iter (x.AddAttr "style")
    cssclass |> Option.iter (x.AddAttr "class")
    x

// TODO: We need to add other content HTML elements here...

// This is the main computation builder that represents Page. It also stores
// all the state as the computation builders run and produce our HTML.
and Page() as this =
  let root = new XDocument()
  let mutable current = root :> XContainer
  let stack = new Stack<_>()

  // Creates element that cannot contain content
  let createElement name = 
    let el = new XElement(xn name)
    current.Add(el)
    let res = new 'T()
    (res :> Element).Init(name, this, el)
    res

  // Creataes element that can contain content
  let createContainerElement name = 
    let el = new XElement(xn name)
    current.Add(el)
    stack.Push(current)
    current <- el
    let res = new 'T()
    (res :> Container).Init(name, this, el)
    res

  member (* friend Container *) x.Current = current
  member (* friend Container *) x.PopStack() = current <- stack.Pop()

  // Returns the constructed XML document (at the end of execution)
  member x.Document = root

  // Various members for creating html elements 
  member x.title = createContainerElement<ContainerDef> "title"
  member x.html = createContainerElement<ContainerDef> "html"
  member x.link = createElement<ElementLink> "html" 
  member x.head = createContainerElement<ContainerDef> "head"
  member x.h1 = createContainerElement<ContainerDef> "h1"
  member x.h2 = createContainerElement<ContainerDef> "h2"
  member x.ul = createContainerElement<ContainerDef> "ul"
  member x.li = createContainerElement<ContainerDef> "li"
  member x.strong = createContainerElement<ContainerDef> "strong"
  member x.p = createContainerElement<ContainerDef> "p"
  member x.div = createContainerElement<ContainerDef> "div"
  member x.a = createContainerElement<ContainerA> "a"
  member x.hr = createElement<ElementDef> "hr"

  // Used for creating text content (called by the % operator)
  member x.text(str:string) = current.Add(str)
  // Used for creating content templates - to be passed as 
  // arguments to a parameterized tempalte
  member x.content = new ContentTemplate()


// Initialize global value of the Page (yes, it has to be global) and helper
// operator '%' for creating text elements in the document

let h = Page()
let (~%) str = h.text(str)

// Just a shortcut to make the syntax more succinct
let fm = sprintf

// Master template taking 'title' and 'content' as arguments

let masterTemplate title content = 
  h.html {
    h.head {
      h.title { 
        title()
        %" - View Engine Sample" 
      }
      h.link.set(typ="text/css", rel="stylesheet", href="/styles/main.css")
    }
    h.h1 { title() }
    h.hr.set(cssclass="heading")
    content()
    h.hr
    h.div.set(id="footer") {
      %"This is an example of using"
      h.a.set(href="http://fsharp.net") { %"the amazing F# language" }
      % @"for writing a simple an elegant view engine 
          for the ASP.NET MVC framework"
    }
  }

Examples

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
// A page that reads products and displays them using the 'masterTemplate'

let products = 
  [ "Tea", 2.3M; 
    "Coffee", 5.0M; 
    "Lemonade", 1.5M ]

masterTemplate
  (h.content { % "Product Listing" })
  (h.content {
    h.div { 
      h.ul.set(cssclass="listing") {
        for name, price in products do
          h.li { 
            h.strong { % name }
            % fm " - Price: $%f" price }
      }
    }
  })

// Prints the constructed XML
h.Document.ToString()
namespace System
namespace System.Xml
namespace System.Xml.Linq
namespace System.Collections
namespace System.Collections.Generic
val xn : s:string -> XName

Full name: Script.xn
val s : string
type XName =
  member Equals : obj:obj -> bool
  member GetHashCode : unit -> int
  member LocalName : string
  member Namespace : XNamespace
  member NamespaceName : string
  member ToString : unit -> string
  static member Get : expandedName:string -> XName + 1 overload

Full name: System.Xml.Linq.XName
XName.Get(expandedName: string) : XName
XName.Get(localName: string, namespaceName: string) : XName
Multiple items
type ContentTemplate =
  new : unit -> ContentTemplate
  member Delay : f:(unit -> unit) -> (unit -> unit)
  member Zero : unit -> unit

Full name: Script.ContentTemplate

--------------------
new : unit -> ContentTemplate
val x : ContentTemplate
member ContentTemplate.Zero : unit -> unit

Full name: Script.ContentTemplate.Zero
member ContentTemplate.Delay : f:(unit -> unit) -> (unit -> unit)

Full name: Script.ContentTemplate.Delay
val f : (unit -> unit)
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
Multiple items
type Element =
  new : unit -> Element
  member AddAttr : n:string -> v:'c -> unit
  member Init : n:string * p:Page * e:XElement -> unit
  member Page : Page

Full name: Script.Element

--------------------
new : unit -> Element
val mutable name : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val mutable pg : Page
Multiple items
type Page =
  new : unit -> Page
  member PopStack : unit -> unit
  member Current : XContainer
  member Document : XDocument
  member a : ContainerA
  member content : ContentTemplate
  member div : ContainerDef
  member h1 : ContainerDef
  member h2 : ContainerDef
  member head : ContainerDef
  ...

Full name: Script.Page

--------------------
new : unit -> Page
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val mutable el : XElement
Multiple items
type XElement =
  inherit XContainer
  new : name:XName -> XElement + 4 overloads
  member AncestorsAndSelf : unit -> IEnumerable<XElement> + 1 overload
  member Attribute : name:XName -> XAttribute
  member Attributes : unit -> IEnumerable<XAttribute> + 1 overload
  member DescendantNodesAndSelf : unit -> IEnumerable<XNode>
  member DescendantsAndSelf : unit -> IEnumerable<XElement> + 1 overload
  member FirstAttribute : XAttribute
  member GetDefaultNamespace : unit -> XNamespace
  member GetNamespaceOfPrefix : prefix:string -> XNamespace
  member GetPrefixOfNamespace : ns:XNamespace -> string
  ...

Full name: System.Xml.Linq.XElement

--------------------
XElement(name: XName) : unit
XElement(other: XElement) : unit
XElement(other: XStreamingElement) : unit
XElement(name: XName, content: obj) : unit
XElement(name: XName, [<System.ParamArray>] content: obj []) : unit
val x : Element
Multiple items
member Element.Page : Page

Full name: Script.Element.Page

--------------------
type Page =
  new : unit -> Page
  member PopStack : unit -> unit
  member Current : XContainer
  member Document : XDocument
  member a : ContainerA
  member content : ContentTemplate
  member div : ContainerDef
  member h1 : ContainerDef
  member h2 : ContainerDef
  member head : ContainerDef
  ...

Full name: Script.Page

--------------------
new : unit -> Page
member Element.Init : n:string * p:Page * e:XElement -> unit

Full name: Script.Element.Init
val n : string
val p : Page
val e : XElement
member Element.AddAttr : n:string -> v:'c -> unit

Full name: Script.Element.AddAttr
val v : 'c
XContainer.Add([<System.ParamArray>] content: obj []) : unit
XContainer.Add(content: obj) : unit
Multiple items
type XAttribute =
  inherit XObject
  new : other:XAttribute -> XAttribute + 1 overload
  member IsNamespaceDeclaration : bool
  member Name : XName
  member NextAttribute : XAttribute
  member NodeType : XmlNodeType
  member PreviousAttribute : XAttribute
  member Remove : unit -> unit
  member SetValue : value:obj -> unit
  member ToString : unit -> string
  member Value : string with get, set
  ...

Full name: System.Xml.Linq.XAttribute

--------------------
XAttribute(other: XAttribute) : unit
XAttribute(name: XName, value: obj) : unit
Multiple items
type ElementDef =
  inherit Element
  new : unit -> ElementDef
  member set : ?id:string * ?style:string * ?cssclass:string -> unit

Full name: Script.ElementDef

--------------------
new : unit -> ElementDef
val x : ElementDef
member ElementDef.set : ?id:string * ?style:string * ?cssclass:string -> unit

Full name: Script.ElementDef.set
val id : string option
val style : string option
val cssclass : string option
module Option

from Microsoft.FSharp.Core
val iter : action:('T -> unit) -> option:'T option -> unit

Full name: Microsoft.FSharp.Core.Option.iter
member Element.AddAttr : n:string -> v:'c -> unit
Multiple items
type ElementLink =
  inherit Element
  new : unit -> ElementLink
  member set : rel:string * href:string * typ:string * ?id:string * ?style:string * ?cssclass:string -> unit

Full name: Script.ElementLink

--------------------
new : unit -> ElementLink
val x : ElementLink
member ElementLink.set : rel:string * href:string * typ:string * ?id:string * ?style:string * ?cssclass:string -> unit

Full name: Script.ElementLink.set
val rel : string
val href : string
val typ : string
Multiple items
type Container =
  inherit Element
  new : unit -> Container
  member For : sq:seq<'a> * b:('a -> unit) -> unit
  member Run : c:'b -> 'b
  member Zero : unit -> unit

Full name: Script.Container

--------------------
new : unit -> Container
val x : Container
member Container.Zero : unit -> unit

Full name: Script.Container.Zero
member Container.Run : c:'b -> 'b

Full name: Script.Container.Run
val c : 'b
property Element.Page: Page
member Page.PopStack : unit -> unit
member Container.For : sq:seq<'a> * b:('a -> unit) -> unit

Full name: Script.Container.For
val sq : seq<'a>
val b : ('a -> unit)
val e : 'a
Multiple items
type ContainerDef =
  inherit Container
  new : unit -> ContainerDef
  member set : ?id:string * ?style:string * ?cssclass:string -> ContainerDef

Full name: Script.ContainerDef

--------------------
new : unit -> ContainerDef
val x : ContainerDef
member ContainerDef.set : ?id:string * ?style:string * ?cssclass:string -> ContainerDef

Full name: Script.ContainerDef.set
Multiple items
type ContainerA =
  inherit Container
  new : unit -> ContainerA
  member set : href:string * ?id:string * ?style:string * ?cssclass:string -> ContainerA

Full name: Script.ContainerA

--------------------
new : unit -> ContainerA
val x : ContainerA
member ContainerA.set : href:string * ?id:string * ?style:string * ?cssclass:string -> ContainerA

Full name: Script.ContainerA.set
val this : Page
val root : XDocument
Multiple items
type XDocument =
  inherit XContainer
  new : unit -> XDocument + 3 overloads
  member Declaration : XDeclaration with get, set
  member DocumentType : XDocumentType
  member NodeType : XmlNodeType
  member Root : XElement
  member Save : fileName:string -> unit + 6 overloads
  member WriteTo : writer:XmlWriter -> unit
  static member Load : uri:string -> XDocument + 7 overloads
  static member Parse : text:string -> XDocument + 1 overload

Full name: System.Xml.Linq.XDocument

--------------------
XDocument() : unit
XDocument([<System.ParamArray>] content: obj []) : unit
XDocument(other: XDocument) : unit
XDocument(declaration: XDeclaration, [<System.ParamArray>] content: obj []) : unit
val mutable current : XContainer
type XContainer =
  inherit XNode
  member Add : content:obj -> unit + 1 overload
  member AddFirst : content:obj -> unit + 1 overload
  member CreateWriter : unit -> XmlWriter
  member DescendantNodes : unit -> IEnumerable<XNode>
  member Descendants : unit -> IEnumerable<XElement> + 1 overload
  member Element : name:XName -> XElement
  member Elements : unit -> IEnumerable<XElement> + 1 overload
  member FirstNode : XNode
  member LastNode : XNode
  member Nodes : unit -> IEnumerable<XNode>
  ...

Full name: System.Xml.Linq.XContainer
val stack : Stack<XContainer>
Multiple items
type Stack<'T> =
  new : unit -> Stack<'T> + 2 overloads
  member Clear : unit -> unit
  member Contains : item:'T -> bool
  member CopyTo : array:'T[] * arrayIndex:int -> unit
  member Count : int
  member GetEnumerator : unit -> Enumerator<'T>
  member Peek : unit -> 'T
  member Pop : unit -> 'T
  member Push : item:'T -> unit
  member ToArray : unit -> 'T[]
  ...
  nested type Enumerator

Full name: System.Collections.Generic.Stack<_>

--------------------
Stack() : unit
Stack(capacity: int) : unit
Stack(collection: IEnumerable<'T>) : unit
val createElement : (string -> 'T) (requires default constructor and 'T :> Element)
val name : string
val el : XElement
val res : 'T (requires default constructor and 'T :> Element)
val createContainerElement : (string -> 'T) (requires default constructor and 'T :> Container)
Stack.Push(item: XContainer) : unit
val res : 'T (requires default constructor and 'T :> Container)
val x : Page
member Page.Current : XContainer

Full name: Script.Page.Current
member Page.PopStack : unit -> unit

Full name: Script.Page.PopStack
Stack.Pop() : XContainer
member Page.Document : XDocument

Full name: Script.Page.Document
member Page.title : ContainerDef

Full name: Script.Page.title
member Page.html : ContainerDef

Full name: Script.Page.html
member Page.link : ElementLink

Full name: Script.Page.link
member Page.head : ContainerDef

Full name: Script.Page.head
member Page.h1 : ContainerDef

Full name: Script.Page.h1
member Page.h2 : ContainerDef

Full name: Script.Page.h2
member Page.ul : ContainerDef

Full name: Script.Page.ul
member Page.li : ContainerDef

Full name: Script.Page.li
member Page.strong : ContainerDef

Full name: Script.Page.strong
member Page.p : ContainerDef

Full name: Script.Page.p
member Page.div : ContainerDef

Full name: Script.Page.div
member Page.a : ContainerA

Full name: Script.Page.a
member Page.hr : ElementDef

Full name: Script.Page.hr
member Page.text : str:string -> unit

Full name: Script.Page.text
val str : string
member Page.content : ContentTemplate

Full name: Script.Page.content
val h : Page

Full name: Script.h
member Page.text : str:string -> unit
val fm : (Printf.StringFormat<'a> -> 'a)

Full name: Script.fm
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val masterTemplate : title:(unit -> unit) -> content:(unit -> unit) -> unit

Full name: Script.masterTemplate
val title : (unit -> unit)
val content : (unit -> unit)
property Page.html: ContainerDef
property Page.head: ContainerDef
property Page.title: ContainerDef
property Page.link: ElementLink
member ElementLink.set : rel:string * href:string * typ:string * ?id:string * ?style:string * ?cssclass:string -> unit
property Page.h1: ContainerDef
property Page.hr: ElementDef
member ElementDef.set : ?id:string * ?style:string * ?cssclass:string -> unit
property Page.div: ContainerDef
member ContainerDef.set : ?id:string * ?style:string * ?cssclass:string -> ContainerDef
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
property Page.a: ContainerA
member ContainerA.set : href:string * ?id:string * ?style:string * ?cssclass:string -> ContainerA
val products : (string * decimal) list

Full name: Script.products
property Page.content: ContentTemplate
property Page.ul: ContainerDef
val price : decimal
property Page.li: ContainerDef
property Page.strong: ContainerDef
property Page.Document: XDocument
XNode.ToString() : string
XNode.ToString(options: SaveOptions) : string
Raw view New version

More information

Link:http://fssnip.net/hf
Posted:4 years ago
Author:Tomas Petricek
Tags: html , dsl