Mutating provided XML types

Using F# 4.0 Automatic Quotations to mutate provided XML documents with static type checking

 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: 
54:

// Set here the path to FSharp.Data on your computer
#r @"../NuGet/FSharp.Data.2.2.5/lib/net40/FSharp.Data.dll"
#r "System.Xml.Linq.dll"

open FSharp.Data
open System.Xml.Linq
open System.Reflection
open FSharp.Quotations
open FSharp.Quotations.Patterns
open Microsoft.FSharp.Linq.RuntimeHelpers.LeafExpressionConverter

type Xml =
  static member private xel (o: obj) =
    let pi = o.GetType().GetProperty("XElement")
    if pi <> null && pi.PropertyType = typeof<XElement>
    then pi.GetValue(o) |> unbox<XElement> |> Some
    else None

  static member inline Set([<ReflectedDefinition>] el: Expr< ^T >, v: ^T) =
    match el with
    | Let(_, Call(_, _, [parent; Value(:? string as name, _)]), _)
    | Let(_, Call(_, _, [Call(_, _, [parent; Value(:? string as name, _)])]), _) ->
      let parent =
        EvaluateQuotation parent
        |> Xml.xel
        |> function Some x -> x | None -> failwith "Object must be XElement"
      match parent.Attribute(XName.Get name) with
      | null ->
        parent.Element(XName.Get name).SetValue(v)
      | att -> att.Value <- string v
    | _ -> failwithf "Not supported expression:\n%A" el


// Example
type MyXml = XmlProvider<"http://www.w3schools.com/xml/simple.xml">
let foodMenu = MyXml.Load("http://www.w3schools.com/xml/simple.xml")
let waffles = foodMenu.Foods |> Seq.find (fun x -> x.Name.Contains("Waffles"))

Xml.Set(waffles.Description, "Sugar bomb")
//Xml.Set(waffles.Calories, "Plenty")         // Error, must be int
//Xml.Set(waffles.Price, 10)                  // Error, must be decimal

// Bonus: another helpful function... with duck typing :)
let inline addChild (el: ^a when ^a : (member XElement: XElement))
                    (child: ^b when ^b : (member XElement: XElement)) =
  (^a: (member XElement: XElement) el).Add (^b: (member XElement: XElement) child)

MyXml.Food(name = "Tortilla Española",
           price = 1000M,
           description = "Very tasty Spanish omelette",
           calories = 0)
|> addChild foodMenu

foodMenu.XElement.Save("/temp/foodMenu.xml")

namespace Microsoft.FSharp

namespace Microsoft.FSharp.Data

namespace System

namespace System.Xml

namespace System.Xml.Linq

namespace System.Reflection

namespace Microsoft.FSharp.Quotations

module Patterns

from Microsoft.FSharp.Quotations

namespace Microsoft

namespace Microsoft.FSharp.Linq

namespace Microsoft.FSharp.Linq.RuntimeHelpers

module LeafExpressionConverter

from Microsoft.FSharp.Linq.RuntimeHelpers

type Xml =
static member Set : el:Expr<'T> * v:'T -> unit
static member private xel : o:obj -> XElement option

Full name: Script.Xml

static member private Xml.xel : o:obj -> XElement option

Full name: Script.Xml.xel

val o : obj

type obj = System.Object

Full name: Microsoft.FSharp.Core.obj

val pi : PropertyInfo

System.Object.GetType() : System.Type

property PropertyInfo.PropertyType: System.Type

val typeof<'T> : System.Type

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

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, [<System.ParamArray>] content: obj []) : unit

PropertyInfo.GetValue(obj: obj, index: obj []) : obj
PropertyInfo.GetValue(obj: obj, invokeAttr: BindingFlags, binder: Binder, index: obj [], culture: System.Globalization.CultureInfo) : obj

val unbox : value:obj -> 'T

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

union case Option.Some: Value: 'T -> Option<'T>

union case Option.None: Option<'T>

Multiple items
static member Xml.Set : el:Expr<'T> * v:'T -> unit

Full name: Script.Xml.Set

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

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

--------------------
new : elements:seq<'T> -> Set<'T>

Multiple items
type ReflectedDefinitionAttribute =
inherit Attribute
new : unit -> ReflectedDefinitionAttribute

Full name: Microsoft.FSharp.Core.ReflectedDefinitionAttribute

--------------------
new : unit -> ReflectedDefinitionAttribute

val el : Expr<'T>

Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>

val v : 'T

active recognizer Let: Expr -> (Var * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Let|_| )

active recognizer Call: Expr -> (Expr option * MethodInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Call|_| )

val parent : Expr

active recognizer Value: Expr -> (obj * System.Type) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Value|_| )

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

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

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string

val name : string

val parent : XElement

val EvaluateQuotation : Expr -> obj

Full name: Microsoft.FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation

static member private Xml.xel : o:obj -> XElement option

val x : XElement

val failwith : message:string -> 'T

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

XElement.Attribute(name: XName) : XAttribute

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

XContainer.Element(name: XName) : XElement

val att : XAttribute

property XAttribute.Value: string

val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf

type MyXml = obj

Full name: Script.MyXml

val foodMenu : obj

Full name: Script.foodMenu

val waffles : obj

Full name: Script.waffles

module Seq

from Microsoft.FSharp.Collections

val find : predicate:('T -> bool) -> source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.find

val x : obj

static member Xml.Set : el:Expr<'T> * v:'T -> unit

val addChild : el:'a -> child:'b -> unit (requires member get_XElement and member get_XElement)

Full name: Script.addChild

val el : 'a (requires member get_XElement)

val child : 'b (requires member get_XElement)

Raw view Test code New version

More information

Link:	http://fssnip.net/sm
Posted:	9 years ago
Author:	Green Eagle Solutions
Tags:	xml , 4.0 , quotations