fix: outline keeps titles; full MD parse stays on Angstrom

.github/workflows/ci.yml

@@ -24,7 +24,6 @@ jobs:
         uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          dune-cache: true
 
       - name: Install dependencies
         run: opam install . --deps-only --with-doc --with-test

.github/workflows/format.yml

@@ -16,7 +16,6 @@ jobs:
         uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: 4.14.x
-          dune-cache: true
 
       - name: Install formatter
         run: opam install ocamlformat.0.26.2 dune

bench/dune

@@ -6,6 +6,10 @@
  (name time_parse)
  (libraries unix mldoc))
 
+(executable
+ (name time_graph)
+ (libraries unix mldoc))
+
 (alias
  (name bench)
- (deps bench.exe time_parse.exe))
+ (deps bench.exe time_parse.exe time_graph.exe))

bench/time_graph.ml

@@ -0,0 +1,142 @@
+(** Bench parsing a Logseq Markdown graph directory (many small files). *)
+open Mldoc.Parser
+
+open Mldoc.Conf
+
+let rec md_files acc dir =
+  match Unix.opendir dir with
+  | exception Unix.Unix_error (Unix.ENOENT, _, _) -> acc
+  | dh ->
+    let rec loop acc =
+      match Unix.readdir dh with
+      | exception End_of_file ->
+        Unix.closedir dh;
+        acc
+      | "."
+      | ".." ->
+        loop acc
+      | name ->
+        let path = Filename.concat dir name in
+        let acc =
+          match Unix.stat path with
+          | { st_kind = S_DIR; _ } -> md_files acc path
+          | { st_kind = S_REG; _ } when Filename.check_suffix name ".md" ->
+            path :: acc
+          | _ -> acc
+        in
+        loop acc
+    in
+    loop acc
+
+let load_all dir =
+  let files = md_files [] dir in
+  let files = List.sort String.compare files in
+  List.map (fun path -> (path, load_file path)) files
+
+let base =
+  { toc = true
+  ; parse_outline_only = false
+  ; heading_number = true
+  ; keep_line_break = false
+  ; format = Markdown
+  ; heading_to_list = false
+  ; exporting_keep_properties = false
+  ; inline_type_with_pos = false
+  ; inline_skip_macro = false
+  ; export_md_indent_style = Dashes
+  ; export_md_remove_options = []
+  ; hiccup_in_block = true
+  ; enable_drawers = true
+  ; parse_marker = true
+  ; parse_priority = true
+  }
+
+let avg ~n f =
+  ignore (f ());
+  let t0 = Unix.gettimeofday () in
+  for _ = 1 to n do
+    ignore (f ())
+  done;
+  let t1 = Unix.gettimeofday () in
+  (t1 -. t0) /. float n
+
+let property_values contents =
+  let acc = ref [] in
+  List.iter
+    (fun content ->
+      String.split_on_char '\n' content
+      |> List.iter (fun line ->
+             match String.index_opt line ':' with
+             | Some i when i + 1 < String.length line && line.[i + 1] = ':' ->
+               let v =
+                 String.trim
+                   (String.sub line (i + 2) (String.length line - i - 2))
+               in
+               if v <> "" then acc := v :: !acc
+             | _ -> ()))
+    contents;
+  List.rev !acc
+
+let () =
+  let dir =
+    if Array.length Sys.argv > 1 then
+      Sys.argv.(1)
+    else
+      "/tmp/ls-movies-4k"
+  in
+  let pages = Filename.concat dir "pages" in
+  let journals = Filename.concat dir "journals" in
+  let loaded =
+    if Sys.file_exists pages then
+      load_all pages
+      @
+      if Sys.file_exists journals then
+        load_all journals
+      else
+        []
+    else
+      load_all dir
+  in
+  let n_files = List.length loaded in
+  let contents = List.map snd loaded in
+  let bytes = List.fold_left (fun s c -> s + String.length c) 0 contents in
+  let concat = String.concat "\n" contents in
+  let values = property_values contents in
+  let n = 3 in
+  Printf.printf "graph=%s files=%d bytes=%d avg_file=%.0f props=%d\n" dir
+    n_files bytes
+    (if n_files = 0 then
+       0.
+     else
+       float bytes /. float n_files)
+    (List.length values);
+  let parse_each config docs =
+    List.iter (fun c -> ignore (parse config c)) docs
+  in
+  let full = avg ~n (fun () -> parse_each base contents) in
+  let outline =
+    avg ~n (fun () ->
+        parse_each { base with parse_outline_only = true } contents)
+  in
+  let concat_full = avg ~n (fun () -> parse base concat) in
+  let concat_outline =
+    avg ~n (fun () -> parse { base with parse_outline_only = true } concat)
+  in
+  let refs =
+    avg ~n (fun () ->
+        List.iter
+          (fun v -> ignore (Mldoc.Property.property_references base v))
+          values)
+  in
+  Printf.printf "iterations=%d (avg seconds)\n" n;
+  Printf.printf "per-file full:              %.4f  (%.1f files/s)\n" full
+    (float n_files /. full);
+  Printf.printf "per-file outline_only:      %.4f  (%.1fx vs full)\n" outline
+    (full /. outline);
+  Printf.printf "concatenated full:          %.4f\n" concat_full;
+  Printf.printf "concatenated outline_only:  %.4f  (%.1fx vs concat full)\n"
+    concat_outline
+    (concat_full /. concat_outline);
+  Printf.printf "property_references only:   %.4f  (%.0f%% of per-file full)\n"
+    refs
+    (100. *. refs /. full)

