3 people like it.

HTML File Type

Discriminated unions to represent a HTML file.(not completely)

  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: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 

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 -> "<meta" + s + " />"
    | Title s  -> decorateNode "<title>" s

type Header =
    Head of (HeaderNode list)

let markupHeader = function
    | Head hls -> decorateNodes hls markupHeaderNode <| decorateNode "<head>"

type BodyNode =
    | Div of (BodyNode list)
    | Span of (BodyNode list)
    | P of (BodyNode list)
    | Text of string
    | H1 of string | H2 of string | H3 of string
    | Br | Hr

let rec markupBodyNode = function
    | Br -> "<br />"
    | Hr -> "<hr>"
    | H1 s -> decorateNode "<h1>" s
    | H2 s -> decorateNode "<h2>" s
    | H3 s -> decorateNode "<h3>" s
    | Text s -> s
    | Div bls  -> decorateNodes bls markupBodyNode <| decorateNode "<div>"
    | Span bls -> decorateNodes bls markupBodyNode <| decorateNode "<span>"
    | P bls    -> decorateNodes bls markupBodyNode <| decorateNode "<p>"

type Body =
    Body of (BodyNode list)

let markupBody = function
    | Body bls -> decorateNodes bls markupBodyNode <| decorateNode "<body>"

type HtmlNode =
    Html of Header * Body

let markupHtmlNode = function
    | Html (h, b) -> (markupHeader h) + (markupBody b)
                    |> decorateNode "<html>"

type DocType = DocType of string

let markupDocType = function
    | DocType s -> "<!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:
// <!DOCTYPE html><html><head><meta Http-Equiv="Content-Type" Content="text/html; c
// harset='utf-8'" /><title>HtmlBuilder</title></head><body><h1>This</h1><h2>is</h2
// ><h3>it</h3><hr><div><span>a span node</span><p>a paragraph</p><br />plain text<
// /div></body></html>
namespace System
val decorateSequence : concatnator:(string -> 'a -> string) -> xs:'b list -> mapper:('b -> 'a) -> decorator:(string -> 'c) -> 'c

Full name: Script.decorateSequence
val concatnator : (string -> 'a -> string)
val xs : 'b list
val mapper : ('b -> 'a)
val decorator : (string -> 'c)
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val decorateAttributes : xs:'a list -> mapper:('a -> string) -> decorator:(string -> 'b) -> 'b

Full name: Script.decorateAttributes
val xs : 'a list
val mapper : ('a -> string)
val decorator : (string -> 'b)
val x : string
val y : string
val decorateNodes : xs:'a list -> mapper:('a -> string) -> decorator:(string -> 'b) -> 'b

Full name: Script.decorateNodes
val decorateNode : tag:string -> s:string -> string

Full name: Script.decorateNode
val tag : string
Multiple items
val string : value:'T -> string

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

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
val s : string
String.Replace(oldValue: string, newValue: string) : string
String.Replace(oldChar: char, newChar: char) : string
type MetaNode =
  | HttpEquiv of string
  | Content of string

Full name: Script.MetaNode
union case MetaNode.HttpEquiv: string -> MetaNode
union case MetaNode.Content: string -> MetaNode
val markupMetaNode : _arg1:MetaNode -> string

Full name: Script.markupMetaNode
type HeaderNode =
  | Meta of MetaNode list
  | Title of string

Full name: Script.HeaderNode
union case HeaderNode.Meta: MetaNode list -> HeaderNode
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
union case HeaderNode.Title: string -> HeaderNode
val markupHeaderNode : _arg1:HeaderNode -> string

Full name: Script.markupHeaderNode
val mls : MetaNode list
type Header = | Head of HeaderNode list

Full name: Script.Header
union case Header.Head: HeaderNode list -> Header
val markupHeader : _arg1:Header -> string

Full name: Script.markupHeader
val hls : HeaderNode list
type BodyNode =
  | Div of BodyNode list
  | Span of BodyNode list
  | P of BodyNode list
  | Text of string
  | H1 of string
  | H2 of string
  | H3 of string
  | Br
  | Hr

Full name: Script.BodyNode
union case BodyNode.Div: BodyNode list -> BodyNode
union case BodyNode.Span: BodyNode list -> BodyNode
union case BodyNode.P: BodyNode list -> BodyNode
Multiple items
union case BodyNode.Text: string -> BodyNode

--------------------
namespace System.Text
union case BodyNode.H1: string -> BodyNode
union case BodyNode.H2: string -> BodyNode
union case BodyNode.H3: string -> BodyNode
union case BodyNode.Br: BodyNode
union case BodyNode.Hr: BodyNode
val markupBodyNode : _arg1:BodyNode -> string

Full name: Script.markupBodyNode
val bls : BodyNode list
Multiple items
union case Body.Body: BodyNode list -> Body

--------------------
type Body = | Body of BodyNode list

Full name: Script.Body
val markupBody : _arg1:Body -> string

Full name: Script.markupBody
type HtmlNode = | Html of Header * Body

Full name: Script.HtmlNode
union case HtmlNode.Html: Header * Body -> HtmlNode
val markupHtmlNode : _arg1:HtmlNode -> string

Full name: Script.markupHtmlNode
val h : Header
val b : Body
Multiple items
union case DocType.DocType: string -> DocType

--------------------
type DocType = | DocType of string

Full name: Script.DocType
val markupDocType : _arg1:DocType -> string

Full name: Script.markupDocType
Multiple items
union case HtmlFile.HtmlFile: (DocType * HtmlNode) -> HtmlFile

--------------------
type HtmlFile = | HtmlFile of (DocType * HtmlNode)

Full name: Script.HtmlFile
val markupHtmlFile : _arg1:HtmlFile -> string

Full name: Script.markupHtmlFile
val d : DocType
val h : HtmlNode
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
Raw view Test code New version

More information

Link:http://fssnip.net/bf
Posted:12 years ago
Author:Gab_km
Tags: discriminated union , html

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.