diff --git a/src/printbox-md/PrintBox_md.ml b/src/printbox-md/PrintBox_md.ml index da3d776..421e0ed 100644 --- a/src/printbox-md/PrintBox_md.ml +++ b/src/printbox-md/PrintBox_md.ml @@ -2,88 +2,6 @@ module B = PrintBox -(* This is a bare-bones implementation that will hopefully evolve over time. *) -(* -let to_md_rec ~tables ~trees (b: B.t) = - let text_to_md ?(border=false) ~l ~style () = - let a, bold = attrs_of_style style in - let l = List.map H.txt l in - let l = if bold then List.map (fun x->H.b [x]) l else l in - let a_border = if border then [H.a_style "border:thin solid"] else [] in - H.span ~a:(H.a_class config.cls_text :: a_border @ (a @ config.a_text)) l in - let loop : - 'tags. (B.t -> ([< Html_types.flow5 > `Pre `Span `Div `Ul `Table `P] as 'tags) html) -> B.t -> 'tags html = - fun fix b -> - match B.view b with - | B.Empty -> (H.div [] :> [< Html_types.flow5 > `Pre `Span `Div `P `Table `Ul ] html) - | B.Text {l; style} when style.B.Style.preformatted -> H.pre [text_to_md ~l ~style ()] - | B.Text {l; style} -> text_to_md ~l ~style () - | B.Pad (_, b) -> fix b - | B.Frame b -> - H.div ~a:[H.a_style "border:thin solid"] [ fix b ] - | B.Align {h=`Right;inner=b;v=_} -> - H.div ~a:[H.a_class ["align-right"]] [ fix b ] - | B.Align {h=`Center;inner=b;v=_} -> - H.div ~a:[H.a_class ["center"]] [ fix b ] - | B.Align {inner=b;_} -> fix b - | B.Grid (bars, a) -> - let class_ = match bars with - | `Bars -> "framed" - | `None -> "non-framed" - in - let to_row a = - Array.to_list a - |> List.map - (fun b -> H.td ~a:(H.a_class config.cls_col :: config.a_col) [fix b]) - |> (fun x -> H.tr ~a:(H.a_class config.cls_row :: config.a_row) x) - in - let rows = - Array.to_list a |> List.map to_row - in - H.table ~a:(H.a_class (class_ :: config.cls_table)::config.a_table) rows - | B.Tree (_, b, l) -> - let l = Array.to_list l in - H.div - [ fix b - ; H.ul (List.map (fun x -> H.li [fix x]) l) - ] - | B.Link _ -> assert false - in - let rec to_md_rec b = - match B.view b with - | B.Tree (_, b, l) when config.tree_summary -> - let l = Array.to_list l in - (match B.view b with - | B.Text {l=tl; style} -> - H.details (H.summary [text_to_md ~l:tl ~style ()]) - [ H.ul (List.map (fun x -> H.li [to_md_rec x]) l) ] - | B.Frame b -> - (match B.view b with - | (B.Text {l=tl; style}) -> - H.details (H.summary [text_to_md ~border:true ~l:tl ~style ()]) - [ H.ul (List.map (fun x -> H.li [to_md_rec x]) l) ] - | _ -> - H.div - [ to_md_rec b - ; H.ul (List.map (fun x -> H.li [to_md_rec x]) l) - ]) - | _ -> - H.div - [ to_md_rec b - ; H.ul (List.map (fun x -> H.li [to_md_rec x]) l) - ]) - | B.Link {uri; inner} -> - H.div [H.a ~a:[H.a_href uri] [to_md_nondet_rec inner]] - | _ -> loop to_md_rec b - and to_md_nondet_rec b = - match B.view b with - | B.Link {uri; inner} -> - H.div [H.a ~a:[H.a_href uri] [to_md_nondet_rec inner]] - | _ -> loop to_md_nondet_rec b - in - to_md_rec b - *) - let style_format ~in_html (s:B.Style.t) = let open B.Style in let {bold; bg_color; fg_color; preformatted} = s in diff --git a/test/dune b/test/dune index 0669a87..1446576 100644 --- a/test/dune +++ b/test/dune @@ -32,3 +32,10 @@ (modules test_md) (package printbox-md) (libraries printbox printbox-md)) + +(rule + (alias runtest) + (deps test_md.expected) + (targets test_md.expected.md) + (mode promote) + (action (copy %{deps} %{targets})))