lib/export/conf.ml

@@ -42,9 +42,10 @@ type t =
     (* hiccup: bool; *)
     toc : bool [@default false]
   ; parse_outline_only : bool [@default false]
-        (** Fast path (esp. Markdown): block structure + properties, and in
-            content only node refs ([[page]] / ((block))), tags (#tag).
-            Skips emphasis/code/timestamps and full Inline.parse. *)
+        (** Outline: headings keep title (Plain + [[page]] / ((block)) / #tag),
+            plus status/priority, properties, SCHEDULED/DEADLINE, and
+            front matter (first block only). Skips mixed markdown used for
+            block rendering (emphasis, code, autolinks). *)
   ; heading_number : bool [@default false]
   ; keep_line_break : bool (* FIXME: is this option deprecated? *)
   ; format : format

lib/mldoc_parser.ml

@@ -146,24 +146,35 @@ let build_md_outline_parsers config =
 let parse config input =
   let outline_only = Conf.(config.parse_outline_only) in
   let md = Conf.is_markdown config in
-  (* Markdown: line-oriented path for outline and full. *)
-  if md then
+  (* Outline markdown uses the line scanner. Full markdown stays on Angstrom so
+     mixed constructs (org blocks, drawers, definition lists, quotes) match
+     published mldoc / Logseq graph-parser. *)
+  if md && outline_only then
     let ast = Md_outline.parse config input in
-    if (not outline_only) || String.contains input '\\' then
+    if String.contains input '\\' then
       List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast
     else
       ast
   else
     let parsers =
-      match outline_only with
-      | true -> build_choice_parsers org_outline_parsers config
-      | false -> build_choice_parsers org_full_parsers config
+      if md then
+        build_choice_parsers md_full_parsers config
+      else if outline_only then
+        build_choice_parsers org_outline_parsers config
+      else
+        build_choice_parsers org_full_parsers config
     in
     match parse_string ~consume:All parsers input with
     | Ok result ->
       let ast = Paragraph.concat_paragraph_lines config result in
       let ast =
-        if outline_only then
+        if md then
+          List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast
+        else
+          ast
+      in
+      let ast =
+        if (not md) && outline_only then
           Prelude.remove
             (fun (t, _) ->
               match t with

lib/syntax/heading0.ml

@@ -147,12 +147,14 @@ struct
     explode (String.trim s) |> List.map map_char |> String.concat ""
 
   let outline_title config title =
-    if Outline_inline.may_have_outline_markup config title then
+    if title = "" then
+      []
+    else if Outline_inline.may_have_outline_markup config title then
       match parse_string ~consume:All (Outline_inline.parse config) title with
       | Ok title -> title
-      | Error _ -> []
+      | Error _ -> Type_op.inline_list_with_none_pos [ Inline.Plain title ]
     else
-      []
+      Type_op.inline_list_with_none_pos [ Inline.Plain title ]
 
   let make_outline_heading ~level ~unordered ~size ~marker ~priority ~title =
     Heading

lib/syntax/inline.ml

@@ -1530,6 +1530,14 @@ let try_fast_md_inline s =
           true
         | _ -> false
       in
+      let is_tag_boundary = function
+        | ' '
+        | '\t'
+        | '\n'
+        | '\r' ->
+          true
+        | _ -> false
+      in
       let tag_trail = function
         | ','
         | ';'
@@ -1586,18 +1594,34 @@ let try_fast_md_inline s =
       in
       while !i < n && not !complex do
         match s.[!i] with
-        | '\n' ->
-          flush_plain !i;
-          acc := Break_Line :: !acc;
-          incr i;
-          plain_start := !i
+        | '\n'
         | '\r' ->
-          flush_plain !i;
-          incr i;
-          if !i < n && s.[!i] = '\n' then incr i;
-          acc := Break_Line :: !acc;
+          (* Two trailing spaces before newline = CommonMark hard break. *)
+          let rec count_spaces k =
+            if k > !plain_start && s.[k - 1] = ' ' then
+              count_spaces (k - 1)
+            else
+              k
+          in
+          let sp = count_spaces !i in
+          if !i - sp >= 2 then (
+            flush_plain sp;
+            acc := Hard_Break_Line :: !acc
+          ) else (
+            flush_plain !i;
+            acc := Break_Line :: !acc
+          );
+          if s.[!i] = '\r' then (
+            incr i;
+            if !i < n && s.[!i] = '\n' then incr i
+          ) else
+            incr i;
           plain_start := !i
-        | '#' when !i + 1 < n && (not (is_ws s.[!i + 1])) && s.[!i + 1] <> '#'
+        | '#'
+          when !i + 1 < n
+               && (not (is_ws s.[!i + 1]))
+               && s.[!i + 1] <> '#'
+               && (!i = 0 || is_tag_boundary s.[!i - 1] || tag_trail s.[!i - 1])
           ->
           flush_plain !i;
           let start = !i + 1 in