sane markdown

1 files changed, 214 insertions, 0 deletions

diff --git a/doc/txt.ml b/doc/txt.ml
new file mode 100644
index 0000000..951f528
--- /dev/null
+++ b/doc/txt.ml
@@ -0,0 +1,214 @@
+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 dedent 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, String.suff s n) in
+  f 0
+
+let rec getlines acc n =
+  match try Some (read_line ()) with End_of_file -> None with
+  | Some s ->
+    let (lvl, s) = dedent s in
+    getlines ((n, lvl, s) :: acc) (n+1)
+  | None -> List.rev acc
+
+let endnum s =
+  let rec f n =
+    if n >= String.length s then 0 else
+    let c = Char.code s.[n] in
+    if c >= 48 && c <= 57 then f (n+1) else
+    if s.[n] = ' ' then f (n+1) else
+    if s.[n] = '.' then (n+1) else
+    0 in
+  f 0
+let skipnum s = String.suff s (endnum 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 = String.haspref "* " l
+
+let getverb lines idnt =
+  let rec f ls =
+    match top lines with
+    | Some (n, i, l) when i >= idnt || l = "" ->
+      pop lines |> ignore;
+      f (l :: 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, String.suff l 2);
+      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