Markup.fs

/// Provides basic types and syntax for defining XML and HTML fragments
/// as a deep EDSL in F#.  Design goals:
///
///     A. Allow different concrente interpretations, including:
///         1. XML documents and fragments
///         2. HTML(5) documents and fragmetns
///         3. XML or HTML templates with placeholders and/or instructions
///
///     B. Provide minimal type safetiy ensuring some sanity but not encoding every
///        invariant, which seems not practical with the weak F# type system.
///
///     C. Ensure consistent syntax (operator meaning) across interpretations
///
///     D. Avoid using operator overloading so that the F# code can run in
///        JavaScript by compiling via quotations (F# quotations do not play well
///        with overloaded operators).
module Markup =

    [<AbstractClass>]
    type Attribute =
        class
        end

    and [<AbstractClass>] [<ReflectedDefinition>] Element =
        inherit Node

        /// "WithChildren" - functional update replacing the children nodes.
        static member ( -^ ) (self: Element, children: #seq<#Node>) : Element =
            self.Markup.WithChildren (children |> Seq.map (fun x -> x :> _)) self

        /// "WithMixedChildren" - a variant of the above with implicit
        /// upcasting to Node. Useful when children are different subtypes.
        static member ( -* ) (self: Element, children: #seq<Node>) : Element =
            self.Markup.WithChildren children self

        /// "WithText" - functional update replacing the children nodes with a
        /// single text node.
        static member ( -% ) (self: Element, text: string) : Element =
            let m = self.Markup
            m.WithChildren [m.TextNode text] self

        /// "WithAttributes" - functional update replacing the attribute nodes.
        static member ( -@ ) (self: Element, attrs: #seq<#Attribute>) : Element =
            self.Markup.WithAttributes (attrs |> Seq.map (fun x -> x :> _)) self

    and [<AbstractClass>] Markup =
        abstract TextNode : string -> Node
        abstract WithAttributes : attributes: seq<Attribute> -> Element -> Element
        abstract WithChildren : children: seq<Node> -> Element -> Element

    and [<AbstractClass>] Node =
        abstract Markup : Markup

    /// Re-export symbolic operators for use in quotation-based code in JavaScript.
    [<ReflectedDefinition>]
    module Operators =

        /// "WithChildren"
        let ( -^ ) (self: Element) (children: #seq<#Node>) : Element =
            self.Markup.WithChildren (children |> Seq.map (fun x -> x :> _)) self

        /// "WithMixedChildren"
        let ( -* ) (self: Element) (children: #seq<Node>) : Element =
            self.Markup.WithChildren children self

        /// "WithText"
        let ( -% ) (self: Element) (text: string) : Element =
            let m = self.Markup
            m.WithChildren [m.TextNode text] self

        /// "WithAttributes"
        let ( -@ ) (self: Element) (attrs: #seq<#Attribute>) : Element =
            self.Markup.WithAttributes (attrs |> Seq.map (fun x -> x :> _)) self

    /// An example of use given some interpretation.
    module Example =
        open Operators

        [<AbstractClass>]
        type Text =
            inherit Node

        let E (x: string) : Element = failwith "TODO"
        let A (n: string) (v: string) : Attribute = failwith "TODO"
        let T (x: string) : Text = failwith "TODO"

        [<ReflectedDefinition>]
        let test () =
            E "html" -^ [
                E "head" -^ [E "title" -% "My Page"]
                E "body" -^ [
                    E "div" -^ [
                        E "div" -@ [A "id" "main"] -% "OK"
                        E "br"
                        E "div" -@ [A "id" "footer"] -* [T "OK"; E "br"]
                    ]
                ]
            ]