Early LaTeX support

lib/block.ml

@@ -65,12 +65,24 @@ module Raw = struct
         header : string;
         contents : string list;
         label_cmt : string option;
+        latex_arguments : string option;
         legacy_labels : string;
         errors : Output.t list;
       }
 
-  let make ~loc ~section ~header ~contents ~label_cmt ~legacy_labels ~errors =
-    Any { loc; section; header; contents; label_cmt; legacy_labels; errors }
+  let make ~loc ~section ~header ~contents ~label_cmt ~legacy_labels
+      ~latex_arguments ~errors =
+    Any
+      {
+        loc;
+        section;
+        header;
+        contents;
+        label_cmt;
+        legacy_labels;
+        latex_arguments;
+        errors;
+      }
 
   let make_include ~loc ~section ~labels = Include { loc; section; labels }
 end
@@ -108,6 +120,7 @@ type t = {
   dir : string option;
   labels : Label.t list;
   legacy_labels : bool;
+  latex_arguments : string option;
   contents : string list;
   skip : bool;
   version_enabled : bool;
@@ -159,20 +172,28 @@ let rec error_padding = function
       let xs = error_padding xs in
       x :: xs
 
-let pp_errors ppf t =
+let pp_errors ?syntax ppf t =
   match t.value with
   | OCaml { errors = []; _ } -> ()
-  | OCaml { errors; _ } ->
+  | OCaml { errors; _ } -> (
       let errors = error_padding errors in
-      Fmt.pf ppf "```mdx-error\n%a\n```\n"
-        Fmt.(list ~sep:(any "\n") Output.pp)
-        errors
+      match syntax with
+      | Some Syntax.Latex ->
+          Fmt.pf ppf "\\begin{mdx-error}\n%a\n\\end{mdx-error}\n"
+            Fmt.(list ~sep:(any "\n") Output.pp)
+            errors
+      | _ ->
+          Fmt.pf ppf "```mdx-error\n%a\n```\n"
+            Fmt.(list ~sep:(any "\n") Output.pp)
+            errors)
   | _ -> ()
 
-let pp_footer ?syntax ppf _ =
+let pp_footer ?syntax ppf t =
   match syntax with
   | Some Syntax.Mli | Some Syntax.Mld -> Fmt.string ppf "]}"
   | Some Syntax.Cram -> Fmt.string ppf "\n"
+  | Some Syntax.Latex ->
+      Fmt.pf ppf "\\end{%a}\n" Fmt.(option Header.pp) (header t)
   | Some Syntax.Markdown | None -> Fmt.string ppf "```\n"
 
 let pp_legacy_labels ppf = function
@@ -192,6 +213,10 @@ let pp_labels ?syntax ppf labels =
       | [ Non_det (Some Nd_command) ] ->
           Fmt.pf ppf "<-- non-deterministic command\n"
       | _ -> failwith "cannot happen: checked during parsing")
+  | Some Syntax.Latex -> (
+      match labels with
+      | [] -> ()
+      | l -> Fmt.pf ppf "%% $MDX %a\n" Fmt.(list ~sep:(any ",") Label.pp) l)
   | Some Syntax.Markdown | None -> (
       match labels with
       | [] -> ()
@@ -217,6 +242,17 @@ let pp_header ?syntax ppf t =
       in
       Fmt.pf ppf "{%a%a[" pp_lang_header lang_headers pp_labels other_labels
   | Some Syntax.Cram -> pp_labels ?syntax ppf t.labels
+  | Some Syntax.Latex -> (
+      (* LaTeX does not have any legacy labels *)
+      match t.latex_arguments with
+      | None ->
+          Fmt.pf ppf "%a\\begin{%a}" (pp_labels ?syntax) t.labels
+            Fmt.(option Header.pp)
+            (header t)
+      | Some args ->
+          Fmt.pf ppf "%a\\begin{%a}%s" (pp_labels ?syntax) t.labels
+            Fmt.(option Header.pp)
+            (header t) args)
   | Some Syntax.Markdown | None ->
       if t.legacy_labels then
         Fmt.pf ppf "```%a%a"
@@ -231,7 +267,7 @@ let pp ?syntax ppf b =
   pp_header ?syntax ppf b;
   pp_contents ?syntax ppf b;
   pp_footer ?syntax ppf b;
-  pp_errors ppf b
+  pp_errors ?syntax ppf b
 
 let directory t = t.dir
 let file t = match t.value with Include t -> Some t.file_included | _ -> None
@@ -402,7 +438,8 @@ let infer_block ~loc ~config ~header ~contents ~errors =
           let+ () = check_no_errors ~loc errors in
           Raw { header })
 
