WIP: Attempt to fix the "box model" of code blocks

CHANGES.md

@@ -18,6 +18,8 @@
 - Fix bug in our CSS hitting verbatim blocks in tags (@jonludlam, #1312)
 - Fix poor behaviour when running odoc_driver with unknown or missing packages
   (@jonludlam, #1311)
+- Clean up how leading indentation is trimmed in code blocks
+  (@noahtheduke, #1318)
 
 # 3.0.0~beta1
 

src/parser/lexer.mll

@@ -76,9 +76,12 @@ let trim_trailing_blank_lines : string -> string = fun s ->
     in
     String.sub s 0 trim_from
 
-(** Returns [None] for an empty, [Some ident] for an indented line. *)
-let trim_leading_whitespace : first_line_offset:int -> string -> string =
- fun ~first_line_offset s ->
+let trim_leading_whitespace : string -> string =
+ fun s ->
+  let trim_left line n =
+    (String.sub line n (String.length line - n))
+  in
+   (** Returns [None] for an empty, [Some ident] for an indented line. *)
   let count_leading_whitespace line =
     let rec count_leading_whitespace' index len =
       if index = len then None
@@ -94,46 +97,59 @@ let trim_leading_whitespace : first_line_offset:int -> string -> string =
     count_leading_whitespace' 0 len
   in
 
-  let lines = Astring.String.cuts ~sep:"\n" s in
+  let first, remaining =
+    match Astring.String.cuts ~sep:"\n" s with
+    | [] -> None, []
+    | first_line :: tl ->
+        (match count_leading_whitespace first_line with 
+        | None -> Some first_line, tl
+        | Some n -> Some (trim_left first_line n), tl)
+  in
 
-  let least_amount_of_whitespace =
+  let least_amount_of_whitespace_fn =
     List.fold_left (fun least_so_far line ->
       match (count_leading_whitespace line, least_so_far) with
       | (Some _ as n', None) -> n'
       | (Some n as n', Some least) when n < least -> n'
       | _ -> least_so_far)
   in
 
-  let first_line_max_drop, least_amount_of_whitespace =
-    match lines with
-    | [] -> 0, None
+  let least_amount_of_whitespace =
+    match remaining with
+    | [] -> None
     | first_line :: tl ->
       begin match count_leading_whitespace first_line with
         | Some n ->
-          n, least_amount_of_whitespace (Some (first_line_offset + n)) tl
+          least_amount_of_whitespace_fn (Some n) tl
         | None ->
-          0, least_amount_of_whitespace None tl
+          least_amount_of_whitespace_fn None tl
       end
   in
 
   match least_amount_of_whitespace with
   | None ->
-    s
+      (match count_leading_whitespace s with
+      | None -> s
+      | Some n -> trim_left s n)
   | Some least_amount_of_whitespace ->
     let drop n line =
       (* Since blank lines were ignored when calculating
          [least_amount_of_whitespace], their length might be less than the
          amount. *)
-      if String.length line < n then line
-      else String.sub line n (String.length line - n)
+      if String.length line < n then ""
+      else trim_left line n
     in
     let lines =
-      match lines with
+      match remaining with
       | [] -> []
       | first_line :: tl ->
-        drop (min first_line_max_drop least_amount_of_whitespace) first_line
+        (drop least_amount_of_whitespace first_line)
         :: List.map (drop least_amount_of_whitespace) tl
     in
+    let lines = match first with
+    | None -> lines
+    | Some l -> l :: lines
+    in
     String.concat "\n" lines
 
 type input = {
@@ -246,12 +262,9 @@ let emit_verbatim input start_offset buffer =
    and trailing empty lines removed. *)
 let emit_code_block ~start_offset content_offset input metadata delim terminator c has_results =
   let c = Buffer.contents c |> trim_trailing_blank_lines in
-  let content_location = input.offset_to_location content_offset in
   let c =
     with_location_adjustments
-      (fun _ _location c ->
-         let first_line_offset = content_location.column in
-         trim_leading_whitespace ~first_line_offset c)
+      (fun _ _location c -> trim_leading_whitespace c)
       input c
   in
   let c = trim_leading_blank_lines c in

src/parser/test/test.ml

@@ -2483,7 +2483,7 @@ let%expect_test _ =
   end in
   ()
 
-let%expect_test _ =
+let%expect_test "code blocks" =
   let module Code_block = struct
     let basic =
       test "{[foo]}";
@@ -2593,7 +2593,7 @@ let%expect_test _ =
       [%expect
         {|
         ((output
-          (((f.ml (1 0) (2 6)) (code_block ((f.ml (1 2) (2 4))  "  foo\
+          (((f.ml (1 0) (2 6)) (code_block ((f.ml (1 2) (2 4))  "foo\
                                                                \nbar")))))
          (warnings ())) |}]
 
@@ -2603,7 +2603,7 @@ let%expect_test _ =
         {|
         ((output
           (((f.ml (1 0) (2 11)) (code_block ((f.ml (1 2) (2 9))  "foo\
-                                                                \n   bar")))))
+                                                                \nbar")))))
          (warnings ())) |}]
 
     let leading_whitespace_with_empty_line =
@@ -2622,7 +2622,7 @@ let%expect_test _ =
         {|
         ((output
           (((f.ml (1 0) (3 7)) (code_block ((f.ml (1 2) (3 5))  "foo\
-                                                               \n \
+                                                               \n\
                                                                \nbar")))))
          (warnings ())) |}]
 
@@ -3166,6 +3166,229 @@ let%expect_test _ =
               (code_block (((f.ml (1 7) (1 12)) ocaml) ())
                ((f.ml (1 13) (1 18)) "foo ") ()))))
            (warnings ())) |}]
+
+    let stdlib_float =
+      test "
+      For example, consider the following program:
+  {[let size = 100_000_000
+  let a = Float.Array.make size 1.
+  let update a f () =
+     Float.Array.iteri (fun i x -> Float.Array.set a i (f x)) a
+  let d1 = Domain.spawn (update a (fun x -> x +. 1.))
+  let d2 = Domain.spawn (update a (fun x ->  2. *. x +. 1.))
+  let () = Domain.join d1; Domain.join d2
+  ]}
+      ";
+      [%expect {|
+        ((output
+          (((f.ml (2 6) (2 50))
+            (paragraph
+             (((f.ml (2 6) (2 9)) (word For)) ((f.ml (2 9) (2 10)) space)
+              ((f.ml (2 10) (2 18)) (word example,)) ((f.ml (2 18) (2 19)) space)
+              ((f.ml (2 19) (2 27)) (word consider)) ((f.ml (2 27) (2 28)) space)
+              ((f.ml (2 28) (2 31)) (word the)) ((f.ml (2 31) (2 32)) space)
+              ((f.ml (2 32) (2 41)) (word following)) ((f.ml (2 41) (2 42)) space)
+              ((f.ml (2 42) (2 50)) (word program:)))))
+           ((f.ml (3 2) (10 4))
+            (code_block
+             ((f.ml (3 4) (10 2))
+               "let size = 100_000_000\
+              \nlet a = Float.Array.make size 1.\
+              \nlet update a f () =\
+              \n   Float.Array.iteri (fun i x -> Float.Array.set a i (f x)) a\
+              \nlet d1 = Domain.spawn (update a (fun x -> x +. 1.))\
+              \nlet d2 = Domain.spawn (update a (fun x ->  2. *. x +. 1.))\
+              \nlet () = Domain.join d1; Domain.join d2")))))
+         (warnings ())) |}]
+
+    let stdlib_condition =
+      test "
+   {[
+     Mutex.lock m;
+     while not P do
+       Mutex.unlock m; Mutex.lock m
+     done;
+     <update the data structure>;
+     Mutex.unlock m
+   ]}
+      ";
+      [%expect {|
+        ((output
+          (((f.ml (2 3) (9 5))
+            (code_block
+             ((f.ml (2 5) (9 3))
+               "Mutex.lock m;\
+              \nwhile not P do\
+              \n  Mutex.unlock m; Mutex.lock m\
+              \ndone;\
+              \n<update the data structure>;\
+              \nMutex.unlock m")))))
+         (warnings ())) |}]
+
+    let stdlib_bytes_1 =
+      test "
+   {[
+let string_init len f : string =
+  let s = Bytes.create len in
+  for i = 0 to len - 1 do Bytes.set s i (f i) done;
+  Bytes.unsafe_to_string s
+   ]}
+      ";
+      [%expect {|
+        ((output
+          (((f.ml (2 3) (7 5))
+            (code_block
+             ((f.ml (2 5) (7 3))
+               "let string_init len f : string =\
+              \n  let s = Bytes.create len in\
+              \n  for i = 0 to len - 1 do Bytes.set s i (f i) done;\
+              \n  Bytes.unsafe_to_string s")))))
+         (warnings ())) |}]
+
+    let stdlib_bytes_2 =
+      test "
+    For example, consider the following program:
+{[let size = 100_000_000
+let b = Bytes.make size  ' '
+let update b f ()  =
+  Bytes.iteri (fun i x -> Bytes.set b i (Char.chr (f (Char.code x)))) b
+let d1 = Domain.spawn (update b (fun x -> x + 1))
+]}
+      ";
+      [%expect {|
+        ((output
+          (((f.ml (2 4) (2 48))
+            (paragraph
+             (((f.ml (2 4) (2 7)) (word For)) ((f.ml (2 7) (2 8)) space)
+              ((f.ml (2 8) (2 16)) (word example,)) ((f.ml (2 16) (2 17)) space)
+              ((f.ml (2 17) (2 25)) (word consider)) ((f.ml (2 25) (2 26)) space)
+              ((f.ml (2 26) (2 29)) (word the)) ((f.ml (2 29) (2 30)) space)
+              ((f.ml (2 30) (2 39)) (word following)) ((f.ml (2 39) (2 40)) space)
+              ((f.ml (2 40) (2 48)) (word program:)))))
+           ((f.ml (3 0) (8 2))
+            (code_block
+             ((f.ml (3 2) (8 0))
+               "let size = 100_000_000\
+              \nlet b = Bytes.make size  ' '\
+              \nlet update b f ()  =\
+              \n  Bytes.iteri (fun i x -> Bytes.set b i (Char.chr (f (Char.code x)))) b\
+              \nlet d1 = Domain.spawn (update b (fun x -> x + 1))")))))
+         (warnings ())) |}]
+
+    let stdlib_arg =
+      test "
+   arguments from the command line to the program. For example:
+
+{[
+     let usage_msg = ...
+     let verbose = ref false
+     let input_files = ref []
+     let output_file = ref \"\"
+]}
+      ";
+      [%expect {|
+        ((output
+          (((f.ml (2 3) (2 63))
+            (paragraph
+             (((f.ml (2 3) (2 12)) (word arguments)) ((f.ml (2 12) (2 13)) space)
+              ((f.ml (2 13) (2 17)) (word from)) ((f.ml (2 17) (2 18)) space)
+              ((f.ml (2 18) (2 21)) (word the)) ((f.ml (2 21) (2 22)) space)
+              ((f.ml (2 22) (2 29)) (word command)) ((f.ml (2 29) (2 30)) space)
+              ((f.ml (2 30) (2 34)) (word line)) ((f.ml (2 34) (2 35)) space)
+              ((f.ml (2 35) (2 37)) (word to)) ((f.ml (2 37) (2 38)) space)
+              ((f.ml (2 38) (2 41)) (word the)) ((f.ml (2 41) (2 42)) space)
+              ((f.ml (2 42) (2 50)) (word program.)) ((f.ml (2 50) (2 51)) space)
+              ((f.ml (2 51) (2 54)) (word For)) ((f.ml (2 54) (2 55)) space)
+              ((f.ml (2 55) (2 63)) (word example:)))))
+           ((f.ml (4 0) (9 2))
+            (code_block
+             ((f.ml (4 2) (9 0))
+               "let usage_msg = ...\
+              \nlet verbose = ref false\
+              \nlet input_files = ref []\
+              \nlet output_file = ref \"\"")))))
+         (warnings ())) |}]
+
+     let stdlib_nativeint =
+       test "
+    {[
+     let zero: nativeint = 0n
+     let one: nativeint = 1n
+     let m_one: nativeint = -1n
+    ]}
+       ";
+       [%expect {|
+         ((output
+           (((f.ml (2 4) (6 6))
+             (code_block
+              ((f.ml (2 6) (6 4))
+                "let zero: nativeint = 0n\
+               \nlet one: nativeint = 1n\
+               \nlet m_one: nativeint = -1n")))))
+          (warnings ())) |}]
+
+     let stdlib_queue =
+       test "
+    {[
+    # let q = Queue.create ()
+    val q : '_weak1 Queue.t = <abstr>
+    ]}
+       ";
+       [%expect {|
+         ((output
+           (((f.ml (2 4) (5 6))
+             (code_block
+              ((f.ml (2 6) (5 4))
+                "# let q = Queue.create ()\
+               \nval q : '_weak1 Queue.t = <abstr>")))))
+          (warnings ())) |}]
+
+     let stdlib_dynarray =
+       test "
+      but this would involve intermediary allocations.
+
+      {[match find x with
+        | None -> ...
+        | Some v -> ...]}
+       ";
+       [%expect {|
+         ((output
+           (((f.ml (2 6) (2 54))
+             (paragraph
+              (((f.ml (2 6) (2 9)) (word but)) ((f.ml (2 9) (2 10)) space)
+               ((f.ml (2 10) (2 14)) (word this)) ((f.ml (2 14) (2 15)) space)
+               ((f.ml (2 15) (2 20)) (word would)) ((f.ml (2 20) (2 21)) space)
+               ((f.ml (2 21) (2 28)) (word involve)) ((f.ml (2 28) (2 29)) space)
+               ((f.ml (2 29) (2 41)) (word intermediary)) ((f.ml (2 41) (2 42)) space)
+               ((f.ml (2 42) (2 54)) (word allocations.)))))
+            ((f.ml (4 6) (6 25))
+             (code_block
+              ((f.ml (4 8) (6 23))
+                "match find x with\
+               \n| None -> ...\
+               \n| Some v -> ...")))))
+          (warnings ())) |}]
+
+     let stdlib_either =
+       test "
+    For example:
+
+{[List.partition_map:
+    ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list]}
+       ";
+       [%expect {|
+         ((output
+           (((f.ml (2 4) (2 16))
+             (paragraph
+              (((f.ml (2 4) (2 7)) (word For)) ((f.ml (2 7) (2 8)) space)
+               ((f.ml (2 8) (2 16)) (word example:)))))
+            ((f.ml (4 0) (5 63))
+             (code_block
+              ((f.ml (4 2) (5 61))
+                "List.partition_map:\
+               \n('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list")))))
+          (warnings ())) |}]
+
   end in
   ()