373 people like it.

Minimal XML DSL

This snippet provides a very small internal DSL for creating and querying XML using the underlying XLinq classes.

DSL for XML literals

1: 
2: 
3: 
4: 
5: 
6: 
7: 

let (!) s = XName.Get(s)
let (@=) xn value = XAttribute(xn, value)
let (@?=) xn value = match value with Some s -> XAttribute(xn, s) | None -> null
type XName with 
    member xn.Item 
        with get([<ParamArray>] objs: obj[]) = 
            if objs = null then null else XElement(xn, objs)

DSL for XML matching

 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: 

type XElement with 
    member e.Item 
        with get(xn: XName) = 
            match e.Attribute(xn) with null -> "" | a -> a.Value
type XMatch = { 
    Filter: XElement seq -> XElement seq 
    Pick: XElement seq -> string
    Step: XName -> XElement -> XElement seq } with
    static member (/) (this: XMatch, xn: XName) = 
        { this with Filter = this.Filter >> Seq.collect (this.Step xn) }
    static member (/) (this: XMatch, xa: XAttribute) = 
        { this with Filter = this.Filter >> Seq.filter (fun e -> e.[xa.Name] = xa.Value) }
    static member (/@) (this: XMatch, xn: XName) =
        { this with 
            Pick = Seq.choose(fun e -> 
                match e.[xn] with "" -> None | s -> Some(s)) >> String.Concat }
    static member (/?) (this: XMatch, e: XElement) = 
        this.Filter(Seq.singleton(e))
    static member (/=) (this: XMatch, e: XElement) = 
        not(this.Filter(Seq.singleton(e)) |> Seq.isEmpty)
    static member (/!) (this: XMatch, e: XElement) = 
        this.Filter(Seq.singleton(e)) |> this.Pick
let (!/) (xn: XName) = {
        Filter = Seq.filter(fun e -> e.Name = xn)
        Pick = Seq.map(fun e -> e.Value) >> String.Concat
        Step = (fun xn e -> e.Elements(xn)) }

Example Usage

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 

let foo, bar, baz, quux = !"foo", !"bar", !"baz", !"{urn:example}quux"
let x = 
    foo.[
        quux.[null],               // intentionally omitted from result
        bar.[baz@?=None,           // omitted attribute
            quux.[()],             // empty element
            quux.[                 // note namespace
                baz@=42,           // value conversion
                "content"]],       // text content
        bar.[baz@=true, 
            quux.[DateTime.Now]]]  // value conversion
printfn "%O" x

printfn "Elements: %A" (!/foo/bar/(baz@=true)/quux/? x)
printfn "Matches: %A" (!/foo/bar/(baz@=true)/quux/= x)
printfn "Doesn't Match: %A" (!/foo/bar/(baz@=false)/quux/= x)
printfn "Values: %A" (!/foo/bar/quux/(baz@=42)/! x)
printfn "Attributes: %A" (!/foo/bar/quux/@baz/! x)
printfn "Split Elements: %A" 
    (Seq.singleton(x) |> (!/foo/bar).Filter |> (!/bar/quux/(baz@=42)).Filter)

Optional way to organize schema-specific XNames

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 

module private ns =
    type Namespace = { ns: XNamespace; decl: XAttribute }
    let inline private n prefix uri = {
        ns = XNamespace.Get(uri)
        decl = XAttribute(XNamespace.Xmlns + prefix, uri) }
    let none       = {ns = XNamespace.None; decl = null}
    let client     = n "client"   "jabber:client"
module private xn =
    let message    = ns.client.ns  + "message"
    let body       = ns.client.ns  + "body"
module private xa = 
    let from       = ns.none.ns    + "from"

printfn "%O" xn.message.[xa.from@="blake@bcdev.com", xn.body.["Hello, World!"]]
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
val xn : XName
val value : 'a
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
val value : 'a option
union case Option.Some: Value: 'T -> Option<'T>
val s : 'a
union case Option.None: Option<'T>
member XName.Item : [<ParamArray>] objs:obj [] -> XElement with get

Full name: Script.Item
Multiple items
type ParamArrayAttribute =
  inherit Attribute
  new : unit -> ParamArrayAttribute

Full name: System.ParamArrayAttribute

--------------------
ParamArrayAttribute() : unit
val objs : obj []
type obj = Object