-let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors =
+let mk ~loc ~section ~labels ~legacy_labels ~latex_arguments ~header ~contents
+    ~errors =
   let block_kind =
     get_label (function Block_kind x -> Some x | _ -> None) labels
   in
@@ -422,6 +459,7 @@ let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors =
     dir = config.dir;
     labels;
     legacy_labels;
+    latex_arguments;
     contents;
     skip = config.skip;
     version_enabled;
@@ -434,8 +472,8 @@ let mk_include ~loc ~section ~labels =
   match get_label (function File x -> Some x | _ -> None) labels with
   | Some file_inc ->
       let header = Header.infer_from_file file_inc in
-      mk ~loc ~section ~labels ~legacy_labels:false ~header ~contents:[]
-        ~errors:[]
+      mk ~loc ~section ~latex_arguments:None ~labels ~legacy_labels:false
+        ~header ~contents:[] ~errors:[]
   | None -> label_required ~loc ~label:"file" ~kind:"include"
 
 let parse_labels ~label_cmt ~legacy_labels =
@@ -453,14 +491,24 @@ let from_raw raw =
   | Raw.Include { loc; section; labels } ->
       let* labels = locate_errors ~loc (Label.of_string labels) in
       Util.Result.to_error_list @@ mk_include ~loc ~section ~labels
-  | Raw.Any { loc; section; header; contents; label_cmt; legacy_labels; errors }
-    ->
+  | Raw.Any
+      {
+        loc;
+        section;
+        header;
+        contents;
+        label_cmt;
+        latex_arguments;
+        legacy_labels;
+        errors;
+      } ->
       let header = Header.of_string header in
       let* labels, legacy_labels =
         locate_errors ~loc (parse_labels ~label_cmt ~legacy_labels)
       in
       Util.Result.to_error_list
-      @@ mk ~loc ~section ~header ~contents ~labels ~legacy_labels ~errors
+      @@ mk ~loc ~section ~header ~contents ~labels ~latex_arguments
+           ~legacy_labels ~errors
 
 let is_active ?section:s t =
   let active =

lib/block.mli

@@ -84,6 +84,7 @@ module Raw : sig
     contents:string list ->
     label_cmt:string option ->
     legacy_labels:string ->
+    latex_arguments:string option ->
     errors:Output.t list ->
     t
 
