rework to allow for optional and required missing values

src/LitXml/DSL.fs

@@ -1,17 +1,52 @@
 namespace LitXml
 
+open System.Xml
+open Microsoft.FSharp.Quotations
+open Expression
+
 [<AutoOpen>]
-module DSL =
+type DSL =
 
-    let inline elem name = ElementBuilder(name)
+    static member inline elem name = ElementBuilder(name)
 
-    let inline attr name value = 
-        Attr(fun tb ->
+    static member inline attr name value : Attr = 
+        ok (fun tb ->
             tb.WriteAttributeString(name, string value)
         )
 
-    let inline value (s: 'a) : Value =
-        Value(fun tb ->
+    static member inline value (s: 'a when 'a :> System.IEquatable<'a>) : Value =
+        ok (fun tb -> 
             tb.WriteString(string s)
         )
 
+    static member inline value (s : Expr<'a> when 'a :> System.IEquatable<'a>) : Value =
+        try 
+            let value = eval<'a> s
+            let f = (fun (sb : XmlWriter) -> 
+                sb.WriteString(string value)
+            )
+            ok f            
+        with
+        | err -> MissingRequired([err.Message])
+
+
+    static member opt (elem : Element) = 
+        match elem with
+        | Ok (f,messages) -> elem
+        | MissingOptional (messages) -> Ok((fun tb -> ()),messages)
+        | MissingRequired (messages) -> Ok((fun tb -> ()),messages)
+
+    static member opt (elem : Expr<Element>) = 
+        try 
+            let elem = eval<Element> elem
+            match elem with
+            | Ok (f,messages) -> elem
+            | MissingOptional (messages) -> Ok((fun tb -> ()),messages)
+            | MissingRequired (messages) -> Ok((fun tb -> ()),messages)
+        with
+        | err -> 
+            let f = (fun (sb : XmlWriter) -> 
+                ()
+            )
+            Ok(f,[err.Message])
+

src/LitXml/Element.fs

@@ -0,0 +1,93 @@
+namespace LitXml
+
+open System.Xml
+
+/// 
+type Message = string
+
+/// Xml node with instructions about xml elements, values and attributes to be written by an xml writer.
+[<AutoOpen>]
+type XmlPart =
+    /// Node could be computed and contains writer instructions.
+    | Ok of (XmlWriter -> unit) * Message list
+    /// Node could not be computed, but was optional.
+    | MissingOptional of Message list
+    /// Node could not be computed, but was required.
+    | MissingRequired of Message list
+
+    static member ok (f : XmlWriter -> unit) : XmlPart = XmlPart.Ok (f,[])
+
+    /// Write xml node content to a xml writer.
+    member this.Invoke(xml : XmlWriter) = 
+
+        match this with 
+        | Ok (f,errs) -> f xml
+        | MissingOptional errs -> 
+            printfn "No function to invoke, Missings:"
+            errs 
+            |> List.iter (printfn "\t %s")
+        | MissingRequired errs -> 
+            printfn "No function to invoke, Missings:"
+            errs 
+            |> List.iter (printfn "\t %s")
+
+    /// Get messages
+    member this.Messages =
+
+        match this with 
+        | Ok (f,errs) -> errs
+        | MissingOptional errs -> errs
+        | MissingRequired errs -> errs
+
+    /// Write xml node content to a xml writer and close it.
+    member this.WriteTo(writer : XmlWriter) = 
+        match this with
+        | Ok (f,messages) ->
+            f writer
+            writer.Flush()
+            writer.Close()
+        | _ -> ()
+
+    /// Write xml node content to a memory stream using a xml writer.
+    ///
+    /// Writer can be tuned by supplying settings
+    member this.WriteTo(stream : System.IO.MemoryStream, ?Settings : XmlWriterSettings) = 
+        let settings = Option.defaultValue (XmlWriterSettings()) Settings
+        match this with
+        | Ok (f,messages) ->
+            let writer = XmlWriter.Create(stream,settings)
+            this.WriteTo(writer)
+        | _ -> ()
+
+    /// Write xml node content to a file path using a xml writer.
+    ///
+    /// Writer can be tuned by supplying settings
+    member this.WriteTo(path : string, ?Settings : XmlWriterSettings) = 
+        let settings = Option.defaultValue (XmlWriterSettings()) Settings
+        match this with
+        | Ok (f,messages) ->
+            let writer = XmlWriter.Create(path, settings)
+            this.WriteTo(writer)
+        | _ -> ()
+
+    /// Write xml node content to a string using a xml writer.
+    ///
+    /// Writer can be tuned by supplying settings
+    member this.WriteToString(?Settings : XmlWriterSettings) = 
+        let settings = Option.defaultValue (XmlWriterSettings()) Settings
+        match this with
+        | Ok (f,messages) ->
+            let tb = System.Text.StringBuilder()
+            let writer = XmlWriter.Create(tb,settings)
+            this.WriteTo(writer)
+            tb.ToString()
+        | _ -> ""
+
+/// Xml Element
+type Element = XmlPart
+
+/// Xml Value
+type Value = XmlPart
+
+/// Xml Attribute
+type Attr = XmlPart

src/LitXml/ElementBuilder.fs

@@ -2,85 +2,129 @@
 
 open System.Xml
 
-type Element(f : XmlWriter -> unit) =
+open Microsoft.FSharp.Quotations
+open Expression
 
-    member this.Invoke(xml : XmlWriter) = f xml
-
-type Value(f) =
+type ElementBuilder(name: string) =
 
-    inherit Element(f)
+    static member Empty = ok (fun _sb -> ())
 
-type Attr(f) =
+    // -- Computation Expression methods --> 
 
-    inherit Element(f)
+    member inline this.Zero() = ok (fun _sb -> ())
 
-// https://docs.microsoft.com/en-us/dotnet/api/system.xml.xmlwriter?view=net-6.0
-type ElementBuilder(name: string) =
+    member _.Name = name
 
-    static member Empty = Element(fun _sb -> ())
+    member inline _.Yield(n: 'a when 'a :> System.IEquatable<'a>) = 
+        ok (fun tb ->
+            tb.WriteString(string n)
+        )
 
-    member inline this.Zero() = Element(fun _sb -> ())
+    member inline _.Yield(n: XmlPart) = n
+
+    member inline _.Yield(b: ElementBuilder) =
+        ok (fun tb ->
+            tb.WriteStartElement(b.Name)
+            tb.WriteEndElement()
+        )
 
-    member _.Name = name
+    member inline _.Yield(b: Expr<XmlPart>) =
+        try 
+            eval<XmlPart> b                   
+        with
+        | err -> MissingRequired([err.Message])
 
-    member inline _.Yield(n: #Element) = n
+    member inline this.YieldFrom(ns: seq<XmlPart>) =   
+        ns
+        |> Seq.fold (fun state we ->
+            this.Combine(state,we)
 
-    member inline _.YieldFrom(ns: seq<#Element>) = 
-        Element(fun tb ->
-            Seq.iter (fun (n: #Element) -> n.Invoke(tb)) ns
-        )
+        ) ElementBuilder.Empty
 
-    member inline _.YieldFrom(bs: seq<ElementBuilder>) = 
-        Element(fun tb ->
+    member inline this.YieldFrom(bs: seq<ElementBuilder>) = 
+        ok (fun tb ->
             bs
             |> Seq.iter (fun b ->
                 tb.WriteStartElement(b.Name)
                 tb.WriteEndElement()
             )           
         )
 
-    member inline _.Yield(b: ElementBuilder) =
-        Element(fun tb ->
-            tb.WriteStartElement(b.Name)
-            tb.WriteEndElement()
-        )
+    member inline this.For(vs : seq<'T>, f : 'T -> XmlPart) =
+        vs
+        |> Seq.map f
+        |> this.YieldFrom
 
-    member inline this.Run(children: #Element) : Element =
-        Element(fun tb ->
-            tb.WriteStartElement(this.Name)
-            children.Invoke(tb)
-            tb.WriteEndElement()
-        )
+    member inline this.For(vs : seq<'T>, f : 'T -> ElementBuilder) =
+        vs
+        |> Seq.map f
+        |> this.YieldFrom
 
-    member inline _.Combine(x1: #Element, x2: #Element) =
-        Element(fun sb -> 
-            x1.Invoke(sb)
-            x2.Invoke(sb)
-        )
 
+    member inline this.Run(children: XmlPart) =
+        match children with
+        | Ok (f,messages) ->
+            Ok ((fun tb ->
+                tb.WriteStartElement(this.Name)
+                f tb
+                tb.WriteEndElement()
+            ),messages)
+        | MissingOptional messages -> MissingOptional messages 
+        | MissingRequired messages -> MissingRequired messages 
+
+    member this.Combine(wx1: XmlPart, wx2: XmlPart) : XmlPart=
+        match wx1,wx2 with
+        // If both contain content, combine the content
+        | Ok (f1,messages1), Ok (f2,messages2) ->
+            Ok (fun tb ->
+                f1 tb
+                f2 tb
+            ,List.append messages1 messages2)
+
+        // If any of the two is missing and was required, return a missing required
+        | _, MissingRequired messages2 ->
+            MissingRequired (List.append wx1.Messages messages2)
+
+        | MissingRequired messages1, _ ->
+            MissingRequired (List.append messages1 wx2.Messages)
+
+        // If only one of the two is missing and was optional, take the content of the functioning one
+        | Ok (f1,messages1), MissingOptional messages2 ->
+            Ok (fun tb ->
+                f1 tb
+            ,List.append messages1 messages2)
+
+        | MissingOptional messages1, Ok (f2,messages2) ->
+            Ok (fun tb ->
+                f2 tb
+            ,List.append messages1 messages2)
+
+        // If both are missing and were optional, return a missing optional
+        | MissingOptional messages1, MissingOptional messages2 ->
+            MissingOptional (List.append messages1 messages2)
+
     member inline _.Delay(n: unit -> Element) = n()
 
-    member inline _.For(ns: 'T seq, ex: 'T -> Element) = 
-        Element(fun tb ->
-            Seq.iter (fun n -> (ex n).Invoke(tb)) ns
-        )
 
-    static member WriteTo(stream : System.IO.MemoryStream, element : Element) = 
-        let writer = XmlWriter.Create(stream)
-        element.Invoke(writer) |> ignore
-        writer.Flush()
-        writer.Close()
-
-    static member WriteTo(path : string, element : Element) = 
-        let writer = XmlWriter.Create(path)
-        element.Invoke(writer) |> ignore
-        writer.Flush()
-        writer.Close()
-
-    static member WriteToString(element : Element) = 
-        let tb = System.Text.StringBuilder()
-        let writer = XmlWriter.Create(tb)
-        element.Invoke(writer) |> ignore
-        writer.Flush()
-        writer.Close()
-        tb.ToString()
+    // -- Writers --> 
+
+    static member writeToWriter (writer : XmlWriter) (element : Element) = 
+        element.WriteTo(writer)
+
+    static member writeToStream (stream : System.IO.MemoryStream) (element : Element) = 
+        element.WriteTo(stream)
+
+    static member writeToStreamWith (settings : XmlWriterSettings) (stream : System.IO.MemoryStream) (element : Element) = 
+        element.WriteTo(stream, settings)
+
+    static member writeToPath (path : string) (element : Element) = 
+        element.WriteTo(path)
+
+    static member writeToPathWith (settings : XmlWriterSettings) (path : string) (element : Element) = 
+        element.WriteTo(path, settings)
+
+    static member writeToString (element : Element) =
+        element.WriteToString()
+
+    static member writeToStringWith (settings : XmlWriterSettings) (element : Element) =
+        element.WriteToString(settings)

src/LitXml/Expression.fs

@@ -0,0 +1,8 @@
+namespace LitXml
+
+open Microsoft.FSharp.Quotations
+open Microsoft.FSharp.Linq.RuntimeHelpers
+
+module Expression =
+
+    let eval<'T> q = LeafExpressionConverter.EvaluateQuotation q :?> 'T

src/LitXml/LitXml.fsproj

@@ -12,8 +12,11 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="Expression.fs" />
+    <Compile Include="Element.fs" />
     <Compile Include="ElementBuilder.fs" />
     <Compile Include="DSL.fs" />
+    <Compile Include="Operators.fs" />
   </ItemGroup>
 
 </Project>

src/LitXml/Operators.fs

@@ -0,0 +1,34 @@
+namespace LitXml
+
+open System.Xml
+open Microsoft.FSharp.Quotations
+open Expression
+
+[<AutoOpen>]
+module Operators = 
+
+    /// Required value operator
+    ///
+    /// If expression does fail, returns a missing required value
+    let inline (!!) (s : Expr<'a> when 'a :> System.IEquatable<'a>) : Value =
+        try 
+            let value = eval<'a> s
+            let f = (fun (sb : XmlWriter) -> 
+                sb.WriteString(string value)
+            )
+            ok f            
+        with
+        | err -> MissingRequired([err.Message])
+
+    /// Optional value operator
+    ///
+    /// If expression does fail, returns a missing optional value
+    let inline (!?) (s : Expr<'a> when 'a :> System.IEquatable<'a>) : Value =
+        try 
+            let value = eval<'a> s
+            let f = (fun (sb : XmlWriter) -> 
+                sb.WriteString(string value)
+            )
+            ok f            
+        with
+        | err -> MissingOptional([err.Message])