Skip to content

Instantly share code, notes, and snippets.

@pirrmann
Last active October 30, 2017 17:33
Show Gist options
  • Save pirrmann/e704055aebc4830b06a33246a9f6e72f to your computer and use it in GitHub Desktop.
Save pirrmann/e704055aebc4830b06a33246a9f6e72f to your computer and use it in GitHub Desktop.
DocTales : WIP
module Document.Core
type Emphasis = | Regular | Medium | Strong
type TextPart = { Text:string; Emphasis:Emphasis; Style:string option }
with static member Regular(text) = { Text=text; Emphasis=Regular; Style=None }
static member Medium(text) = { Text=text; Emphasis=Medium; Style=None }
static member Strong(text) = { Text=text; Emphasis=Strong; Style=None }
type Text = Text of TextPart list
with static member Regular(text) = Text([TextPart.Regular(text)])
static member Medium(text) = Text([TextPart.Medium(text)])
static member Strong(text) = Text([TextPart.Strong(text)])
static member Block(text) = Text.Regular(text) |> Block
static member List(items) = items |> (List.map Text.Regular) |> List
and DocPart =
| TitledSections of TitledSection list
| TitledSection of TitledSection
| Block of Text
| List of Text list
| Table of Style:string option * Rows: Row list
| Section of Section
and TitledSection = { Title: string; Section: Section }
and Row = { Cells: Cell list; Style: string option }
with static member FromCells(cells) = { Cells = cells; Style = None }
static member FromCells(cells, style) = { Cells = cells; Style = Some(style) }
and Cell = { Parts: DocPart list; RowSpan: int; ColSpan: int; IsHeader: bool }
with static member New = { Parts = []; RowSpan = 1; ColSpan = 1; IsHeader = false }
static member Text(text:string) = Cell.Text(Text.Regular(text))
static member Text(text:Text) = { Parts = [ Block(text) ]; RowSpan = 1; ColSpan = 1; IsHeader = false }
static member Header(text:string) = Cell.Header(Text.Regular(text))
static member Header(text:Text) = { Parts = [ Block(text) ]; RowSpan = 1; ColSpan = 1; IsHeader = true }
and Section = { Parts: DocPart list; BreakBefore: bool; Style: string option }
with static member FromParts(parts) = { Parts = parts; BreakBefore = false; Style = None }
[<AutoOpen>]
module Tools =
let withPageBreak section = { section with BreakBefore = true }
let titled title section = { Title = title; Section = section }
module Document.HtmlRenderer
open Document.Core
let rec toHtml (docPart:DocPart): string seq =
let toHtmlRow (row:Row) =
seq {
yield sprintf "<tr%s>" (match row.Style with | None -> "" | Some(style) -> " class=" + style)
for cell in row.Cells do
let tag = if cell.IsHeader then "th" else "td"
yield sprintf "<%s colspan=\"%d\" rowspan=\"%d\">" tag cell.ColSpan cell.RowSpan
yield! cell.Parts |> Seq.collect toHtml
yield sprintf "</%s>" tag
yield "</tr>" }
let toHtmlSection parentTag titledSection =
seq {
yield sprintf "<%s%s>" parentTag (if titledSection.Section.BreakBefore then " class=\"page-break\"" else "")
yield sprintf "<span class=\"title\">%s</span>" titledSection.Title
yield "<div>"
yield! titledSection.Section.Parts |> Seq.collect toHtml
yield "</div>"
yield sprintf "</%s>" parentTag
}
let getClass emphasis style =
match emphasis, style with
| Regular, None -> ""
| Medium, None -> " class=\"em-medium\""
| Strong, None -> " class=\"em-strong\""
| Regular, Some style -> sprintf " class=\"%s\"" style
| Medium, Some style -> sprintf " class=\"em-medium %s\"" style
| Strong, Some style -> sprintf " class=\"em-strong %s\"" style
let toHtmlTextParts parentTag text =
seq {
match text with
| Text([singlePart]) when singlePart.Style = None ->
yield sprintf "<%s%s>" parentTag (getClass (singlePart.Emphasis) None)
yield singlePart.Text
yield sprintf "</%s>" parentTag
| Text(parts) ->
yield sprintf "<%s>" parentTag
yield! parts |> Seq.map (fun p -> sprintf "<span%s>%s</span>" (getClass (p.Emphasis) (p.Style)) p.Text)
yield sprintf "</%s>" parentTag
}
seq {
match docPart with
| TitledSections(sections) ->
yield "<ol>"
for section in sections do
yield! toHtmlSection "li" section
yield "</ol>"
| TitledSection(section) ->
yield! toHtmlSection "div" section
| Table(style, rows) ->
yield match style with Some(s) -> sprintf "<table class=\"%s\">" s | None -> "<table>"
for row in rows do
yield! toHtmlRow row
yield "</table>"
| Block(b) -> yield! b |> toHtmlTextParts "p"
| List(lis) ->
yield "<ul>"
yield! lis |> Seq.collect (toHtmlTextParts "li")
yield "</ul>"
| Section(section) ->
yield
match section.Style, section.BreakBefore with
| Some(s), true -> sprintf "<div class=\"%s page-break\">" s
| Some(s), false -> sprintf "<div class=\"%s\">" s
| None, true -> "<div class=\"page-break\">"
| None, false -> "<div>"
yield! section.Parts |> Seq.collect toHtml
yield "</div>"
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment