~toastal/sourcehut-asciidoc-renderer

2001851983d5cd8ed7f25a62e066f09758c67ab1 — toastal 1 year, 3 months ago b9ee70c
Add ocamlformat (wrapped with tab support)
3 files changed, 80 insertions(+), 46 deletions(-)

M flake.nix
A srht_markup_massager/.ocamlformat
M srht_markup_massager/srht_markup_massager.ml
M flake.nix => flake.nix +27 -2
@@ 15,11 15,35 @@

      nixpkgsFor = forAllSystems (system: import nixpkgs {
        inherit system;
        overlays = [ self.overlay ];
        overlays = [ self.overlay.default ];
      });
    in
    {
      overlay = final: prev: { };
      overlay.default = final: prev:
        let
          appendFlags = new: old:
            with builtins;
            if isString old then prev.lib.concatStringsSep " " ([ old ] ++ new)
            else if isList old then prev.lib.concatStringsSep " " (old ++ new)
            else (prev.lib.concatStringsSep " " new);

          of = prev.ocamlformat.overrideAttrs (old: {
            flambdaSupport = true;
            configureFlags = appendFlags [ "-O3" ] (old.configureFlags or null);
          });
        in
        {
          ocamlformat-with-tabs = prev.symlinkJoin {
            name = "ocamlformat";
            paths = [
              (prev.writeShellScriptBin "ocamlformat" ''
                set -euo pipefail
                exec ${prev.lib.getExe of} "$@" | unexpand --first-only --tabs=2
              '')
              of
            ];
          };
        };

      defaultPackage = forAllSystems (system: self.packages.${system}.${name});



@@ 73,6 97,7 @@
          buildInputs = with pkgs; [
            dhall
            nixpkgs-fmt
            ocamlformat-with-tabs
          ];
          inputsFrom = builtins.attrValues self.packages.${system};
        });

A srht_markup_massager/.ocamlformat => srht_markup_massager/.ocamlformat +14 -0
@@ 0,0 1,14 @@
profile = ocamlformat
break-fun-sig = fit-or-vertical
cases-exp-indent = 2
cases-matching-exp-indent = compact
field-space = loose
function-indent = 2
margin = 90
nested-match = align
leading-nested-match-parens = false
space-around-arrays = true
space-around-lists = true
space-around-records = true
space-around-variants = true
wrap-comments = true

M srht_markup_massager/srht_markup_massager.ml => srht_markup_massager/srht_markup_massager.ml +39 -44
@@ 1,7 1,5 @@
(*
	SPDX-FileCopyrightText 2022 toastal <toastal@posteo.net>
	SPDX-License-Identifier: LGPL-2.1-or-later
*)
(* SPDX-FileCopyrightText 2022 toastal <toastal@posteo.net> SPDX-License-Identifier:
	 LGPL-2.1-or-later *)
let unicon node =
	let () = Soup.remove_class "icon" node in
	Soup.add_class "Icon" node


@@ 11,43 9,43 @@ let mk_del node =
	Soup.set_name "del" node

let unwrap_lone_p soup parent_selector =
	Soup.select (String.concat "" [ parent_selector; ">"; "p:only-child" ]) soup
	soup
	|> Soup.select (String.concat "" [ parent_selector; ">"; "p:only-child" ])
	|> Soup.iter Soup.unwrap

let unwrap_definition_list_items node =
	match Soup.parent node with
	| None ->
		()
	| Some parent ->
		match Soup.parent parent with
		| Some parent' ->
			let () = Soup.select "li" node |> Soup.iter (Soup.set_name "dd") in
			let () = Soup.replace parent' node in
			Soup.unwrap node
		| None -> ()
	| None -> ()
		| None ->
			()

let markdown_wrapper node =
	let wrapper = Soup.create_element  ~class_:"markdown" "div" in
	let wrapper = Soup.create_element ~class_:"markdown" "div" in
	Soup.wrap node wrapper

let aside_n_color_admonitions node =
	(* `aside` is a more semantic element *)
	(* SourceHut doesn’t support <aside> even if it is more semantic
	let () = Soup.set_name "aside" node in
	*)
	(* SourceHut doesn’t support <aside> even if it is more semantic let () = Soup.set_name
		 "aside" node in *)
	let add_icon_class c = Soup.select ".Icon" node |> Soup.iter (Soup.add_class c) in
	let cs = Soup.classes node in
	if List.exists (fun x -> x = "tip" || x = "info") cs then
		add_icon_class "bg-info"
	if List.exists (fun x -> x = "tip" || x = "info") cs then add_icon_class "bg-info"
	else if List.exists (fun x -> x = "caution" || x = "warning") cs then
		add_icon_class "bg-warning"
	else if List.exists (fun x -> x = "important") cs then
		add_icon_class "bg-danger"
	else if List.exists (fun x -> x = "important") cs then add_icon_class "bg-danger"

