9 people like it.

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

More information

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