From b2c39fa7e052166e9272512f889f3107def7ef72 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Thu, 30 Aug 2018 05:06:19 +0700 Subject: [PATCH 1/7] Autolink revamp --- lib/ex_doc/formatter/html/autolink.ex | 566 +++++++++++++----- test/ex_doc/formatter/html/autolink_test.exs | 59 ++ .../formatter/html/syntax_rule_test.exs | 84 +++ 3 files changed, 545 insertions(+), 164 deletions(-) create mode 100644 test/ex_doc/formatter/html/syntax_rule_test.exs diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index 3469d87b3..0596590e7 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -1,10 +1,162 @@ +defmodule ExDoc.SyntaxRule do + @type language :: :elixir | :erlang | :markdown + + @spec re_source(atom, language) :: String.t() + def re_source(name, language \\ :elixir) do + re(name, language) |> Regex.source() + end + + @spec re(atom, language) :: Regex.t() + def re(name, language \\ :elixir) + + def re(:prefix, :elixir) do + ~r{ + [ct]: # c:, t: + }x + end + + def re(:m, :elixir) do + ~r{ + ( [A-Z] # start with uppercase letter + [_a-zA-Z0-9]*\.? # followed by optional letter, number or underscore + )+ # this pattern could be repeated + (?~*^@\\+\\%\\!-\/]+ # special form + }x + end + + def re(:f, :erlang) do + ~r{ + # TODO: revise the erlang rules for function names + [0-9a-zA-Z_!\\?]+ + }x + end + + def re(:fa, language) when language in [:elixir, :erlang] do + ~r{ + (#{re_source(:f, language)}) # function name + /\d+ # slash + arity + }x + end + + def re(:mfa, :elixir) do + ~r{ + (#{re_source(:prefix)})? # optional callback/type identifier or ":" + ( + (#{re_source(:m)}\.) + #{re_source(:fa)} + ) + }x + end + + def re(:mfa, :erlang) do + ~r{ + #{re_source(:m, :erlang)} # module name + \. # "." + #{re_source(:fa, :erlang)} # function name + }x + end + + def re(:local, :elixir) do + ~r{ + (#{re_source(:prefix)})? # optional callback or type identifier + #{re_source(:fa)} # function name + arity + }x + end + + def re(:modules, :elixir) do + ~r{ + #{re_source(:m)} + }x + end + + def re(:modules, :erlang) do + ~r{ + #{re_source(:m, :erlang)} + }x + end + + def re(:functions, :elixir) do + ~r{ + (#{re_source(:local)}) | (#{re_source(:mfa)}) + }x + end + + def re(:functions, :erlang) do + ~r{ + #{re_source(:mfa, :erlang)} + }x + end + + def re({:normal_link, function_re_source}, :markdown) do + ~r{ + (? :functions + :module -> :modules + end + + case link_type do + :normal -> + re({:normal_link, re_source(group, language)}, :markdown) + + :custom -> + re({:custom_link, re_source(group, language)}, :markdown) + end + end +end + defmodule ExDoc.Formatter.HTML.Autolink do @moduledoc """ Conveniences for autolinking. """ - + import ExDoc.SyntaxRule import ExDoc.Formatter.HTML.Templates, only: [h: 1, enc_h: 1] + @type language :: ExDoc.SyntaxRule.language() + @type kind :: :function | :module + @type link_type :: :normal | :custom + + random_string = 1..10_000_000 |> Enum.random() |> Integer.to_charlist(36) + @backtick_replacement "" + @elixir_docs "https://hexdocs.pm/" @erlang_docs "http://www.erlang.org/doc/man/" @basic_types_page "typespecs.html#basic-types" @@ -71,7 +223,7 @@ defmodule ExDoc.Formatter.HTML.Autolink do @special_form_strings for {f, a} <- special_form_exports, do: "#{f}/#{a}" @doc """ - Compiles information used during autolinks. + Compiles information used during autolinking. """ def compile(modules, extension, extra_lib_dirs) do aliases = Enum.map(modules, & &1.module) @@ -112,25 +264,20 @@ defmodule ExDoc.Formatter.HTML.Autolink do end defp project_doc(bin, module_id, locals, compiled) when is_binary(bin) do - %{ - aliases: aliases, - docs_refs: docs_refs, - extension: extension, - lib_dirs: lib_dirs, - modules_refs: modules_refs - } = compiled + options = + Map.merge(compiled, %{ + module_id: module_id, + locals: locals + }) + |> Map.to_list() - bin - |> locals(locals, aliases, extension, lib_dirs) - |> elixir_functions(docs_refs, extension, lib_dirs) - |> elixir_modules(modules_refs, module_id, extension, lib_dirs) - |> erlang_functions() + link_everything(bin, options) end @doc """ - Autolinks all modules nodes. + Autolinks all module nodes. - This is the main API to autolink any modules nodes. + This is the main API to autolink any module nodes. """ def all(modules, compiled) do opts = [timeout: :infinity] @@ -311,171 +458,291 @@ defmodule ExDoc.Formatter.HTML.Autolink do |> IO.iodata_to_binary() end - @doc """ - Helper function for autolinking locals. + @kinds [:module, :function] + @languages [:elixir, :erlang] + @link_types [:custom, :normal] - Create links to locally defined functions, specified in `locals` - as a list of `fun/arity` strings. + @regexes (for link_type <- @link_types, + language <- @languages, + kind <- @kinds do + %{ + kind: kind, + language: language, + link_type: link_type + } + end) - Ignores functions which are already wrapped in markdown url syntax, - e.g. `[test/1](url)`. If the function doesn't touch the leading - or trailing `]`, e.g. `[my link link/1 is here](url)`, the fun/arity - will get translated to the new href of the function. - """ - def locals(bin, locals, aliases \\ [], extension \\ ".html", lib_dirs \\ elixir_lib_dirs()) do - fun_re = - Regex.source( - ~r{(([ct]:)?([a-z_]+[A-Za-z_\d]*[\\?\\!]?|[\{\}=&\\|\\.<>~*^@\\+\\%\\!-\/]+)/\d+)} - ) + @doc false + def locals(string, locals, aliases \\ [], extension \\ ".html", lib_dirs \\ elixir_lib_dirs()) do + options = [ + locals: locals, + aliases: aliases, + extension: extension, + lib_dirs: lib_dirs + ] - regex = ~r{(? - {prefix, _, function, arity} = split_function(match) - text = "`#{function}/#{arity}`" + link(string, :elixir, :module, options) + end - cond do - match in locals -> - "[#{text}](##{prefix}#{enc_h(function)}/#{arity})" + @doc false + def elixir_functions(string, docs_refs, extension \\ ".html", lib_dirs \\ elixir_lib_dirs()) + when is_binary(string) do + options = [ + docs_refs: docs_refs, + extension: extension, + lib_dirs: lib_dirs + ] - match in @basic_type_strings -> - "[#{text}](#{elixir_docs}#{@basic_types_page})" + link(string, :elixir, :function, options) + end - match in @built_in_type_strings -> - "[#{text}](#{elixir_docs}#{@built_in_types_page})" + @doc false + def erlang_modules(string) when is_binary(string) do + link(string, :erlang, :module, []) + end - match in @kernel_function_strings -> - "[#{text}](#{elixir_docs}Kernel#{extension}##{prefix}#{enc_h(function)}/#{arity})" + @doc false + def erlang_functions(string) when is_binary(string) do + link(string, :erlang, :function, []) + end - match in @special_form_strings -> - "[#{text}](#{elixir_docs}Kernel.SpecialForms" <> - "#{extension}##{prefix}#{enc_h(function)}/#{arity})" + defp replace_fun(language, kind, link_type, options) do + case link_type do + :normal -> + fn all, match -> + replacement(all, language, kind, match, options) + end - true -> - all - end - end) + :custom -> + fn all, text, match -> + replacement(all, language, kind, match, text, options) + end + end end @doc """ - Helper function for autolinking elixir functions. - - Project functions are specified in `project_funs` as a list of - `Module.fun/arity` tuples. + Helper function for autolinking functions and modules. - Functions wrapped in markdown url syntax can link to other docs if - the url is wrapped in backticks, otherwise the url is used as is. - If the function doesn't touch the leading or trailing `]`, e.g. - `[my link Module.link/1 is here](url)`, the Module.fun/arity - will get translated to the new href of the function. - """ - def elixir_functions(bin, project_funs, extension \\ ".html", lib_dirs \\ elixir_lib_dirs()) - when is_binary(bin) do - bin - |> replace_custom_links(project_funs, extension, lib_dirs) - |> replace_normal_links(project_funs, extension, lib_dirs) - end + It autolinks all links for a certain `language` and of a certain `kind`. - module_re = Regex.source(~r{(([A-Z][A-Za-z_\d]+)\.)+}) + `language` can be: `:elixir`, `:erlang` or `:markdown`. - fun_re = - Regex.source( - ~r{([ct]:)?((#{module_re})?(([a-z_]+[A-Za-z_\d]*[\\?\\!]?)|[\{\}=&\\|\\.<>~*^@\\+\\%\\!-\/]+)/\d+)} - ) + `kind` is either `:function` or `:module`. - @custom_re ~r{\[(.*?)\]\(`(#{fun_re})`\)} - @normal_re ~r{(? - replacement(all, match, project_funs, extension, lib_dirs, text) + """ + @spec link(String.t(), language, kind, keyword) :: String.t() + def link(string, language, kind, options) do + string + |> preprocess() + |> link(language, kind, :normal, options) + |> link(language, kind, :custom, options) + |> postprocess() + end + + defp link(string, language, kind, link_type, options) do + regex = regex_link_type(language, kind, link_type) + replace_fun = replace_fun(language, kind, link_type, options) + + Regex.replace(regex, string, replace_fun) + end + + defp link_everything(string, options) do + Enum.reduce(@regexes, string, fn %{ + kind: kind, + language: language, + link_type: link_type + }, + acc -> + link(acc, language, kind, link_type, options) end) end - defp replace_normal_links(bin, project_funs, extension, lib_dirs) do - Regex.replace(@normal_re, bin, fn all, match -> - replacement(all, match, project_funs, extension, lib_dirs) + # Replaces all backticks inside the text of custom links with @backtick_replacement. + defp preprocess(string) do + regex = ~r{ + \[(.*?`.*?)\] + \((.*?)\) + }x + + Regex.replace(regex, string, fn _all, text, link -> + new_text = String.replace(text, :binary.compile_pattern("`"), @backtick_replacement) + "[#{new_text}](#{link})" end) end - defp replacement(all, match, project_funs, extension, lib_dirs, text \\ nil) do - {prefix, module, function, arity} = split_function(match) - text = text || "`#{module}.#{function}/#{arity}`" + # Reverts the changes done by `preprocess/1`. + defp postprocess(string) do + String.replace(string, :binary.compile_pattern(@backtick_replacement), "`") + # string + end + + @doc false + # The heart of the autolinking logic + @spec replacement(String.t(), language, kind, String.t(), keyword) :: String.t() + def replacement(string, language, kind, match, text \\ nil, options) do + aliases = Keyword.get(options, :aliases, []) + docs_refs = Keyword.get(options, :docs_refs, []) + extension = Keyword.get(options, :extension, ".html") + lib_dirs = Keyword.get(options, :lib_dirs, default_lib_dirs(language)) + locals = Keyword.get(options, :locals, []) + module_id = Keyword.get(options, :module_id, nil) + modules_refs = Keyword.get(options, :modules_refs, []) + + pmfa = {prefix, module, function, arity} = split_function(match) + text = text || default_text(language, kind, match, pmfa) - aliases = [] elixir_docs = get_elixir_docs(aliases, lib_dirs) - cond do - match in project_funs -> - "[#{text}](#{module}#{extension}##{prefix}#{enc_h(function)}/#{arity})" + case language do + :erlang -> + cond do + doc = module_docs(:erlang, module, lib_dirs) -> + case kind do + :module -> + "[#{text}](#{doc}#{module}.html)" + + :function -> + "[#{text}](#{doc}#{module}.html##{function}-#{arity})" + end + + true -> + string + end + + :elixir -> + case kind do + :module -> + cond do + match == module_id -> + "[`#{match}`](#{match}#{extension}#content)" + + match in modules_refs -> + "[`#{match}`](#{match}#{extension})" + + doc = module_docs(:elixir, match, lib_dirs) -> + "[`#{match}`](#{doc}#{match}.html)" + + true -> + string + end + + :function -> + cond do + match in locals -> + "[#{text}](##{prefix}#{enc_h(function)}/#{arity})" + + match in docs_refs -> + "[#{text}](#{module}#{extension}##{prefix}#{enc_h(function)}/#{arity})" + + match in @basic_type_strings -> + "[#{text}](#{elixir_docs}#{@basic_types_page})" + + match in @built_in_type_strings -> + "[#{text}](#{elixir_docs}#{@built_in_types_page})" - match in @kernel_function_strings -> - "[#{text}](#{elixir_docs}Kernel#{extension}##{prefix}#{enc_h(function)}/#{arity})" + match in @kernel_function_strings -> + "[#{text}](#{elixir_docs}Kernel#{extension}##{prefix}#{enc_h(function)}/#{arity})" - match in @special_form_strings -> - "[#{text}](#{elixir_docs}Kernel.SpecialForms#{extension}##{prefix}#{enc_h(function)}/#{ - arity - })" + match in @special_form_strings -> + "[#{text}](#{elixir_docs}Kernel.SpecialForms#{extension}##{prefix}#{ + enc_h(function) + }/#{arity})" - doc = lib_dirs_to_doc("Elixir." <> module, lib_dirs) -> - "[#{text}](#{doc}#{module}.html##{prefix}#{enc_h(function)}/#{arity})" + doc = module_docs(:elixir, module, lib_dirs) -> + "[#{text}](#{doc}#{module}.html##{prefix}#{enc_h(function)}/#{arity})" - true -> - all + true -> + string + end + end end end - @doc """ - Helper function for autolinking elixir modules. + ## Helpers - Ignores modules which are already wrapped in markdown url syntax, - e.g. `[Module](url)`. If the module name doesn't touch the leading - or trailing `]`, e.g. `[my link Module is here](url)`, the Module - will get translated to the new href of the module. - """ - def elixir_modules( - bin, - modules, - module_id \\ nil, - extension \\ ".html", - lib_dirs \\ elixir_lib_dirs() - ) - when is_binary(bin) do - regex = ~r{(? - cond do - match == module_id -> - "[`#{match}`](#{match}#{extension}#content)" + defp default_text(:elixir, _kind, _match, {_prefix, module, function, arity}) do + if module == "" do + # local + "`#{function}/#{arity}`" + else + "`#{module}.#{function}/#{arity}`" + end + end - match in modules -> - "[`#{match}`](#{match}#{extension})" + defp default_lib_dirs(:elixir), + do: elixir_lib_dirs() - doc = lib_dirs_to_doc("Elixir." <> match, lib_dirs) -> - "[`#{match}`](#{doc}#{match}.html)" + defp default_lib_dirs(:erlang), + do: erlang_lib_dirs() - true -> - all - end - end) - end + defp module_docs(:elixir, module, lib_dirs), + do: lib_dirs_to_doc("Elixir." <> module, lib_dirs) + + defp module_docs(:erlang, module, lib_dirs), + do: lib_dirs_to_doc(module, lib_dirs) + + @doc false + def split_function(string) when is_binary(string), + do: split_function_string(string) - defp split_function("c:" <> bin) do - {_, mod, fun, arity} = split_function(bin) + defp split_function_string("c:" <> string) do + {_, mod, fun, arity} = split_function(string) {"c:", mod, fun, arity} end - defp split_function("t:" <> bin) do - {_, mod, fun, arity} = split_function(bin) + defp split_function_string("t:" <> string) do + {_, mod, fun, arity} = split_function_string(string) {"t:", mod, fun, arity} end - defp split_function(bin) when is_binary(bin) do - split_function(String.split(bin, "/")) + defp split_function_string(":" <> string) do + {_, mod, fun, arity} = split_function_string(string) + {":", mod, fun, arity} + end + + defp split_function_string(string) do + string + |> String.split("/") + |> split_function_list() + end + + # handles a single module + defp split_function_list([module]) do + {"", module, "", ""} end - defp split_function([modules, arity]) do + defp split_function_list([modules, arity]) do {mod, name} = modules # this handles the case of the ".." function @@ -487,39 +754,10 @@ defmodule ExDoc.Formatter.HTML.Autolink do end # handles "/" function - defp split_function([modules, "", arity]) do - split_function([modules <> "/", arity]) + defp split_function_list([modules, "", arity]) when is_binary(modules) do + split_function_list([modules <> "/", arity]) end - @doc """ - Helper function for autolinking erlang functions. - - Only links modules that are in the Erlang distribution `lib_dir` - and only link functions in those modules that export a function of the - same name and arity. - - Ignores functions which are already wrapped in markdown url syntax, - e.g. `[:module.test/1](url)`. If the function doesn't touch the leading - or trailing `]`, e.g. `[my link :module.link/1 is here](url)`, the :module.fun/arity - will get translated to the new href of the function. - """ - def erlang_functions(bin) when is_binary(bin) do - lib_dirs = erlang_lib_dirs() - regex = ~r{(? - {_, module, function, arity} = split_function(match) - - if doc = lib_dirs_to_doc(module, lib_dirs) do - "[`:#{match}`](#{doc}#{module}.html##{function}-#{arity})" - else - all - end - end) - end - - ## Helpers - defp doc_prefix(%{type: c}) when c in [:callback, :macrocallback], do: "c:" defp doc_prefix(%{type: _}), do: "" diff --git a/test/ex_doc/formatter/html/autolink_test.exs b/test/ex_doc/formatter/html/autolink_test.exs index 2eaba1a21..3978e03b3 100644 --- a/test/ex_doc/formatter/html/autolink_test.exs +++ b/test/ex_doc/formatter/html/autolink_test.exs @@ -224,6 +224,18 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do assert Autolink.elixir_functions("[`is_boolean`](`is_boolean/1`)", []) == "[`is_boolean`](#{@elixir_docs}elixir/Kernel.html#is_boolean/1)" + + assert Autolink.elixir_functions("[term()](`t:term/0`)", []) == + "[term()](#{@elixir_docs}elixir/typespecs.html#built-in-types)" + + assert Autolink.elixir_functions("[term\(\)](`t:term/0`)", []) == + "[term\(\)](#{@elixir_docs}elixir/typespecs.html#built-in-types)" + + assert Autolink.elixir_functions("[`term()`](`t:term/0`)", []) == + "[`term()`](#{@elixir_docs}elixir/typespecs.html#built-in-types)" + + assert Autolink.elixir_functions("[`term()`](`t:term/0`)", []) == + "[`term()`](#{@elixir_docs}elixir/typespecs.html#built-in-types)" end end @@ -282,6 +294,36 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do end end + describe "Erlang modules" do + test "autolinks to Erlang modules" do + assert Autolink.erlang_modules("`:erlang`") == "[`:erlang`](#{@erlang_docs}erlang.html)" + + assert Autolink.erlang_modules("`:erl_prim_loader`") == + "[`:erl_prim_loader`](#{@erlang_docs}erl_prim_loader.html)" + end + + test "autolinks to Erlang modules with custom links" do + assert Autolink.erlang_modules("[`example`](`:lists`)") == + "[`example`](#{@erlang_docs}lists.html)" + + assert Autolink.erlang_modules("[example](`:lists`)") == + "[example](#{@erlang_docs}lists.html)" + end + + test "does not autolink pre-linked docs" do + assert Autolink.erlang_modules("[`:erlang`](other.html)") == "[`:erlang`](other.html)" + + assert Autolink.erlang_modules("[the `:erlang` module](other.html)") == + "[the `:erlang` module](other.html)" + + assert Autolink.erlang_modules("`:erlang`") == "[`:erlang`](#{@erlang_docs}erlang.html)" + end + + test "does not autolink functions that aren't part of the Erlang distribution" do + assert Autolink.erlang_modules("`:unknown.foo/0`") == "`:unknown.foo/0`" + end + end + describe "erlang functions" do test "autolinks to erlang functions" do assert Autolink.erlang_functions("`:erlang.apply/2`") == @@ -302,6 +344,14 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do "[`:zlib.deflateInit/2`](#{@erlang_docs}zlib.html#deflateInit-2)" end + test "autolinks to Erlang functions with custom links" do + assert Autolink.erlang_functions("[`example`](`:lists.reverse/1`)") == + "[`example`](#{@erlang_docs}lists.html#reverse-1)" + + assert Autolink.erlang_functions("[example](`:lists.reverse/1`)") == + "[example](#{@erlang_docs}lists.html#reverse-1)" + end + test "does not autolink pre-linked docs" do assert Autolink.erlang_functions("[`:erlang.apply/2`](other.html)") == "[`:erlang.apply/2`](other.html)" @@ -309,6 +359,15 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do assert Autolink.erlang_functions("[the `:erlang.apply/2`](other.html)") == "[the `:erlang.apply/2`](other.html)" + assert Autolink.erlang_functions("[the `:erlang.apply/2` function](`Kernel.apply/2`)") == + "[the `:erlang.apply/2` function](`Kernel.apply/2`)" + + assert Autolink.erlang_functions("[the :erlang.apply/2 function](`Kernel.apply/2`)") == + "[the :erlang.apply/2 function](`Kernel.apply/2`)" + + assert Autolink.erlang_functions("[the `:erlang.apply/2` function](other.html)") == + "[the `:erlang.apply/2` function](other.html)" + assert Autolink.erlang_functions("`:erlang`") == "`:erlang`" end diff --git a/test/ex_doc/formatter/html/syntax_rule_test.exs b/test/ex_doc/formatter/html/syntax_rule_test.exs new file mode 100644 index 000000000..121b37c77 --- /dev/null +++ b/test/ex_doc/formatter/html/syntax_rule_test.exs @@ -0,0 +1,84 @@ +defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do + use ExUnit.Case, async: true + + import ExDoc.SyntaxRule + import Regex, only: [run: 2] + + describe "Elixir: basic parts" do + test "prefix" do + assert ["t:"] = run(re(:prefix), "t:term()") + assert ["c:"] = run(re(:prefix), "c:GenServer.c:init/1") + refute run(re(:prefix), ":binary.cp()") + end + + test "modules" do + refute run(re(:m), "module.fun/1") + assert "Module" == run(re(:m), "Module.fun/1") |> hd() + assert "Module.Some" == run(re(:m), "Module.Some.fun/1") |> hd() + end + + test "functions" do + assert "fun" == run(re(:f), "`fun/1`") |> hd() + assert "is_FUN_99?" == run(re(:f), "`is_FUN_99?/1`") |> hd() + + assert "fun/11" == run(re(:fa), "`fun/11`") |> hd() + assert "is_FUN_99?/11" == run(re(:fa), "`is_FUN_99?/11`") |> hd() + end + + test "special forms" do + assert "/" == run(re(:f), "`/2`") |> hd() + assert "." == run(re(:f), "`.2`") |> hd() + assert "__ENV__" == run(re(:f), "`__ENV__/0`") |> hd() + end + end + + describe "Erlang: basic parts" do + test "modules" do + refute run(re(:m, :erlang), "MODULE.FUN/1") + assert ":module" == run(re(:m, :erlang), ":module.fun/1") |> hd() + assert ":module_some" == run(re(:m, :erlang), ":module_some.fun/1") |> hd() + end + + test "functions" do + assert "fun" == run(re(:f, :erlang), "`fun/1`") |> hd() + assert "is_FUN_99?!" == run(re(:f, :erlang), "`is_FUN_99?!/1`") |> hd() + + assert "is_fun_99/123" == run(re(:fa, :erlang), "`is_fun_99/123`") |> hd() + end + + test "mfa" do + assert ":my_erlang_module.is_fun!/123" == + run(re(:mfa, :erlang), "`:my_erlang_module.is_fun!/123`") |> hd() + end + end + + describe "links" do + test "normal links - Elixir" do + mfa = re_source(:mfa) + refute run(re({:normal_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") + assert run(re({:normal_link, mfa}, :markdown), "`Mod.example/1`") + end + + test "custom links - Elixir" do + mfa = re_source(:mfa) + + assert "[`example`](`Mod.example/1`)" == + run(re({:custom_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") |> hd() + end + + test "normal links - Erlang" do + mfa = re_source(:mfa, :erlang) + refute run(re({:normal_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") + assert run(re({:normal_link, mfa}, :markdown), "`:mod.example/1`") + end + + test "custom links - Erlang" do + mfa = re_source(:mfa, :erlang) + + assert "[`example`](`:mod.example/1`)" == + run(re({:custom_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") |> hd() + + refute run(re({:custom_link, mfa}, :markdown), "`:mod.example/1`") + end + end +end From 3baf5f62ed7b68d56d8aa67c71d0289f17c25d14 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Sun, 9 Sep 2018 00:32:50 +0700 Subject: [PATCH 2/7] Make Ebert happy --- .../formatter/html/syntax_rule_test.exs | 41 +++++++++++-------- 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/test/ex_doc/formatter/html/syntax_rule_test.exs b/test/ex_doc/formatter/html/syntax_rule_test.exs index 121b37c77..ade8b03f5 100644 --- a/test/ex_doc/formatter/html/syntax_rule_test.exs +++ b/test/ex_doc/formatter/html/syntax_rule_test.exs @@ -1,3 +1,4 @@ +@moduledoc false defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do use ExUnit.Case, async: true @@ -13,42 +14,42 @@ defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do test "modules" do refute run(re(:m), "module.fun/1") - assert "Module" == run(re(:m), "Module.fun/1") |> hd() - assert "Module.Some" == run(re(:m), "Module.Some.fun/1") |> hd() + assert "Module" == run_hd(re(:m), "Module.fun/1") + assert "Module.Some" == run_hd(re(:m), "Module.Some.fun/1") end test "functions" do - assert "fun" == run(re(:f), "`fun/1`") |> hd() - assert "is_FUN_99?" == run(re(:f), "`is_FUN_99?/1`") |> hd() + assert "fun" == run_hd(re(:f), "`fun/1`") + assert "is_FUN_99?" == run_hd(re(:f), "`is_FUN_99?/1`") - assert "fun/11" == run(re(:fa), "`fun/11`") |> hd() - assert "is_FUN_99?/11" == run(re(:fa), "`is_FUN_99?/11`") |> hd() + assert "fun/11" == run_hd(re(:fa), "`fun/11`") + assert "is_FUN_99?/11" == run_hd(re(:fa), "`is_FUN_99?/11`") end test "special forms" do - assert "/" == run(re(:f), "`/2`") |> hd() - assert "." == run(re(:f), "`.2`") |> hd() - assert "__ENV__" == run(re(:f), "`__ENV__/0`") |> hd() + assert "/" == run_hd(re(:f), "`/2`") + assert "." == run_hd(re(:f), "`.2`") + assert "__ENV__" == run_hd(re(:f), "`__ENV__/0`") end end describe "Erlang: basic parts" do test "modules" do refute run(re(:m, :erlang), "MODULE.FUN/1") - assert ":module" == run(re(:m, :erlang), ":module.fun/1") |> hd() - assert ":module_some" == run(re(:m, :erlang), ":module_some.fun/1") |> hd() + assert ":module" == run_hd(re(:m, :erlang), ":module.fun/1") + assert ":module_some" == run_hd(re(:m, :erlang), ":module_some.fun/1") end test "functions" do - assert "fun" == run(re(:f, :erlang), "`fun/1`") |> hd() - assert "is_FUN_99?!" == run(re(:f, :erlang), "`is_FUN_99?!/1`") |> hd() + assert "fun" == run_hd(re(:f, :erlang), "`fun/1`") + assert "is_FUN_99?!" == run_hd(re(:f, :erlang), "`is_FUN_99?!/1`") - assert "is_fun_99/123" == run(re(:fa, :erlang), "`is_fun_99/123`") |> hd() + assert "is_fun_99/123" == run_hd(re(:fa, :erlang), "`is_fun_99/123`") end test "mfa" do assert ":my_erlang_module.is_fun!/123" == - run(re(:mfa, :erlang), "`:my_erlang_module.is_fun!/123`") |> hd() + run_hd(re(:mfa, :erlang), "`:my_erlang_module.is_fun!/123`") end end @@ -63,22 +64,26 @@ defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do mfa = re_source(:mfa) assert "[`example`](`Mod.example/1`)" == - run(re({:custom_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") |> hd() + run_hd(re({:custom_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") end test "normal links - Erlang" do mfa = re_source(:mfa, :erlang) refute run(re({:normal_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") - assert run(re({:normal_link, mfa}, :markdown), "`:mod.example/1`") + assert run_hd(re({:normal_link, mfa}, :markdown), "`:mod.example/1`") end test "custom links - Erlang" do mfa = re_source(:mfa, :erlang) assert "[`example`](`:mod.example/1`)" == - run(re({:custom_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") |> hd() + run_hd(re({:custom_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") refute run(re({:custom_link, mfa}, :markdown), "`:mod.example/1`") end end + + defp run_hd(regex, string) do + hd(Regex.run(regex, string)) + end end From 13c2c338fed2856f4095cc916ad48c29d3eb9921 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Sun, 9 Sep 2018 00:48:21 +0700 Subject: [PATCH 3/7] Make Ebert happy round 2 --- lib/ex_doc/formatter/html/autolink.ex | 29 ++++++++++--------- .../formatter/html/syntax_rule_test.exs | 1 - 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index 0596590e7..67a4091fc 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -1,9 +1,11 @@ defmodule ExDoc.SyntaxRule do + @moduledoc false + @type language :: :elixir | :erlang | :markdown @spec re_source(atom, language) :: String.t() def re_source(name, language \\ :elixir) do - re(name, language) |> Regex.source() + Regex.source(re(name, language)) end @spec re(atom, language) :: Regex.t() @@ -110,7 +112,7 @@ defmodule ExDoc.SyntaxRule do `\s* # leading backtick (#{function_re_source}) # CAPTURE 1 \s*` # trailing backtick - (?!`) + (?!`) (?!\])(?!\)) # it shouldn't be followed by "]", ")" }x end @@ -265,7 +267,8 @@ defmodule ExDoc.Formatter.HTML.Autolink do defp project_doc(bin, module_id, locals, compiled) when is_binary(bin) do options = - Map.merge(compiled, %{ + compiled + |> Map.merge(%{ module_id: module_id, locals: locals }) @@ -623,18 +626,16 @@ defmodule ExDoc.Formatter.HTML.Autolink do case language do :erlang -> - cond do - doc = module_docs(:erlang, module, lib_dirs) -> - case kind do - :module -> - "[#{text}](#{doc}#{module}.html)" - - :function -> - "[#{text}](#{doc}#{module}.html##{function}-#{arity})" - end + if doc = module_docs(:erlang, module, lib_dirs) do + case kind do + :module -> + "[#{text}](#{doc}#{module}.html)" - true -> - string + :function -> + "[#{text}](#{doc}#{module}.html##{function}-#{arity})" + end + else + string end :elixir -> diff --git a/test/ex_doc/formatter/html/syntax_rule_test.exs b/test/ex_doc/formatter/html/syntax_rule_test.exs index ade8b03f5..4a49482fd 100644 --- a/test/ex_doc/formatter/html/syntax_rule_test.exs +++ b/test/ex_doc/formatter/html/syntax_rule_test.exs @@ -1,4 +1,3 @@ -@moduledoc false defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do use ExUnit.Case, async: true From ddf7a0da0ddec7cc330bcbca07c1d8c0a79f4641 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Mon, 10 Sep 2018 05:38:43 +0700 Subject: [PATCH 4/7] Several fixes - Rename ExDoc.SyntaxRule to ExDoc.Formatter.HTML.SyntaxRule - Fix syntax rules for normal links - Add internal option `:preprocess?` to Autolink.link/4, which is set to `true` by default - Fix Autolink.link_everything/2 to only preprocess and postprocess just once - Add corner-cases section in text, including a few ones --- lib/ex_doc/formatter/html/autolink.ex | 77 +++++++++++++------ test/ex_doc/formatter/html/autolink_test.exs | 34 ++++++++ .../formatter/html/syntax_rule_test.exs | 2 +- 3 files changed, 89 insertions(+), 24 deletions(-) diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index 67a4091fc..6aadba06a 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -1,4 +1,4 @@ -defmodule ExDoc.SyntaxRule do +defmodule ExDoc.Formatter.HTML.SyntaxRule do @moduledoc false @type language :: :elixir | :erlang | :markdown @@ -107,13 +107,13 @@ defmodule ExDoc.SyntaxRule do def re({:normal_link, function_re_source}, :markdown) do ~r{ - (? link(language, kind, :normal, options) + |> link(language, kind, :custom, options) + + string = + if options[:preprocess?] do + postprocess(string) + else + string + end + string - |> preprocess() - |> link(language, kind, :normal, options) - |> link(language, kind, :custom, options) - |> postprocess() end defp link(string, language, kind, link_type, options) do @@ -577,15 +598,25 @@ defmodule ExDoc.Formatter.HTML.Autolink do Regex.replace(regex, string, replace_fun) end - defp link_everything(string, options) do - Enum.reduce(@regexes, string, fn %{ - kind: kind, - language: language, - link_type: link_type - }, - acc -> - link(acc, language, kind, link_type, options) - end) + @doc false + def link_everything(string, options) when is_list(options) do + # disable preprocess every time we run link/4, + # and transform string manually before and after Enum.reduce + options = Keyword.put_new(options, :preprocess?, false) + + string = preprocess(string) + + string = + Enum.reduce(@regexes, string, fn %{ + kind: kind, + language: language, + link_type: link_type + }, + acc -> + link(acc, language, kind, link_type, options) + end) + + postprocess(string) end # Replaces all backticks inside the text of custom links with @backtick_replacement. diff --git a/test/ex_doc/formatter/html/autolink_test.exs b/test/ex_doc/formatter/html/autolink_test.exs index 3978e03b3..a871a281b 100644 --- a/test/ex_doc/formatter/html/autolink_test.exs +++ b/test/ex_doc/formatter/html/autolink_test.exs @@ -191,6 +191,18 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do "[the `Mod.example/1`](foo)" end + test "supports normal links" do + assert Autolink.elixir_functions("`Mod.example/1`", ["Mod.example/1"]) == + "[`Mod.example/1`](Mod.html#example/1)" + + assert Autolink.elixir_functions("(`Mod.example/1`)", ["Mod.example/1"]) == + "([`Mod.example/1`](Mod.html#example/1))" + + # It ignores links preceded by "](" + assert Autolink.elixir_functions("](`Mod.example/1`)", ["Mod.example/1"]) == + "](`Mod.example/1`)" + end + test "supports custom links" do assert Autolink.elixir_functions("[`example`](`Mod.example/1`)", ["Mod.example/1"]) == "[`example`](Mod.html#example/1)" @@ -291,6 +303,15 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do assert Autolink.elixir_modules("[the `Mod.Nested`](other.html)", ["Mod.Nested"]) == "[the `Mod.Nested`](other.html)" + + assert Autolink.elixir_modules("[in the `Kernel` module](Kernel.html#guards)", ["Kernel"]) == + "[in the `Kernel` module](Kernel.html#guards)" + + assert Autolink.elixir_modules("[in the `Kernel` module](Kernel.html#guards)", []) == + "[in the `Kernel` module](Kernel.html#guards)" + + assert Autolink.link_everything("[in the `Kernel` module](Kernel.html#guards)", []) == + "[in the `Kernel` module](Kernel.html#guards)" end end @@ -531,6 +552,19 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do end end + describe "corner-cases" do + test "accepts functions around () and []" do + assert Autolink.locals("`===/2`", [], [Kernel]) === "[`===/2`](Kernel.html#===/2)" + assert Autolink.locals("(`===/2`)", [], [Kernel]) === "([`===/2`](Kernel.html#===/2))" + assert Autolink.locals("[`===/2`]", [], [Kernel]) === "[[`===/2`](Kernel.html#===/2)]" + + output = Autolink.link_everything("`===/2`", []) + assert output === "[`===/2`](#{@elixir_docs}elixir/Kernel.html#===/2)" + assert Autolink.link_everything("(`===/2`)", []) === "(" <> output <> ")" + assert Autolink.link_everything("[`===/2`]", []) === "[" <> output <> "]" + end + end + defp assert_typespec_placeholders(original, expected, typespecs, aliases \\ []) do ast = Code.string_to_quoted!(original) {actual, _} = Autolink.format_and_extract_typespec_placeholders(ast, typespecs, aliases, []) diff --git a/test/ex_doc/formatter/html/syntax_rule_test.exs b/test/ex_doc/formatter/html/syntax_rule_test.exs index 4a49482fd..657e27c08 100644 --- a/test/ex_doc/formatter/html/syntax_rule_test.exs +++ b/test/ex_doc/formatter/html/syntax_rule_test.exs @@ -1,7 +1,7 @@ defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do use ExUnit.Case, async: true - import ExDoc.SyntaxRule + import ExDoc.Formatter.HTML.SyntaxRule import Regex, only: [run: 2] describe "Elixir: basic parts" do From 7b4d1ee25d2bed02a2aa9177d71257fd105d0a85 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Mon, 10 Sep 2018 23:10:40 +0700 Subject: [PATCH 5/7] Implement suggestions by @josevalim --- lib/ex_doc/formatter/html/autolink.ex | 343 +++++++++--------- .../formatter/html/syntax_rule_test.exs | 88 ----- 2 files changed, 169 insertions(+), 262 deletions(-) delete mode 100644 test/ex_doc/formatter/html/syntax_rule_test.exs diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index 6aadba06a..e7afe48ba 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -1,163 +1,14 @@ -defmodule ExDoc.Formatter.HTML.SyntaxRule do - @moduledoc false - - @type language :: :elixir | :erlang | :markdown - - @spec re_source(atom, language) :: String.t() - def re_source(name, language \\ :elixir) do - Regex.source(re(name, language)) - end - - @spec re(atom, language) :: Regex.t() - def re(name, language \\ :elixir) - - def re(:prefix, :elixir) do - ~r{ - [ct]: # c:, t: - }x - end - - def re(:m, :elixir) do - ~r{ - ( [A-Z] # start with uppercase letter - [_a-zA-Z0-9]*\.? # followed by optional letter, number or underscore - )+ # this pattern could be repeated - (?~*^@\\+\\%\\!-\/]+ # special form - }x - end - - def re(:f, :erlang) do - ~r{ - # TODO: revise the erlang rules for function names - [0-9a-zA-Z_!\\?]+ - }x - end - - def re(:fa, language) when language in [:elixir, :erlang] do - ~r{ - (#{re_source(:f, language)}) # function name - /\d+ # slash + arity - }x - end - - def re(:mfa, :elixir) do - ~r{ - (#{re_source(:prefix)})? # optional callback/type identifier or ":" - ( - (#{re_source(:m)}\.) - #{re_source(:fa)} - ) - }x - end - - def re(:mfa, :erlang) do - ~r{ - #{re_source(:m, :erlang)} # module name - \. # "." - #{re_source(:fa, :erlang)} # function name - }x - end - - def re(:local, :elixir) do - ~r{ - (#{re_source(:prefix)})? # optional callback or type identifier - #{re_source(:fa)} # function name + arity - }x - end - - def re(:modules, :elixir) do - ~r{ - #{re_source(:m)} - }x - end - - def re(:modules, :erlang) do - ~r{ - #{re_source(:m, :erlang)} - }x - end - - def re(:functions, :elixir) do - ~r{ - (#{re_source(:local)}) | (#{re_source(:mfa)}) - }x - end - - def re(:functions, :erlang) do - ~r{ - #{re_source(:mfa, :erlang)} - }x - end - - def re({:normal_link, function_re_source}, :markdown) do - ~r{ - (? :functions - :module -> :modules - end - - case link_type do - :normal -> - re({:normal_link, re_source(group, language)}, :markdown) - - :custom -> - re({:custom_link, re_source(group, language)}, :markdown) - end - end -end - defmodule ExDoc.Formatter.HTML.Autolink do @moduledoc """ Conveniences for autolinking. """ - import ExDoc.Formatter.HTML.SyntaxRule import ExDoc.Formatter.HTML.Templates, only: [h: 1, enc_h: 1] - @type language :: ExDoc.Formatter.HTML.SyntaxRule.language() + @type language :: :elixir | :erlang | :markdown @type kind :: :function | :module @type link_type :: :normal | :custom - random_string = 1..10_000_000 |> Enum.random() |> Integer.to_charlist(36) - @backtick_replacement "" + @backtick_replacement "" @elixir_docs "https://hexdocs.pm/" @erlang_docs "http://www.erlang.org/doc/man/" @@ -224,6 +75,7 @@ defmodule ExDoc.Formatter.HTML.Autolink do @kernel_function_strings for {f, a} <- kernel_exports, do: "#{f}/#{a}" @special_form_strings for {f, a} <- special_form_exports, do: "#{f}/#{a}" + @doc """ Compiles information used during autolinking. """ @@ -542,29 +394,27 @@ defmodule ExDoc.Formatter.HTML.Autolink do end end - @doc """ - Helper function for autolinking functions and modules. - - It autolinks all links for a certain `language` and of a certain `kind`. - - `language` can be: `:elixir`, `:erlang` or `:markdown`. - - `kind` is either `:function` or `:module`. - - It accepts a list of `options` used in the replacement functions. - - `:aliases - - `:docs_refs` - - `:extension` - Default value is `".html"` - - `:lib_dirs` - - `:locals` - A list of local functions - - `:module_id` - Module of the current doc. Default value is `nil` - - `:modules_refs` - List of modules available - - Internal options: - - `:preprocess?` - `true` or `false`. Do preprocessing and postprocessing, such as replacing backticks - with a token - - """ + # Helper function for autolinking functions and modules. + # + # It autolinks all links for a certain `language` and of a certain `kind`. + # + # `language` can be: `:elixir`, `:erlang` or `:markdown`. + # + # `kind` is either `:function` or `:module`. + # + # It accepts a list of `options` used in the replacement functions. + # - `:aliases + # - `:docs_refs` + # - `:extension` - Default value is `".html"` + # - `:lib_dirs` + # - `:locals` - A list of local functions + # - `:module_id` - Module of the current doc. Default value is `nil` + # - `:modules_refs` - List of modules available + # + # Internal options: + # - `:preprocess?` - `true` or `false`. Do preprocessing and postprocessing, such as replacing backticks + # with a token + @doc false @spec link(String.t(), language, kind, keyword) :: String.t() def link(string, language, kind, options) do options = Keyword.put_new(options, :preprocess?, true) @@ -883,4 +733,149 @@ defmodule ExDoc.Formatter.HTML.Autolink do defp get_elixir_docs(aliases, lib_dirs) do get_source(Kernel, aliases, lib_dirs) end + + ## REGULAR EXPRESSION HELPERS + + # Returns a the string source of a regular expression, + # given the `name` and `language` + defp re_source(name, language \\ :elixir) do + Regex.source(re(name, language)) + end + + # Returns a regular expression + # given the `name` and `language` + defp re(name, language \\ :elixir) + + defp re(:prefix, :elixir) do + ~r{ + [ct]: # c:, t: + }x + end + + defp re(:m, :elixir) do + ~r{ + ( [A-Z] # start with uppercase letter + [_a-zA-Z0-9]*\.? # followed by optional letter, number or underscore + )+ # this pattern could be repeated + (?~*^@\\+\\%\\!-\/]+ # special_form + }x + end + + defp re(:f, :erlang) do + ~r{ + # TODO: revise the erlang rules for function names + [0-9a-zA-Z_!\\?]+ + }x + end + + defp re(:fa, language) when language in [:elixir, :erlang] do + ~r{ + (#{re_source(:f, language)}) # function_name + /\d+ # /arity + }x + end + + defp re(:mfa, :elixir) do + ~r{ + (#{re_source(:prefix)})? # optional callback/type identifier or ":" + ( + (#{re_source(:m)}\.) + #{re_source(:fa)} + ) + }x + end + + defp re(:mfa, :erlang) do + ~r{ + #{re_source(:m, :erlang)} # module_name + \. # "." + #{re_source(:fa, :erlang)} # function_name/arity + }x + end + + defp re(:local, :elixir) do + ~r{ + (#{re_source(:prefix)})? # optional callback or type identifier + #{re_source(:fa)} # function_name/arity + }x + end + + defp re(:modules, :elixir) do + ~r{ + #{re_source(:m)} + }x + end + + defp re(:modules, :erlang) do + ~r{ + #{re_source(:m, :erlang)} + }x + end + + defp re(:functions, :elixir) do + ~r{ + (#{re_source(:local)}) | (#{re_source(:mfa)}) + }x + end + + defp re(:functions, :erlang) do + ~r{ + #{re_source(:mfa, :erlang)} + }x + end + + defp re({:normal_link, function_re_source}, :markdown) do + ~r{ + (? :functions + :module -> :modules + end + + case link_type do + :normal -> + re({:normal_link, re_source(group, language)}, :markdown) + + :custom -> + re({:custom_link, re_source(group, language)}, :markdown) + end + end end diff --git a/test/ex_doc/formatter/html/syntax_rule_test.exs b/test/ex_doc/formatter/html/syntax_rule_test.exs deleted file mode 100644 index 657e27c08..000000000 --- a/test/ex_doc/formatter/html/syntax_rule_test.exs +++ /dev/null @@ -1,88 +0,0 @@ -defmodule ExDoc.Formatter.HTML.SyntaxRuleTest do - use ExUnit.Case, async: true - - import ExDoc.Formatter.HTML.SyntaxRule - import Regex, only: [run: 2] - - describe "Elixir: basic parts" do - test "prefix" do - assert ["t:"] = run(re(:prefix), "t:term()") - assert ["c:"] = run(re(:prefix), "c:GenServer.c:init/1") - refute run(re(:prefix), ":binary.cp()") - end - - test "modules" do - refute run(re(:m), "module.fun/1") - assert "Module" == run_hd(re(:m), "Module.fun/1") - assert "Module.Some" == run_hd(re(:m), "Module.Some.fun/1") - end - - test "functions" do - assert "fun" == run_hd(re(:f), "`fun/1`") - assert "is_FUN_99?" == run_hd(re(:f), "`is_FUN_99?/1`") - - assert "fun/11" == run_hd(re(:fa), "`fun/11`") - assert "is_FUN_99?/11" == run_hd(re(:fa), "`is_FUN_99?/11`") - end - - test "special forms" do - assert "/" == run_hd(re(:f), "`/2`") - assert "." == run_hd(re(:f), "`.2`") - assert "__ENV__" == run_hd(re(:f), "`__ENV__/0`") - end - end - - describe "Erlang: basic parts" do - test "modules" do - refute run(re(:m, :erlang), "MODULE.FUN/1") - assert ":module" == run_hd(re(:m, :erlang), ":module.fun/1") - assert ":module_some" == run_hd(re(:m, :erlang), ":module_some.fun/1") - end - - test "functions" do - assert "fun" == run_hd(re(:f, :erlang), "`fun/1`") - assert "is_FUN_99?!" == run_hd(re(:f, :erlang), "`is_FUN_99?!/1`") - - assert "is_fun_99/123" == run_hd(re(:fa, :erlang), "`is_fun_99/123`") - end - - test "mfa" do - assert ":my_erlang_module.is_fun!/123" == - run_hd(re(:mfa, :erlang), "`:my_erlang_module.is_fun!/123`") - end - end - - describe "links" do - test "normal links - Elixir" do - mfa = re_source(:mfa) - refute run(re({:normal_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") - assert run(re({:normal_link, mfa}, :markdown), "`Mod.example/1`") - end - - test "custom links - Elixir" do - mfa = re_source(:mfa) - - assert "[`example`](`Mod.example/1`)" == - run_hd(re({:custom_link, mfa}, :markdown), "[`example`](`Mod.example/1`)") - end - - test "normal links - Erlang" do - mfa = re_source(:mfa, :erlang) - refute run(re({:normal_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") - assert run_hd(re({:normal_link, mfa}, :markdown), "`:mod.example/1`") - end - - test "custom links - Erlang" do - mfa = re_source(:mfa, :erlang) - - assert "[`example`](`:mod.example/1`)" == - run_hd(re({:custom_link, mfa}, :markdown), "[`example`](`:mod.example/1`)") - - refute run(re({:custom_link, mfa}, :markdown), "`:mod.example/1`") - end - end - - defp run_hd(regex, string) do - hd(Regex.run(regex, string)) - end -end From 8c2d3d02cf565dccf9e35c7b4f9d0f98048f3be3 Mon Sep 17 00:00:00 2001 From: eksperimental Date: Mon, 10 Sep 2018 23:15:22 +0700 Subject: [PATCH 6/7] remove warning --- lib/ex_doc/formatter/html/autolink.ex | 3 --- 1 file changed, 3 deletions(-) diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index e7afe48ba..d9afe4df2 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -75,7 +75,6 @@ defmodule ExDoc.Formatter.HTML.Autolink do @kernel_function_strings for {f, a} <- kernel_exports, do: "#{f}/#{a}" @special_form_strings for {f, a} <- special_form_exports, do: "#{f}/#{a}" - @doc """ Compiles information used during autolinking. """ @@ -744,8 +743,6 @@ defmodule ExDoc.Formatter.HTML.Autolink do # Returns a regular expression # given the `name` and `language` - defp re(name, language \\ :elixir) - defp re(:prefix, :elixir) do ~r{ [ct]: # c:, t: From 8e42565b5e99dae72d06781a2a2117ab68ec5bbc Mon Sep 17 00:00:00 2001 From: eksperimental Date: Wed, 12 Sep 2018 21:42:14 +0700 Subject: [PATCH 7/7] Fix bug replacing backtick inside custom links The regex was too greedy --- bin/ex_doc | 1 + lib/ex_doc/formatter/html/autolink.ex | 83 ++++++++++++-------- test/ex_doc/formatter/html/autolink_test.exs | 50 +++++++++++- 3 files changed, 102 insertions(+), 32 deletions(-) diff --git a/bin/ex_doc b/bin/ex_doc index bdfca0aba..3a913059d 100755 --- a/bin/ex_doc +++ b/bin/ex_doc @@ -1,5 +1,6 @@ #!/usr/bin/env elixir mix_env = System.get_env["MIX_ENV"] || "dev" + Code.prepend_path Path.expand("../_build/#{mix_env}/lib/nimble_parsec/ebin", __DIR__) Code.prepend_path Path.expand("../_build/#{mix_env}/lib/makeup/ebin", __DIR__) Code.prepend_path Path.expand("../_build/#{mix_env}/lib/makeup_elixir/ebin", __DIR__) diff --git a/lib/ex_doc/formatter/html/autolink.ex b/lib/ex_doc/formatter/html/autolink.ex index d9afe4df2..84d0cef59 100644 --- a/lib/ex_doc/formatter/html/autolink.ex +++ b/lib/ex_doc/formatter/html/autolink.ex @@ -8,8 +8,7 @@ defmodule ExDoc.Formatter.HTML.Autolink do @type kind :: :function | :module @type link_type :: :normal | :custom - @backtick_replacement "" - + @backtick_token "" @elixir_docs "https://hexdocs.pm/" @erlang_docs "http://www.erlang.org/doc/man/" @basic_types_page "typespecs.html#basic-types" @@ -418,33 +417,25 @@ defmodule ExDoc.Formatter.HTML.Autolink do def link(string, language, kind, options) do options = Keyword.put_new(options, :preprocess?, true) - string = - if options[:preprocess?] do - preprocess(string) - else - string - end - - string = - string - |> link(language, kind, :normal, options) - |> link(language, kind, :custom, options) - - string = - if options[:preprocess?] do - postprocess(string) - else - string - end - string + |> link_process(:preprocess, options[:preprocess?]) + |> link(language, kind, :custom, options) + |> link(language, kind, :normal, options) + |> link_process(:postprocess, options[:preprocess?]) end - defp link(string, language, kind, link_type, options) do + @doc false + @spec link(String.t(), language, link_type, kind, keyword) :: String.t() + def link(string, language, kind, link_type, options) do regex = regex_link_type(language, kind, link_type) replace_fun = replace_fun(language, kind, link_type, options) - Regex.replace(regex, string, replace_fun) + result = link_process(string, :preprocess, options[:preprocess?]) + result = Regex.replace(regex, result, replace_fun) + result = link_process(result, :postprocess, options[:preprocess?]) + + # output([before: string, after: result], options[:module_id], [Version, "Version"]) + result end @doc false @@ -463,28 +454,55 @@ defmodule ExDoc.Formatter.HTML.Autolink do }, acc -> link(acc, language, kind, link_type, options) + # link(acc, language, kind, options) end) postprocess(string) end - # Replaces all backticks inside the text of custom links with @backtick_replacement. - defp preprocess(string) do + defp link_process(string, _, false), + do: string + + defp link_process(string, :preprocess, true), + do: preprocess(string) + + defp link_process(string, :postprocess, true), + do: postprocess(string) + + defp output(term, module_id, module_id) do + IO.puts(inspect(term)) + exit(:output) + term + end + + # used temporarily for debugging + defp output(term, module_id, print_only_module_list) do + if module_id in print_only_module_list do + IO.puts(inspect(term)) + IO.puts("****************") + end + + term + end + + @doc false + # Replaces all backticks inside the text of custom links with @backtick_token. + def preprocess(string) do regex = ~r{ - \[(.*?`.*?)\] - \((.*?)\) + \[([^\]]*?`[^\]]*?)\] + \(([^\)]*?)\) }x Regex.replace(regex, string, fn _all, text, link -> - new_text = String.replace(text, :binary.compile_pattern("`"), @backtick_replacement) + new_text = String.replace(text, :binary.compile_pattern("`"), @backtick_token) "[#{new_text}](#{link})" end) end + @doc false # Reverts the changes done by `preprocess/1`. - defp postprocess(string) do - String.replace(string, :binary.compile_pattern(@backtick_replacement), "`") - # string + def postprocess(string) do + String.replace(string, :binary.compile_pattern(@backtick_token), "`") end @doc false @@ -875,4 +893,7 @@ defmodule ExDoc.Formatter.HTML.Autolink do re({:custom_link, re_source(group, language)}, :markdown) end end + + @doc false + def backtick_token(), do: @backtick_token end diff --git a/test/ex_doc/formatter/html/autolink_test.exs b/test/ex_doc/formatter/html/autolink_test.exs index a871a281b..c5c3d9225 100644 --- a/test/ex_doc/formatter/html/autolink_test.exs +++ b/test/ex_doc/formatter/html/autolink_test.exs @@ -160,7 +160,7 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do end test "autolinks types" do - # use the same approach for elixir_functions as for localss + # use the same approach for elixir_functions as for locals assert Autolink.elixir_functions( "`t:MyModule.my_type/0`", ["t:MyModule.my_type/0"] @@ -248,6 +248,17 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do assert Autolink.elixir_functions("[`term()`](`t:term/0`)", []) == "[`term()`](#{@elixir_docs}elixir/typespecs.html#built-in-types)" + + assert Autolink.elixir_functions("[version](`t:Version.version/0`)", ["t:Version.version/0"]) == + "[version](Version.html#t:version/0)" + + assert Autolink.link_everything("[version](`t:Version.version/0`)", + docs_refs: ["t:Version.version/0"] + ) == "[version](Version.html#t:version/0)" + + # assert Autolink.link_everything("[version](`t:version/0`)", [locals: ["t:Version.version/0"]]) == + assert Autolink.link_everything("[version](`t:version/0`)", locals: ["t:version/0"]) == + "[version](#t:version/0)" end end @@ -570,4 +581,41 @@ defmodule ExDoc.Formatter.HTML.AutolinkTest do {actual, _} = Autolink.format_and_extract_typespec_placeholders(ast, typespecs, aliases, []) assert actual == expected, "Original: #{original}\nExpected: #{expected}\nActual: #{actual}" end + + describe "backtick preprocessing" do + test "replace backticks" do + assert Autolink.preprocess("[`===/2`](foo)") === + "[#{Autolink.backtick_token()}===/2#{Autolink.backtick_token()}](foo)" + end + + test "do not touch backticks" do + assert Autolink.preprocess("`===/2`") === "`===/2`" + assert Autolink.preprocess("(`===/2`)") === "(`===/2`)" + assert Autolink.preprocess("(foo)[`Module`]") === "(foo)[`Module`]" + + # this tests for a bug in the regex that it was being too greedy and streaching several links + string = """ + A [version](`t:version/0`) is a [string](`t:String.t/0`) in a specific + format or a [version](`t:Version.t/0`) struct + generated after parsing a version string with `Version.parse/1`. + """ + + assert Autolink.preprocess(string) === string + end + + test "replace backtick tokens" do + assert Autolink.postprocess( + "[#{Autolink.backtick_token()}===/2#{Autolink.backtick_token()}](foo)" + ) === "[`===/2`](foo)" + + string = """ + [A `version` is](`t:version/0`) a [beautiful `string` in a](`t:String.t/0`) specific + format or a [`version`](`t:Version.t/0`) struct + generated after parsing a version string with `Version.parse/1`. + """ + + refute Autolink.preprocess(string) === string + assert Autolink.preprocess(string) |> Autolink.postprocess() === string + end + end end