(* `pygments.rb` Gem isn’t upstreamed into Nixpkgs, and it looks
 * complicated to do so. Errors are being swallowed; lazy. *)
(* `pygments.rb` Gem isn’t upstreamed into Nixpkgs, and it looks complicated to do so.
	 Errors are being swallowed; lazy. *)
let pygmentize_element node =
	match Soup.attribute "data-lang" node, Soup.leaf_text node, Soup.parent node with
	| (Some lang, Some sauce, Some parent) ->
	match (Soup.attribute "data-lang" node, Soup.leaf_text node, Soup.parent node) with
	| Some lang, Some sauce, Some parent ->
		(* These syntaxes aren’t yet supported *)
		let lang' =
			if lang = "purescript" || lang = "dhall" then "haskell"


@@ 55,10 53,11 @@ let pygmentize_element node =
			else lang
		in
		let command = Printf.sprintf "pygmentize -f html -l %s" lang' in
		let std_out, std_in, std_err =
			Unix.open_process_full command (Unix.environment ())
		let std_out, std_in, std_err = Unix.open_process_full command (Unix.environment ()) in
		let () =
			Soup.write_channel std_in sauce ;
			flush std_in
		in
		let () = Soup.write_channel std_in sauce; flush std_in in
		(* close stdin to signal the end of input *)
		let () = close_out std_in in
		let output = Soup.read_channel std_out in


@@ 68,54 67,50 @@ let pygmentize_element node =
		let () =
			Soup.select "div.highlight" parsed_code
			|> Soup.iter (fun cont ->
					let () = Soup.set_attribute "data-lang" lang cont in
					if lang != lang' then Soup.set_attribute "data-alt-lexer" lang' cont
				)
						 let () = Soup.set_attribute "data-lang" lang cont in
						 if lang != lang' then Soup.set_attribute "data-alt-lexer" lang' cont )
		in
		let () = (* special code cleanup *)
		let () =
			(* special code cleanup *)
			if lang' = "nix" then
				let remove_false_positive_errors er =
					if (Soup.texts er) = ["$"] then
					if Soup.texts er = [ "$" ] then
						match Soup.next_sibling er with
						| Some ns when (Soup.texts ns) = ["{"] ->
						| Some ns when Soup.texts ns = [ "{" ] ->
							let () = Soup.remove_class "err" er in
							Soup.add_class "p" er
						| _ -> ()
						| _ ->
							()
				in
				Soup.select "span.err" parsed_code |> Soup.iter remove_false_positive_errors
			else ()
		in
		Soup.replace parent parsed_code
	(* yeah, this is lazy *)
	| (_, _, _) -> ()
	| _, _, _ ->
		()

let () =
	let soup = Soup.read_channel stdin |> Soup.parse in
	(* Admonitions contain incompatible class *)
	let () = Soup.select "td.icon" soup |> Soup.iter unicon in
	(* Personally I think these are bugs in Asciidoctor, but visually it
	adds unnecessary space *)
	(* Personally I think these are bugs in Asciidoctor, but visually it adds unnecessary
		 space *)
	let () = List.iter (unwrap_lone_p soup) [ "dd"; "li"; "th"; "td" ] in
	(* Personally I think this is bug in Asciidoctor, as this is the
	wrong element *)
	(* Personally I think this is bug in Asciidoctor, as this is the wrong element *)
	let () = Soup.select "span.line-through" soup |> Soup.iter mk_del in
	(* `markdown` class needed to get borders and padding *)
	let () = Soup.select "table" soup |> Soup.iter markdown_wrapper in
	(* Personally I think this is another bug in Asciidoctor, as you
	can’t make multiple `<dd>`s *)
	(* Personally I think this is another bug in Asciidoctor, as you can’t make multiple
		 `<dd>`s *)
	let () =
		Soup.select "dl > dd > div.ulist:only-child > ul:only-child" soup
		|> Soup.iter unwrap_definition_list_items
	in
	(* Admonitions need a lot of love on various platforms *)
	let () = Soup.select ".admonitionblock" soup |> Soup.iter aside_n_color_admonitions in
	(* Run source blocks through `pygmentize` to emulate the Python Markdown toolchain *)
	let () =
		Soup.select ".admonitionblock" soup
		|> Soup.iter aside_n_color_admonitions
	in
	(* Run source blocks through `pygmentize` to emulate the Python
	Markdown toolchain *)
	let () =
		Soup.select "pre.highlight code[data-lang]" soup
		|> Soup.iter pygmentize_element
		Soup.select "pre.highlight code[data-lang]" soup |> Soup.iter pygmentize_element
	in
	soup |> Soup.to_string |> Soup.write_channel stdout