@@ -97,6 +98,7 @@ type t = {
   dir : string option;
   labels : Label.t list;
   legacy_labels : bool;
+  latex_arguments:string option;
   contents : string list;
   skip : bool;
   version_enabled : bool;
@@ -112,6 +114,7 @@ val mk :
   section:section option ->
   labels:Label.t list ->
   legacy_labels:bool ->
+  latex_arguments:string option ->
   header:Header.t option ->
   contents:string list ->
   errors:Output.t list ->

lib/dune

@@ -21,3 +21,5 @@
 (ocamllex lexer_cram)
 
 (ocamllex lexer_top)
+
+(ocamllex lexer_tex)

lib/lexer_mdx.mll

@@ -40,9 +40,10 @@ rule text section = parse
         in
         let end_ = Lexing.lexeme_start_p lexbuf in
         let loc = loc ~start ~end_ in
+        let latex_arguments = None in
         let block =
           Block.Raw.make ~loc ~section ~header ~contents ~label_cmt
-            ~legacy_labels ~errors
+            ~legacy_labels ~latex_arguments ~errors
         in
         `Block block :: text section lexbuf }
   | "<!--" ws* "$MDX" ws* ([^' ' '\n']* as labels) ws* "-->" ws* eol
@@ -85,7 +86,7 @@ and cram_text section = parse
         let loc = loc ~start ~end_ in
         let block =
             Block.Raw.make ~loc ~section ~header ~contents ~label_cmt
-              ~legacy_labels ~errors:[]
+              ~legacy_labels ~latex_arguments:None ~errors:[]
         in
         `Block block
         :: (if requires_empty_line then `Text "\n" :: rest else rest) }
@@ -101,7 +102,7 @@ and cram_text section = parse
         let rest = cram_text section lexbuf in
         let block =
             Block.Raw.make ~loc ~section ~header ~contents ~label_cmt
-              ~legacy_labels ~errors:[]
+              ~legacy_labels ~latex_arguments:None ~errors:[]
         in
         `Block block
         :: (if requires_empty_line then `Text "\n" :: rest else rest) }

lib/lexer_tex.mli

@@ -0,0 +1,4 @@
+type token =
+  [ `Block of Block.Raw.t | `Section of int * string | `Text of string ]
+
+val latex_token : Lexing.lexbuf -> (token list, [ `Msg of string ]) result

lib/lexer_tex.mll

@@ -0,0 +1,80 @@
+{
+open Astring
+
+type token = [ `Block of Block.Raw.t | `Section of int * string | `Text of string ]
+
+let newline lexbuf = Lexing.new_line lexbuf
+
+let loc ~start ~end_ =
+  Location.{loc_start = start; loc_end = end_; loc_ghost = false}
+}
+
+let eol = '\n' | eof
+let ws = ' ' | '\t'
+
+rule text section = parse
+  | eof { [] }
+  | ("#"+ as n) " " ([^'\n']* as str) eol
+      { let section = (String.length n, str) in
+        newline lexbuf;
+        `Section section :: text (Some section) lexbuf }
+  | ( "%" ws* "$MDX" ws* ([^' ' '\n']* as label_cmt) ws* eol? )?
+    "\\begin{" ([^' ' '\n']* as header) "}" ("[" [^'\n']* "]" as latex_arguments)? eol
+      { let start = Lexing.lexeme_start_p lexbuf in
+        newline lexbuf;
+        (match label_cmt with
+         | Some _ -> newline lexbuf
+         | None -> ());
+        let contents = block lexbuf in
+        (* we assume the multi-line block starts with an ""
+           TODO: tie this to the regex match *)
+        let contents = "" :: contents in
+        let errors =
+          match error_block lexbuf with
+          | exception _ -> []
+          | e ->
+            List.map (fun x ->
+                match String.trim x with
+                | "..." -> `Ellipsis
+                | _ -> `Output x) e
+        in
+        let end_ = Lexing.lexeme_start_p lexbuf in
+        let loc = loc ~start ~end_ in
+        let block =
+          Block.Raw.make ~loc ~section ~header ~contents ~label_cmt
+            ~legacy_labels:"" ~latex_arguments ~errors
+        in
+        `Block block :: text section lexbuf }
+  | "%" ws* "$MDX" ws* ([^' ' '\n']* as labels) ws* eol
+      { let loc = Location.curr lexbuf in
+        newline lexbuf;
+        let block = Block.Raw.make_include ~loc ~section ~labels in
+        `Block block :: text section lexbuf }
+  | ([^'\n']* as str) eol
+      { newline lexbuf;
+        let str = String.append str "\n" in
+        `Text str :: text section lexbuf }
+
+and block = parse
+  | eof | ws* as end_pad "\\end{" ([^' ' '\n']*) "}" ws* eol
+    { newline lexbuf;
+      [end_pad] }
+  | ([^'\n']* as str) eol
+  { newline lexbuf;
+      str :: block lexbuf }
+
+and error_block = parse
+  | "\\begin{mdx-error}" ws* eol { newline lexbuf; block lexbuf }
+
+{
+  let latex_token lexbuf =
+    try Ok (text None lexbuf)
+    with
+    | exn ->
+      let loc = Location.curr lexbuf in
+      let msg =
+        Format.asprintf "%a: %s" Stable_printer.Location.pp loc
+          (Printexc.to_string exn)
+      in
+      Util.Result.errorf "%s" msg
+}

lib/mdx.ml

@@ -17,6 +17,7 @@
 let src = Logs.Src.create "ocaml-mdx"
 
 module Lexer_mdx = Lexer_mdx
+module Lexer_tex = Lexer_tex
 module Log = (val Logs.src_log src : Logs.LOG)
 module Output = Output
 module Cram = Cram
@@ -72,6 +73,8 @@ let parse_lexbuf syntax Misc.{ string; lexbuf } =
   match syntax with
   | Syntax.Mli -> Mli_parser.parse_mli string
   | Syntax.Mld -> Mli_parser.parse_mld string
+  | Latex ->
+      Util.Result.to_error_list @@ Lexer_tex.latex_token lexbuf >>= parse
   | Markdown ->
       Util.Result.to_error_list @@ Lexer_mdx.markdown_token lexbuf >>= parse
   | Cram -> Util.Result.to_error_list @@ Lexer_mdx.cram_token lexbuf >>= parse
@@ -82,7 +85,7 @@ let of_string syntax s =
   match syntax with
   | Syntax.Mli -> Mli_parser.parse_mli s
   | Syntax.Mld -> Mli_parser.parse_mld s
-  | Syntax.Markdown | Syntax.Cram ->
+  | Syntax.Latex | Syntax.Markdown | Syntax.Cram ->
       Misc.{ lexbuf = Lexing.from_string s; string = s } |> parse_lexbuf syntax
 
 let dump_line ppf (l : line) =

lib/mdx.mli

@@ -24,6 +24,7 @@
    {{!Output}outputs}.  *)
 
 module Lexer_mdx = Lexer_mdx
+module Lexer_tex = Lexer_tex
 module Output = Output
 module Cram = Cram
 module Deprecated = Deprecated

lib/mli_parser.ml

@@ -148,7 +148,7 @@ let make_block code_block file_contents =
       in
       let contents = slice code_block.content |> String.split_on_char '\n' in
       Block.mk ~loc:code_block.code_block ~section:None ~labels ~header
-        ~contents ~legacy_labels:false ~errors:[]
+        ~contents ~legacy_labels:false ~latex_arguments:None ~errors:[]
 
 (* Given the locations of the code blocks within [file_contents], then slice it up into
    [Text] and [Block] parts by using the starts and ends of those blocks as

lib/syntax.ml

@@ -1,7 +1,8 @@
-type t = Markdown | Cram | Mli | Mld
+type t = Markdown | Latex | Cram | Mli | Mld
 
 let pp fs = function
   | Markdown -> Fmt.string fs "markdown"
+  | Latex -> Fmt.string fs "latex"
   | Cram -> Fmt.string fs "cram"
   | Mli -> Fmt.string fs "mli"
   | Mld -> Fmt.string fs "mld"
@@ -12,12 +13,14 @@ let infer ~file =
   match Filename.extension file with
   | ".t" -> Some Cram
   | ".md" -> Some Markdown
+  | ".tex" -> Some Latex
   | ".mli" -> Some Mli
   | ".mld" -> Some Mld
   | _ -> None
 
 let of_string = function
   | "markdown" | "normal" -> Some Markdown
+  | "latex" -> Some Latex
   | "cram" -> Some Cram
   | "mli" -> Some Mli
   | "mld" -> Some Mld

lib/syntax.mli

@@ -1,4 +1,4 @@
-type t = Markdown | Cram | Mli | Mld
+type t = Markdown | Latex | Cram | Mli | Mld
 
 val pp : Format.formatter -> t -> unit
 val equal : t -> t -> bool

test/bin/gen_rule_helpers/gen_rule_helpers.ml

@@ -39,7 +39,7 @@ let get_files dir =
 let cwd_options_file = "test-case.opts"
 
 let cwd_test_files =
-  [ "test-case.md"; "test-case.t"; "test-case.mli"; "test-case.mld" ]
+  [ "test-case.md"; "test-case.t"; "test-case.mli"; "test-case.mld"; "test-case.tex" ]
 
 let cwd_enabled_if_file = "test-case.enabled-if"
 

test/bin/mdx-test/expect-latex/.ocamlformat

@@ -0,0 +1 @@
+disable=true