Light XML DSL

A light domain specific language for declaring xml in F# as code.

 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:

open System

// The DSL
module LightDsl =
(Structural types omitted)
    let name s = Name (s)
    let qname ns s = QualifiedName (ns, s)

    let (@=) name value = { Name=name; Value=value }
    let elem name = { Name=name; Attributes=[]; Content=Empty }
    let attribs a (el:XmlElement) = { el with Attributes=a }
    let value s (el:XmlElement) = { el with Content=Value (s) }
    let content items (el:XmlElement) = { el with Content=Content (items) }


open System.Xml.Linq
open LightDsl

[<AutoOpen>]
module XElementExtension =
(Private members omitted)
    module XElement =
        let ofLightDsl (xe:XmlElement) = map xe

// Usage
let xml = 
    elem (qname "http://myschema" "root")
    |> content [
        elem (name "Person")
        |> attribs [name "id" @= "js1"]
        |> content [elem (name "FullName") |> value "John Smith" ]]
    |> XElement.ofLightDsl

namespace System

type XmlMarkup =
        | Element of XmlElement
        | Attribute of XmlAttribute

    and XmlName =
        | Name of string
        | QualifiedName of string * string

    and XmlElement =
        { Name:XmlName
            Attributes:XmlAttribute list
            Content:XmlElementContent }

    and XmlElementContent =
        | Empty
        | Value of string
        | Content of XmlElement list

    and XmlAttribute =
        { Name:XmlName
            Value:String }

val name : s:string -> XmlName

Full name: Script.LightDsl.name

val s : string

union case XmlName.Name: string -> XmlName

val qname : ns:string -> s:string -> XmlName

Full name: Script.LightDsl.qname

val ns : string

union case XmlName.QualifiedName: string * string -> XmlName

val name : XmlName

val value : String

union case XmlElementContent.Value: string -> XmlElementContent

val elem : name:XmlName -> XmlElement

Full name: Script.LightDsl.elem

union case XmlElementContent.Content: XmlElement list -> XmlElementContent

union case XmlElementContent.Empty: XmlElementContent

val attribs : a:XmlAttribute list -> el:XmlElement -> XmlElement

Full name: Script.LightDsl.attribs

val a : XmlAttribute list

val el : XmlElement

type XmlElement =
  {Name: XmlName;
   Attributes: XmlAttribute list;
   Content: XmlElementContent;}

Full name: Script.LightDsl.XmlElement

val value : s:string -> el:XmlElement -> XmlElement

Full name: Script.LightDsl.value

val content : items:XmlElement list -> el:XmlElement -> XmlElement

Full name: Script.LightDsl.content

val items : XmlElement list

namespace System.Xml

Multiple items
namespace System.Linq

--------------------
namespace Microsoft.FSharp.Linq

module LightDsl

from Script

Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute

let private mapName = function
        | Name n -> XName.Get (n)
        | QualifiedName (ns,n) -> XName.Get (n, ns)

    let private mapAttribs (attribs:XmlAttribute list) =
        attribs |> List.map (fun a -> new XAttribute (mapName a.Name, a.Value))

    let rec private map (e:XmlElement) =
        match e.Content with
        | Empty -> new XElement (mapName e.Name)
        | Value s ->
            let content =
                mapAttribs e.Attributes
                |> List.map (fun a -> a :> obj)
                |> List.append ([s :> obj])

            new XElement (mapName e.Name, content)
        | Content c ->
            let content =
                mapAttribs e.Attributes
                |> List.map (fun a -> a :> obj)
                |> List.append (c |> List.map (fun e -> map (e) :> obj))

            new XElement (mapName e.Name, content)

module XElement

from Script.XElementExtension

val ofLightDsl : xe:XmlElement -> 'a

Full name: Script.XElementExtension.XElement.ofLightDsl

val xe : XmlElement

val private map : e:XmlElement -> 'a

Full name: Script.XElementExtension.map

val xml : obj

Full name: Script.xml

Previous Version Raw view Test code New version

More information

Link:	http://fssnip.net/9x
Posted:	13 years ago
Author:	Huw Simpson
Tags:	xml , dsl , linqtoxml