Full name: Microsoft.FSharp.Core.obj
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, [<ParamArray>] content: obj []) : unit
val e : XElement
member XElement.Item : xn:XName -> string with get

Full name: Script.Item
XElement.Attribute(name: XName) : XAttribute
val a : XAttribute
property XAttribute.Value: string
type XMatch =
  {Filter: seq<XElement> -> seq<XElement>;
   Pick: seq<XElement> -> string;
   Step: XName -> XElement -> seq<XElement>;}
  static member ( /@ ) : this:XMatch * xn:XName -> XMatch
  static member ( /! ) : this:XMatch * e:XElement -> string
  static member ( /? ) : this:XMatch * e:XElement -> seq<XElement>
  static member ( / ) : this:XMatch * xn:XName -> XMatch
  static member ( / ) : this:XMatch * xa:XAttribute -> XMatch
  static member ( /= ) : this:XMatch * e:XElement -> bool

Full name: Script.XMatch
XMatch.Filter: seq<XElement> -> seq<XElement>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
XMatch.Pick: seq<XElement> -> string
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
XMatch.Step: XName -> XElement -> seq<XElement>
val this : XMatch
module Seq

from Microsoft.FSharp.Collections
val collect : mapping:('T -> #seq<'U>) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.collect
val xa : XAttribute
val filter : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.filter
property XAttribute.Name: XName
val choose : chooser:('T -> 'U option) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.choose
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
String.Concat([<ParamArray>] values: string []) : string
   (+0 other overloads)
String.Concat(values: Collections.Generic.IEnumerable<string>) : string
   (+0 other overloads)
String.Concat<'T>(values: Collections.Generic.IEnumerable<'T>) : string
   (+0 other overloads)
String.Concat([<ParamArray>] args: obj []) : string
   (+0 other overloads)
String.Concat(arg0: obj) : string
   (+0 other overloads)
String.Concat(str0: string, str1: string) : string
   (+0 other overloads)
String.Concat(arg0: obj, arg1: obj) : string
   (+0 other overloads)
String.Concat(str0: string, str1: string, str2: string) : string
   (+0 other overloads)
String.Concat(arg0: obj, arg1: obj, arg2: obj) : string
   (+0 other overloads)
String.Concat(str0: string, str1: string, str2: string, str3: string) : string
   (+0 other overloads)
val singleton : value:'T -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.singleton
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val isEmpty : source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.isEmpty
property XElement.Name: XName
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
property XElement.Value: string
XContainer.Elements() : Collections.Generic.IEnumerable<XElement>
XContainer.Elements(name: XName) : Collections.Generic.IEnumerable<XElement>
val foo : XName

Full name: Script.foo
val bar : XName

Full name: Script.bar
val baz : XName

Full name: Script.baz
val quux : XName

Full name: Script.quux
val x : XElement

Full name: Script.x
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
property DateTime.Now: DateTime
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
type private Namespace =
  {ns: XNamespace;
   decl: XAttribute;}

Full name: Script.ns.Namespace
Namespace.ns: XNamespace
type XNamespace =
  member Equals : obj:obj -> bool
  member GetHashCode : unit -> int
  member GetName : localName:string -> XName
  member NamespaceName : string
  member ToString : unit -> string
  static member Get : namespaceName:string -> XNamespace
  static member None : XNamespace
  static member Xml : XNamespace
  static member Xmlns : XNamespace

Full name: System.Xml.Linq.XNamespace
Namespace.decl: XAttribute
val private n : prefix:string -> uri:string -> Namespace

Full name: Script.ns.n
val prefix : string
val uri : string
XNamespace.Get(namespaceName: string) : XNamespace
property XNamespace.Xmlns: XNamespace
val private none : Namespace

Full name: Script.ns.none
property XNamespace.None: XNamespace
val private client : Namespace

Full name: Script.ns.client
val private message : XName

Full name: Script.xn.message
module ns

from Script
val private client : ns.Namespace

Full name: Script.ns.client
ns.Namespace.ns: XNamespace
val private body : XName

Full name: Script.xn.body
val private from : XName

Full name: Script.xa.from
val private none : ns.Namespace

Full name: Script.ns.none
module xn

from Script
module xa

from Script

More information

Link:http://fssnip.net/U
Posted:14 years ago
Author:Blake Coverett
Tags: xml

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.