open System let decorateSequence concatnator xs mapper decorator = xs |> List.map mapper |> List.fold concatnator "" |> decorator let decorateAttributes xs mapper decorator = decorateSequence (fun x y -> x + " " + y) xs mapper decorator let decorateNodes xs mapper decorator = decorateSequence (fun x y -> x + y) xs mapper decorator let decorateNode (tag : string) s = tag + s + (tag.Replace ("<", "")) type MetaNode = HttpEquiv of string | Content of string let markupMetaNode = function | HttpEquiv s -> "Http-Equiv=\"" + s + "\"" | Content s -> "Content=\"" + s + "\"" type HeaderNode = Meta of (MetaNode list) | Title of string let markupHeaderNode = function | Meta mls -> decorateAttributes mls markupMetaNode <| fun s -> "" | Title s -> decorateNode "
" type Body = Body of (BodyNode list) let markupBody = function | Body bls -> decorateNodes bls markupBodyNode <| decorateNode "
" type HtmlNode = Html of Header * Body let markupHtmlNode = function | Html (h, b) -> (markupHeader h) + (markupBody b) |> decorateNode "" type DocType = DocType of string let markupDocType = function | DocType s -> "" type HtmlFile = HtmlFile of (DocType * HtmlNode) let markupHtmlFile = function | HtmlFile (d, h) -> (markupDocType d) + (markupHtmlNode h) HtmlFile ( DocType ("html"), Html ( Head ( [Meta ([HttpEquiv ("Content-Type"); Content ("text/html; charset='utf-8'")]); Title ("Html File")] ), Body ( [H1 ("This"); H2 ("is"); H3 ("it"); Hr; Div ( [Span ([Text ("a span node")]); P ([Text ("a paragraph")]); Br; Text ("plain text")] )] ) ) ) |> markupHtmlFile |> printfn "%s" // You will see like below: //a paragraph