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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
module MarkdownGen
// MarkdownGen is only used for some property-based testing and is not ready for use for anything else.
open Types
open Shared
open Logger
// return string surrounded by pat
let surround pat str =
let pat2 = match pat with
| "(" -> ")"
| "[" -> "]"
| "{" -> "}"
| _ -> pat
sprintf "%s%s%s" pat str pat2
/// convert TFrmtedString to string
let rec mdFStr fStr =
match fStr with
| Literal str -> str
| Code str -> surround "`" str
| Strong a -> mdInlineElements a |> surround "**"
| Emphasis e -> mdInlineElements e |> surround "*"
| Line l -> mdInlineElements l
| Strike s -> mdInlineElements s |> surround "~~"
/// convert InlineElement list to string, with HTML tags where necessary
/// not tail recursive because the code looks cleaner this way
and mdInlineElements' b eles =
let braSurround = surround "("
let sbraSurround = surround "["
let convertMd pStr ele =
pStr +
match ele with
| FrmtedString fStr -> mdFStr fStr
| Link (ht, url) -> (mdFStr ht |> sbraSurround) + (url |> braSurround)
| Picture (alt, url) -> (alt |> sbraSurround |> sprintf "!%s" ) + (url |> braSurround)
| InlineCitation (ht, _)
| InlineFootnote (ht, _) -> ("^" + mdFStr ht) |> sbraSurround
List.fold convertMd (sprintf "%s" b) eles
and mdInlineElements = mdInlineElements' ""
/// process Markdown paragraph
let mdParagraph lines =
let folder pLinesStr line =
pLinesStr + mdInlineElements line
List.fold folder "" lines
+ "\n\n"
/// process Markdown Table
let mdTable (rows: PRow list) =
// filter out table header
let containHeader (row: PRow) =
//let PCells(_, isHeader) = row
match row with
| PCells(_, isHeader) ->
isHeader
let takeoutCells = List.map (fun pRow -> match pRow with | PCells(cells,_) -> cells)
let headerRows = List.filter (containHeader) rows |> takeoutCells
let bodyRows = List.filter (containHeader >> not) rows |> takeoutCells
let foldCells alignRow row =
let cellsFolder alignRow pStr cell =
match cell with
| CellLine(line, _, align) ->
match alignRow with
| true ->
match align with
| Centre -> ":---:"
| Right -> "---:"
| Left -> ":---"
| NoAlign -> "---"
| false ->
mdInlineElements line
|> (fun cellContent -> pStr + cellContent + "|")
List.fold (cellsFolder alignRow) "|" row
let foldRows alignRow rows =
let rowsFolder alignRow pStr row =
pStr + (foldCells alignRow) row + "\n"
List.fold (rowsFolder alignRow) "" rows
let foldNormalRows = foldRows false
let foldAlignRow = foldCells true
foldNormalRows headerRows
+ (headerRows |> List.head |> foldAlignRow)
+ foldNormalRows bodyRows + "\n\n"
/// recursively process a list
let rec mdList list =
let mdListItem ord tab (pStr,pCount) li =
let makeTabs num =
if num <= 0 then "" else String.replicate num "\t"
let retFold s = pStr + s, pCount + 1
match li with
| StringItem(line) -> mdInlineElements line |> (fun s ->
match ord,s with
| _,"" -> ""
| true,_ ->
sprintf "%s%i. %s\n" (makeTabs tab) pCount s
|> logPassN globLog.Debug
| false,_ ->
sprintf "%s- %s\n" (makeTabs tab) s) |> retFold
| NestedList(list) -> mdList list |> retFold
match list with
| {ListType=lt; ListItem=liS; Depth=d} ->
let ord = match lt with | OL _ -> true | UL -> false
List.fold (mdListItem ord (d-1)) ("",1) liS
|> fst
/// process header
let mdHeader header =
match header with
| {HeaderName=line;Level=lv} ->
(line |> mdInlineElements)
|> sprintf "%s %s\n" (String.replicate lv "#")
/// process HTML body part
let mdBody pObjs =
let folder pStr pObj =
pStr +
match pObj with
| Paragraph p -> mdParagraph p
| Quote q -> mdInlineElements' ">" q
| CodeBlock (c, l) -> surround "```" (mapLang l + "\n" + c + "\n")
| Table rows -> mdTable rows
| List l -> mdList l |> sprintf "%s\n"
| Header h -> mdHeader h //#### DO SOMETHING WITH STRING HERE
//| Footnote (fnId, _) -> mdInlineFootnote fnId
| _ -> sprintf "%A is not implemented" pObj
List.fold folder "" pObjs
|
