diff --git a/.gitignore b/.gitignore index 08a111c2ee..e516216dea 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,6 @@ _coverage/ # For local experiments. scratch/ + +# opam v2 +_opam/ diff --git a/odoc.opam b/odoc.opam index e34f0e19f3..348e228a75 100644 --- a/odoc.opam +++ b/odoc.opam @@ -16,6 +16,7 @@ dev-repo: "http://github.com/ocaml-doc/odoc.git" available: [ocaml-version >= "4.03.0"] depends: [ + "astring" {build} "bos" {build} "cmdliner" {build} "cppo" {build} diff --git a/src/parser/jbuild b/src/parser/jbuild index e012b5dda3..feb9b23cf6 100644 --- a/src/parser/jbuild +++ b/src/parser/jbuild @@ -5,4 +5,4 @@ (library ((name parser_) (preprocess (pps (bisect_ppx))) - (libraries (model)))) + (libraries (model astring)))) diff --git a/src/parser/lexer.mll b/src/parser/lexer.mll index f335c2d55b..81dbbc6280 100644 --- a/src/parser/lexer.mll +++ b/src/parser/lexer.mll @@ -70,6 +70,38 @@ let trim_trailing_blank_lines : string -> string = fun s -> in String.sub s 0 trim_from +let trim_leading_whitespace : string -> string = fun s -> + let count_leading_whitespace : string -> int = fun line -> + let rec count_leading_whitespace' : int -> int = fun index -> + if index >= String.length line then + index + else + match line.[index] with + | ' ' | '\t' -> count_leading_whitespace' (index + 1) + | _ -> index + in + count_leading_whitespace' 0 + in + let lines = Astring.String.cuts ~sep:"\n" s in + let least_amount_of_whitespace = + lines + |> List.map count_leading_whitespace + (* Note that if [lines] is empty, [least_amount_of_whitespace] will be + [max_int]. But this is okay since if it's indeed empty, the value + will not be used when trying to remove whitespace below. *) + |> List.fold_left min max_int + in + let remove_whitespace : string -> string = fun line -> + String.sub + line + least_amount_of_whitespace + (String.length line - least_amount_of_whitespace) + in + lines + |> List.map remove_whitespace + |> String.concat "\n" + + module Location = Model.Location_ @@ -256,6 +288,7 @@ rule token input = parse | "{[" (code_block_text as c) "]}" { let c = trim_leading_blank_lines c in let c = trim_trailing_blank_lines c in + let c = trim_leading_whitespace c in emit input (`Code_block c) } | "{v" (verbatim_text as t) "v}" diff --git a/test/parser/expect/code-block/leading-newline-with-space.txt b/test/parser/expect/code-block/leading-newline-with-space.txt index 5cdbd6693e..68907aafc4 100644 --- a/test/parser/expect/code-block/leading-newline-with-space.txt +++ b/test/parser/expect/code-block/leading-newline-with-space.txt @@ -1 +1 @@ -((output (ok (((f.ml (1 0) (2 6)) (code_block " foo"))))) (warnings ())) +((output (ok (((f.ml (1 0) (2 6)) (code_block foo))))) (warnings ())) diff --git a/test/parser/expect/code-block/leading-tab-two-different-indent.txt b/test/parser/expect/code-block/leading-tab-two-different-indent.txt new file mode 100644 index 0000000000..c1fc7fcd64 --- /dev/null +++ b/test/parser/expect/code-block/leading-tab-two-different-indent.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 7)) (code_block "foo\ + \n\tbar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-tab-two.txt b/test/parser/expect/code-block/leading-tab-two.txt new file mode 100644 index 0000000000..2a6e899e76 --- /dev/null +++ b/test/parser/expect/code-block/leading-tab-two.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 6)) (code_block "foo\ + \nbar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-tab.txt b/test/parser/expect/code-block/leading-tab.txt index 7672eef1b3..bd00b8aa2c 100644 --- a/test/parser/expect/code-block/leading-tab.txt +++ b/test/parser/expect/code-block/leading-tab.txt @@ -1 +1 @@ -((output (ok (((f.ml (1 0) (1 8)) (code_block "\tfoo"))))) (warnings ())) +((output (ok (((f.ml (1 0) (1 8)) (code_block foo))))) (warnings ())) diff --git a/test/parser/expect/code-block/leading-whitespace-two-cr-lf.txt b/test/parser/expect/code-block/leading-whitespace-two-cr-lf.txt new file mode 100644 index 0000000000..e52d0ed630 --- /dev/null +++ b/test/parser/expect/code-block/leading-whitespace-two-cr-lf.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 6)) (code_block "foo\r\ + \nbar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-whitespace-two-different-indent-rev.txt b/test/parser/expect/code-block/leading-whitespace-two-different-indent-rev.txt new file mode 100644 index 0000000000..7f6d5a0520 --- /dev/null +++ b/test/parser/expect/code-block/leading-whitespace-two-different-indent-rev.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 6)) (code_block " foo\ + \nbar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-whitespace-two-different-indent.txt b/test/parser/expect/code-block/leading-whitespace-two-different-indent.txt new file mode 100644 index 0000000000..784aa5f132 --- /dev/null +++ b/test/parser/expect/code-block/leading-whitespace-two-different-indent.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 8)) (code_block "foo\ + \n bar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-whitespace-two.txt b/test/parser/expect/code-block/leading-whitespace-two.txt new file mode 100644 index 0000000000..2a6e899e76 --- /dev/null +++ b/test/parser/expect/code-block/leading-whitespace-two.txt @@ -0,0 +1,3 @@ +((output (ok (((f.ml (1 0) (2 6)) (code_block "foo\ + \nbar"))))) + (warnings ())) diff --git a/test/parser/expect/code-block/leading-whitespace.txt b/test/parser/expect/code-block/leading-whitespace.txt index 590144181c..bd00b8aa2c 100644 --- a/test/parser/expect/code-block/leading-whitespace.txt +++ b/test/parser/expect/code-block/leading-whitespace.txt @@ -1 +1 @@ -((output (ok (((f.ml (1 0) (1 8)) (code_block " foo"))))) (warnings ())) +((output (ok (((f.ml (1 0) (1 8)) (code_block foo))))) (warnings ())) diff --git a/test/parser/test.ml b/test/parser/test.ml index 92ac52df22..a08ebb1213 100644 --- a/test/parser/test.ml +++ b/test/parser/test.ml @@ -271,7 +271,13 @@ let tests : test_suite list = [ t "cr-lf" "{[foo\r\nbar]}"; t "blank-line" "{[foo\n\nbar]}"; t "leading-whitespace" "{[ foo]}"; + t "leading-whitespace-two" "{[ foo\n bar]}"; + t "leading-whitespace-two-cr-lf" "{[ foo\r\n bar]}"; + t "leading-whitespace-two-different-indent" "{[ foo\n bar]}"; + t "leading-whitespace-two-different-indent-rev" "{[ foo\n bar]}"; t "leading-tab" "{[\tfoo]}"; + t "leading-tab-two" "{[\tfoo\n\tbar]}"; + t "leading-tab-two-different-indent" "{[\tfoo\n\t\tbar]}"; t "leading-newline" "{[\nfoo]}"; t "leading-cr-lf" "{[\r\nfoo]}"; t "leading-newlines" "{[\n\nfoo]}";