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: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52:

open System

// The DSL
module LightDsl =
    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    }

    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" ]]

namespace System

type XmlMarkup =
| Element of XmlElement
| Attribute of XmlAttribute

Full name: Script.LightDsl.XmlMarkup

union case XmlMarkup.Element: XmlElement -> XmlMarkup

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

Full name: Script.LightDsl.XmlElement

Multiple items
union case XmlMarkup.Attribute: XmlAttribute -> XmlMarkup

--------------------
type Attribute =
  member Equals : obj:obj -> bool
  member GetHashCode : unit -> int
  member IsDefaultAttribute : unit -> bool
  member Match : obj:obj -> bool
  member TypeId : obj
  static member GetCustomAttribute : element:MemberInfo * attributeType:Type -> Attribute + 7 overloads
  static member GetCustomAttributes : element:MemberInfo -> Attribute[] + 15 overloads
  static member IsDefined : element:MemberInfo * attributeType:Type -> bool + 7 overloads

Full name: System.Attribute

type XmlAttribute =
{Name: XmlName;
Value: String;}

Full name: Script.LightDsl.XmlAttribute

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

Full name: Script.LightDsl.XmlName

union case XmlName.Name: string -> XmlName

Multiple items
val string : value:'T -> string

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

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string

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

XmlElement.Name: XmlName

XmlElement.Attributes: XmlAttribute list

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

XmlElement.Content: XmlElementContent

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

Full name: Script.LightDsl.XmlElementContent

union case XmlElementContent.Empty: XmlElementContent

union case XmlElementContent.Value: string -> XmlElementContent

union case XmlElementContent.Content: XmlElement list -> XmlElementContent

XmlAttribute.Name: XmlName

XmlAttribute.Value: String

Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit

val name : s:string -> XmlName

Full name: Script.LightDsl.name

val s : string

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

Full name: Script.LightDsl.qname

val ns : string

val name : XmlName

val value : String

val elem : name:XmlName -> XmlElement

Full name: Script.LightDsl.elem

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

Full name: Script.LightDsl.attribs

val a : XmlAttribute list

val el : 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 : XmlElement

Full name: Script.xml

Next Version Raw view Test code New version

More information

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