2 people like it.

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:8 years ago
Author:Green Eagle Solutions
Tags: xml , 4.0 , quotations