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

Full name: Script.xml

More information

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