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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
let dent = 4
type doc = item list
and item =
| Verb of string * string
| Par of string
| Ulist of doc list
| Olist of doc list
| Title of int * string
let (|>) x f = f x
module String = struct
include String
let suff s n =
let l = String.length s in
if n >= l then "" else
String.sub s n (l-n)
let haspref p s =
let lp = String.length p in
String.length s >= lp &&
p = String.sub s 0 lp
end
let warn n e =
Printf.eprintf "Warning line %d: %s.\n" n e
let getdent s =
let rec f n =
if n >= String.length s then 0 else
if s.[n] = ' ' then f (n+1) else
if s.[n] = '\t' then f (n+8) else
n/dent in
f 0
let dedent s i =
let rec f i j =
if i <= 0 then (-i, j) else
if j >= String.length s then (0, j) else
if s.[j] = ' ' then f (i-1) (j+1) else
if s.[j] = '\t' then f (i-8) (j+1) else
(0, j) in
let (p, j) = f (i*dent) 0 in
String.make p ' ' ^ String.suff s j
let rec getlines acc n =
match try Some (read_line ()) with End_of_file -> None with
| Some s ->
getlines ((n, getdent s, s) :: acc) (n+1)
| None -> List.rev acc
let matchs skip fin s =
let rec f n =
if n >= String.length s then 0 else
if s.[n] = fin then (n+1) else
if String.contains skip s.[n] then f (n+1) else
0 in
f 0
let endnum = matchs " 0123456789" '.'
let endbul = matchs " " '*'
let skipnum s = String.suff s (endnum s)
let skipbul s = String.suff s (endbul s)
let gettitles lines =
let titles = Hashtbl.create 100 in
let insert lvl n t =
let t = skipnum t in
if Hashtbl.mem titles t then
warn n "title has multiple definitions";
Hashtbl.add titles t (lvl, n) in
lines |> List.iter begin fun (n, lvl, t) ->
if lvl <> 0 then () else
if String.haspref "- " t then insert 0 n t else
if String.haspref "~ " t then insert 1 n t else
()
end;
titles
let top lines =
match !lines with
| [] -> None
| l :: _ -> Some l
let pop lines =
match top lines with
| None -> None
| l -> lines := List.tl !lines; l
let push lines l =
lines := l :: !lines
let isolist l = endnum l <> 0
let isulist l = endbul l <> 0
let getverb lines idnt =
let rec f ls =
match top lines with
| Some (n, i, l) when i >= idnt || l = "" ->
pop lines |> ignore;
f (dedent l idnt :: ls)
| _ ->
let ls =
if List.hd ls = ""
then List.tl ls
else ls in
List.rev ls |>
String.concat "\n" in
f []
let getpar lines idnt =
let rec f ls =
match top lines with
| Some (n, i, l)
when i = idnt
&& l <> ""
&& not (isolist l)
&& not (isulist l) ->
pop lines |> ignore;
f (l :: ls)
| _ ->
List.rev ls |>
String.concat "\n" in
f []
let mergedoc =
let rec aggreg f = function
| (i :: is) as is'->
begin match f i with
| Some l ->
let l', is = aggreg f is in
List.append l l', is
| None -> [], is'
end
| is -> [], is in
let ul = function Ulist l -> Some l | _ -> None in
let ol = function Olist l -> Some l | _ -> None in
let rec f d = match d with
| Ulist _ :: _ ->
let l, d = aggreg ul d in
Ulist l :: f d
| Olist _ :: _ ->
let l, d = aggreg ol d in
Olist l :: f d
| i :: d -> i :: f d
| [] -> [] in
f
let rec getdoc lines si acc =
match top lines with
| Some (n, i, l) ->
if i = si && isolist l then begin (* Olist item *)
pop lines |> ignore;
push lines (n, i+1, skipnum l);
let li = getdoc lines (si+1) [] in
getdoc lines si (Olist [li] :: acc);
end else
if i = si && isulist l then begin (* Ulist item *)
pop lines |> ignore;
push lines (n, i+1, skipbul l);
let li = getdoc lines (si+1) [] in
getdoc lines si (Ulist [li] :: acc);
end else
if i > si then begin (* Verb item *)
let ty =
if l.[0] <> '[' then "" else begin
pop lines |> ignore;
l
end in
let verb = getverb lines i in
getdoc lines si (Verb (ty, verb) :: acc);
end else
if si = 0 && String.haspref "~ " l
|| si = 0 && String.haspref "- " l then begin (* Titles *)
pop lines |> ignore;
let lvl = if l.[0] = '-' then 0 else 1 in
let tit = String.suff l 2 in
getdoc lines si (Title (lvl, tit) :: acc);
end else
if String.haspref "---" l
|| String.haspref "~~~" l
|| l = "" then begin (* Decorations *)
pop lines |> ignore;
getdoc lines si acc;
end else
if i = si then begin (* Par item *)
let par = getpar lines si in
getdoc lines si (Par par :: acc);
end else
List.rev acc |> mergedoc
| None -> List.rev acc |> mergedoc
let rec dochtml d =
let open Printf in
let rec prlist =
List.iter begin fun d ->
match d with
| Par p :: d -> printf "<li>%s\n" p; dochtml d
| d -> printf "<li>"; dochtml d;
end in
let itemhtml = function
| Title (0, t) ->
printf "<h3>%s</h3>\n" t;
| Title (_, t) ->
printf "<h4>%s</h4>\n" t;
| Olist l ->
printf "<ol>\n";
prlist l;
printf "</ol>\n";
| Ulist l ->
printf "<ul>\n";
prlist l;
printf "</ul>\n";
| Verb (_, v) ->
printf "<pre>\n%s\n</pre>\n" v;
| Par p ->
printf "<p>\n%s\n</p>\n" p; in
List.iter itemhtml d
let _ =
let lines = getlines [] 1 in
let _ = gettitles lines in
getdoc (ref lines) 0 [] |> dochtml
|
