From bf887e3971050fbee522bc53a132e698b40f4ad6 Mon Sep 17 00:00:00 2001 From: Kiko Fernandez-Reyes Date: Wed, 3 Jan 2024 08:39:46 +0100 Subject: [PATCH] compiler: conversor from markdown to erlang+html documentation attributes are written in markdown and this parser consumes markdown doc attributes and emits erlang+html. when someone types the `h(mod)`, `shell_docs.erl` converts the markdown documentation attribute to erlang+html, since `shell_docs.erl` knows how to interpret this format. --- erts/doc/src/erlang_system_info.md | 2 +- lib/compiler/src/beam_doc.erl | 4 +- lib/compiler/src/cerl.erl | 2 +- lib/stdlib/src/Makefile | 1 + lib/stdlib/src/shell_docs.erl | 44 +- lib/stdlib/src/shell_docs_markdown.erl | 897 +++++++++++++ lib/stdlib/src/stdlib.app.src | 1 + lib/stdlib/test/Makefile | 1 + lib/stdlib/test/shell_docs_SUITE.erl | 42 +- lib/stdlib/test/shell_docs_markdown_SUITE.erl | 1123 +++++++++++++++++ 10 files changed, 2091 insertions(+), 26 deletions(-) create mode 100644 lib/stdlib/src/shell_docs_markdown.erl create mode 100644 lib/stdlib/test/shell_docs_markdown_SUITE.erl diff --git a/erts/doc/src/erlang_system_info.md b/erts/doc/src/erlang_system_info.md index 65a90dc5097e..fd14d661d5bb 100644 --- a/erts/doc/src/erlang_system_info.md +++ b/erts/doc/src/erlang_system_info.md @@ -270,7 +270,7 @@ Returns information about the default process heap settings: `garbage_collection` described below. - `garbage_collection`{: #system_info_garbage_collection } - Returns - `t:garbage_collection_defaults()` describing the default garbage collection settings. + `t:garbage_collection_defaults/0` describing the default garbage collection settings. A process spawned on the local node by a `spawn` or `spawn_link` uses these garbage collection settings. The default settings can be changed by using [`erlang:system_flag/2`](`erlang:system_flag/2`). diff --git a/lib/compiler/src/beam_doc.erl b/lib/compiler/src/beam_doc.erl index e2b7d0dc805f..a9a9d31abce7 100644 --- a/lib/compiler/src/beam_doc.erl +++ b/lib/compiler/src/beam_doc.erl @@ -1077,10 +1077,10 @@ fetch_doc_and_anno(#docs{docs = DocsMap}=State, {Attr, Anno0, F, A, _Args}) -> {_, {Doc1, Anno}} -> {Doc1, Anno} end. --spec fun_to_varargs(tuple() | term()) -> list(term()). +-spec fun_to_varargs(tuple() | term()) -> dynamic(). fun_to_varargs({type, _, bounded_fun, [T|_]}) -> fun_to_varargs(T); -fun_to_varargs({type, _, 'fun', [{type,_,product,Args}|_] }) -> +fun_to_varargs({type, _, 'fun', [{type,_,product,Args}|_] }) when is_list(Args) -> map(fun fun_to_varargs/1, Args); fun_to_varargs({ann_type, _, [Name|_]}) -> Name; diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 9a23567ff585..99eaa6867bc6 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -50,7 +50,7 @@ function `type/1`. > we do not give any guarantees on how an abstract syntax tree may or may not be > represented, _with the following exceptions_: no syntax tree is represented by a > single atom, such as `none`, by a list constructor `[X | Y]`, or by the empty ->list `[]`. This can be relied on when writing functions that operate on syntax +> list `[]`. This can be relied on when writing functions that operate on syntax > trees. """. diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index cd6d5241cfaa..9423528573b2 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -121,6 +121,7 @@ MODULES= \ shell \ shell_default \ shell_docs \ + shell_docs_markdown \ slave \ sofs \ string \ diff --git a/lib/stdlib/src/shell_docs.erl b/lib/stdlib/src/shell_docs.erl index 665cab680d03..99d372b8b323 100644 --- a/lib/stdlib/src/shell_docs.erl +++ b/lib/stdlib/src/shell_docs.erl @@ -69,7 +69,7 @@ be rendered as is. %% Used by chunks.escript in erl_docgen -export([validate/1, normalize/1, supported_tags/0]). -%% Convinience functions +%% Convenience functions -export([get_doc/1, get_doc/3, get_type_doc/3, get_callback_doc/3]). -export_type([chunk_elements/0, chunk_element_attr/0]). @@ -81,7 +81,7 @@ be rendered as is. columns }). --define(ALL_ELEMENTS,[a,p,'div',br,h1,h2,h3,h4,h5,h6, +-define(ALL_ELEMENTS,[a,p,'div',blockquote,br,h1,h2,h3,h4,h5,h6, i,b,em,strong,pre,code,ul,ol,li,dl,dt,dd]). %% inline elements are: -define(INLINE,[i,b,em,strong,code,a]). @@ -89,7 +89,7 @@ be rendered as is. orelse ((ELEM) =:= i) orelse ((ELEM) =:= em) orelse ((ELEM) =:= b) orelse ((ELEM) =:= strong))). %% non-inline elements are: --define(BLOCK,[p,'div',pre,br,ul,ol,li,dl,dt,dd,h1,h2,h3,h4,h5,h6]). +-define(BLOCK,[p,'div',pre,blockquote,br,ul,ol,li,dl,dt,dd,h1,h2,h3,h4,h5,h6]). -define(IS_BLOCK(ELEM),not ?IS_INLINE(ELEM)). -define(IS_PRE(ELEM),(((ELEM) =:= pre))). @@ -130,7 +130,7 @@ The configuration of how the documentation should be rendered. -doc "The HTML tags allowed in `application/erlang+html`.". -type chunk_element_type() :: chunk_element_inline_type() | chunk_element_block_type(). -type chunk_element_inline_type() :: a | code | em | strong | i | b. --type chunk_element_block_type() :: p | 'div' | br | pre | ul | +-type chunk_element_block_type() :: p | 'div' | blockquote | br | pre | ul | ol | li | dl | dt | dd | h1 | h2 | h3 | h4 | h5 | h6. @@ -155,7 +155,7 @@ This function can be used to do a basic validation of the doc content of validate(Module) when is_atom(Module) -> {ok, Doc} = code:get_doc(Module), validate(Doc); -validate(#docs_v1{ module_doc = MDocs, docs = AllDocs }) -> +validate(#docs_v1{ format = ?NATIVE_FORMAT, module_doc = MDocs, docs = AllDocs }) -> %% Check some macro in-variants AE = lists:sort(?ALL_ELEMENTS), @@ -437,7 +437,7 @@ normalize_paragraph(Elems) -> -doc false. -spec get_doc(Module :: module()) -> chunk_elements(). get_doc(Module) -> - {ok, #docs_v1{ module_doc = ModuleDoc } = D } = code:get_doc(Module), + {ok, #docs_v1{ module_doc = ModuleDoc } = D} = code:get_doc(Module), get_local_doc(Module, ModuleDoc, D). -doc false. @@ -449,7 +449,7 @@ get_doc(Module) -> Signature :: [binary()], Metadata :: map(). get_doc(Module, Function, Arity) -> - {ok, #docs_v1{ docs = Docs } = D } = code:get_doc(Module), + {ok, #docs_v1{ docs = Docs } = D} = code:get_doc(Module), FnFunctions = lists:filter(fun({{function, F, A},_Anno,_Sig,_Doc,_Meta}) -> F =:= Function andalso A =:= Arity; @@ -488,7 +488,7 @@ as `render(Module, Function, Docs)`. Function :: atom(), Docs :: docs_v1(), Res :: unicode:chardata() | {error,function_missing}. -render(Module, #docs_v1{ module_doc = ModuleDoc } = D, Config) +render(Module, #docs_v1{module_doc = ModuleDoc} = D, Config) when is_atom(Module), is_map(Config) -> render_headers_and_docs([[{h2,[],[<<"\t",(atom_to_binary(Module))/binary>>]}]], get_local_doc(Module, ModuleDoc, D), D, Config); @@ -519,7 +519,7 @@ as `render(Module, Function, Arity, Docs)`. Arity :: arity(), Docs :: docs_v1(), Res :: unicode:chardata() | {error,function_missing}. -render(Module, Function, #docs_v1{ docs = Docs } = D, Config) +render(Module, Function, #docs_v1{docs = Docs} = D, Config) when is_atom(Module), is_atom(Function), is_map(Config) -> render_function( lists:filter(fun({{function, F, _},_Anno,_Sig,_Doc,_Meta}) -> @@ -539,14 +539,14 @@ render(_Module, Function, Arity, #docs_v1{ } = D) -> Docs :: docs_v1(), Config :: config(), Res :: unicode:chardata() | {error,function_missing}. -render(Module, Function, Arity, #docs_v1{ docs = Docs } = D, Config) +render(Module, Function, Arity, #docs_v1{ docs = Docs }=DocV1, Config) when is_atom(Module), is_atom(Function), is_integer(Arity), is_map(Config) -> render_function( lists:filter(fun({{function, F, A},_Anno,_Sig,_Doc,_Meta}) -> F =:= Function andalso A =:= Arity; (_) -> false - end, Docs), D, Config). + end, Docs), DocV1, Config). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% API function for dealing with the type documentation @@ -560,7 +560,7 @@ render(Module, Function, Arity, #docs_v1{ docs = Docs } = D, Config) Signature :: [binary()], Metadata :: map(). get_type_doc(Module, Type, Arity) -> - {ok, #docs_v1{ docs = Docs } = D } = code:get_doc(Module), + {ok, #docs_v1{ docs = Docs } = D} = code:get_doc(Module), FnFunctions = lists:filter(fun({{type, T, A},_Anno,_Sig,_Doc,_Meta}) -> T =:= Type andalso A =:= Arity; @@ -658,7 +658,7 @@ render_type(_Module, Type, Arity, #docs_v1{ docs = Docs } = D, Config) -> Signature :: [binary()], Metadata :: map(). get_callback_doc(Module, Callback, Arity) -> - {ok, #docs_v1{ docs = Docs } = D } = code:get_doc(Module), + {ok, #docs_v1{ docs = Docs } = D} = code:get_doc(Module), FnFunctions = lists:filter(fun({{callback, T, A},_Anno,_Sig,_Doc,_Meta}) -> T =:= Callback andalso A =:= Arity; @@ -745,6 +745,9 @@ render_callback(_Module, Callback, Arity, #docs_v1{ docs = Docs } = D, Config) - end, Docs), D, Config). %% Get the docs in the correct locale if it exists. +-spec get_local_doc(atom() | tuple() | binary(), Docs, D) -> term() when + Docs :: map() | none | hiddden, + D :: docs_v1(). get_local_doc(MissingMod, Docs, D) when is_atom(MissingMod) -> get_local_doc(atom_to_binary(MissingMod), Docs, D); get_local_doc({F,A}, Docs, D) -> @@ -767,6 +770,8 @@ get_local_doc(Missing, None, _D) when None =:= none; None =:= #{} -> normalize_format(Docs, #docs_v1{ format = ?NATIVE_FORMAT }) -> normalize(Docs); +normalize_format(Docs, #docs_v1{ format = <<"text/markdown">> }) when is_binary(Docs) -> + normalize(shell_docs_markdown:parse_md(Docs)); normalize_format(Docs, #docs_v1{ format = <<"text/", _/binary>> }) when is_binary(Docs) -> [{pre, [], [Docs]}]. @@ -775,7 +780,7 @@ render_function([], _D, _Config) -> {error,function_missing}; render_function(FDocs, D, Config) when is_map(Config) -> render_function(FDocs, D, init_config(D, Config)); -render_function(FDocs, #docs_v1{ docs = Docs } = D, Config) -> +render_function(FDocs, #docs_v1{ docs = Docs } = DocV1, Config) -> Grouping = lists:foldl( fun({_Group,_Anno,_Sig,_Doc,#{ equiv := Group }} = Func, Acc) -> @@ -798,15 +803,15 @@ render_function(FDocs, #docs_v1{ docs = Docs } = D, Config) -> end, Members) of {value, {_,_,_,Doc,_Meta}} -> render_headers_and_docs( - Signatures, get_local_doc(Group, Doc, D), D, Config); + Signatures, get_local_doc(Group, Doc, DocV1), DocV1, Config); false -> case lists:keyfind(Group, 1, Docs) of false -> render_headers_and_docs( - Signatures, get_local_doc(Group, none, D), D, Config); + Signatures, get_local_doc(Group, none, DocV1), DocV1, Config); {_,_,_,Doc,_} -> render_headers_and_docs( - Signatures, get_local_doc(Group, Doc, D), D, Config) + Signatures, get_local_doc(Group, Doc, DocV1), DocV1, Config) end end end, lists:reverse(Grouping)). @@ -933,8 +938,7 @@ init_config(D, Config) -> render_docs(Elems,State,Pos,Ind,D) when is_list(Elems) -> lists:mapfoldl(fun(Elem,P) -> -%%% io:format("Elem: ~p (~p) (~p,~p)~n",[Elem,State,P,Ind]), - render_docs(Elem,State,P,Ind,D) + render_docs(Elem,State,P,Ind,D) end,Pos,Elems); render_docs(Elem,State,Pos,Ind,D) -> render_element(Elem,State,Pos,Ind,D). @@ -985,6 +989,8 @@ render_element({Elem,_Attr,_Content} = E,State,Pos,Ind,D) when Pos > Ind, ?IS_BL render_element({'div',[{class,What}],Content},State,Pos,Ind,D) -> {Docs,_} = render_docs(Content, ['div'|State], 0, Ind+2, D), trimnlnl([pad(Ind - Pos),string:titlecase(What),":\n",Docs]); +render_element({blockquote,_Attr,Content},State,_Pos,Ind,D) -> + trimnlnl(render_docs(Content, ['div'|State], 0, Ind+2, D)); render_element({Tag,_,Content},State,Pos,Ind,D) when Tag =:= p; Tag =:= 'div' -> trimnlnl(render_docs(Content, [Tag|State], Pos, Ind, D)); diff --git a/lib/stdlib/src/shell_docs_markdown.erl b/lib/stdlib/src/shell_docs_markdown.erl new file mode 100644 index 000000000000..c0307f3e9a1b --- /dev/null +++ b/lib/stdlib/src/shell_docs_markdown.erl @@ -0,0 +1,897 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(shell_docs_markdown). + +-moduledoc false. +%% this module is expected to be consumed by `shell_docs.erl`. +%% any output from `process_md/1` may not correspond 1-to-1 to +%% a common conversion from markdown to Erlang+HTML. +%% the end goal is that the output can be pretty printed correctly. + +-export([parse_md/1]). + +%% Valid inline prefixes, e.g., t:my_type() +-define(INLINE_PREFIX(X), (X =:= $t orelse X =:= $m orelse X =:= $e orelse X =:= $c)). + +%% Allowed lists and their ways to capture them +-define(IS_BULLET(X), (X =:= $* orelse X =:= $- orelse X =:= $+)). +-define(IS_NUMBERED(X), (is_integer(X) andalso min(0, X) =:= 0)). + +%% Parsing format symbols and symbols separators between formats +-define(VALID_BREAK(Symb), (Symb =:= $\s orelse Symb =:= $\n orelse Symb =:= <<>>)). +-define(VALID_SEPARATOR(Symb), (?VALID_BREAK(Symb) orelse ?VALID_PUNCTUATION(Symb))). +-define(VALID_FORMAT(Format), (Format =:= $* orelse Format =:= $_)). +-define(VALID_ESCAPED(Char), + ((Char) =:= $! orelse (Char) =:= $" orelse (Char) =:= $# orelse (Char) =:= $$ + orelse (Char) =:= $% orelse (Char) =:= $& orelse (Char) =:= $' orelse (Char) =:= $( + orelse (Char) =:= $\) orelse (Char) =:= $* orelse (Char) =:= $+ orelse (Char) =:= $, + orelse (Char) =:= $- orelse (Char) =:= $. orelse (Char) =:= $/ orelse (Char) =:= $: + orelse (Char) =:= $; orelse (Char) =:= $< orelse (Char) =:= $= orelse (Char) =:= $> + orelse (Char) =:= $? orelse (Char) =:= $@ orelse (Char) =:= $[ orelse (Char) =:= $\\ + orelse (Char) =:= $] orelse (Char) =:= $^ orelse (Char) =:= $_ orelse (Char) =:= $` + orelse (Char) =:= ${ orelse (Char) =:= $| orelse (Char) =:= $} orelse (Char) =:= $~ + )). +-define(VALID_PUNCTUATION(Symb), + (Symb =:= $. orelse Symb =:= $, orelse + Symb =:= $( orelse Symb =:= $) orelse + Symb =:= $: orelse Symb =:= $;)). + +-spec parse_md(Doc0 :: binary()) -> Doc1 :: shell_docs:chunk_elements(). +parse_md(Doc) when is_binary(Doc) -> + %% remove links from [this form][1] to [this form]. + Doc1 = re:replace(Doc, ~b"\\[([^\\]]*?)\\]\\[(.*?)\\]", "\\1", [{return, binary}, global]), + + Lines = binary:split(Doc1, [<<"\r\n">>, <<"\n">>], [global]), + AST = parse_md(Lines, []), + format_line(AST). + +%% Formats a line +-spec format_line(Input :: shell_docs:chunk_elements()) -> Result :: shell_docs:chunk_elements(). +format_line(Ls) -> + format_line(Ls, sets:new()). + +-spec format_line(Input, OmissionSet) -> Result when + Input :: shell_docs:chunk_elements(), + Result :: shell_docs:chunk_elements(), + OmissionSet :: sets:set(atom()). +format_line([], _BlockSet0) -> + []; +format_line([{Tag, [], List} | Rest], BlockSet0) -> + case format_line(List, sets:add_element(Tag, BlockSet0)) of + [] -> + format_line(Rest, BlockSet0); + Ls -> + [{Tag, [], Ls}] ++ format_line(Rest, BlockSet0) + end; +format_line([Bin | Rest], BlockSet0) when is_binary(Bin) -> + %% Ignores formatting these elements + Restriction = sets:from_list([h1, h2, h3, h4, h5, h6, pre]), + + case sets:is_disjoint(Restriction, BlockSet0) of + true -> + case format_inline(create_paragraph(Bin)) of + {p, [], []} -> + %% ignore empty paragraphs + %% they can happen if the line only contains links + %% that are removed, so no content exists + format_line(Rest, BlockSet0); + B -> + [B | format_line(Rest, BlockSet0)] + end; + false -> + [Bin | format_line(Rest, BlockSet0)] + end. + + +-spec parse_md(Markdown, HtmlErlang) -> HtmlErlang when + Markdown :: [binary()], + HtmlErlang :: shell_docs:chunk_elements(). +parse_md([], Block) -> + Block; + +parse_md([<<" ", Line/binary>> | Rest], Block) -> + Block ++ process_code([<<" ", Line/binary>> | Rest], []); + +%% +%% Lists and paragraphs +%% +parse_md(Rest, Block) when is_list(Rest) -> + process_rest(Rest, Block). + +process_table([<<$|, _Data/binary>>=Header, Delimiter | Rest]) -> + maybe + {true, Fields} ?= check_start_closing_table(Header), + {true, Fields} ?= is_delimiter(Delimiter), + {DataRows, NotTable} ?= extract_body(Rest, Fields), + Table = lists:map(fun(Line) -> <> end, [Header, Delimiter | DataRows]), + {[create_table(Table)], NotTable} + else + false -> + error; + {true, _DiffFieldNumber} -> + error + end; +process_table(_) -> + %% The table either misses a delimiter or data rows, + %% which makes it an invalid table + error. + + +is_delimiter(<<$|, Line/binary>>) -> + NoSpacesBin = re:replace(Line, ~b"(\s|:)", <<>>, [{return, binary}, global]), + is_delimiter(NoSpacesBin, 0); +is_delimiter(_A) -> + false. + +is_delimiter(<<>>, Count) -> + {true, Count}; +is_delimiter(<<$|, Line/binary>>, Count) -> + is_delimiter(Line, Count + 1); +is_delimiter(<<$-, Line/binary>>, Count) -> + is_delimiter(Line, Count); +is_delimiter(_Bin, _Count) -> + false. + +extract_body([], _Fields) -> + {[], []}; +extract_body([<<>> | Rest], _Fields) -> + {[], Rest}; +extract_body([<<$|, _/binary>>=Line | Rest], Fields) -> + maybe + {true, Fields} ?= check_start_closing_table(Line), + {Row, Rest1} ?= extract_body(Rest, Fields), + {[Line | Row], Rest1} + else + _E -> + false + end; +extract_body(Rest, _Fields) when is_list(Rest) -> + {[], Rest}. + + +check_start_closing_table(Line) -> + Line1 = re:replace(Line, ~b"(\s)", <<>>, [{return, binary}, global]), + FirstBar = binary:first(Line1), + LastBar = binary:last(Line1), + case FirstBar =:= $| andalso LastBar =:= $| of + true -> + SkipVerbatimSlash = length(binary:matches(Line, ~"\\|")), + {true, length(binary:matches(Line, ~"|")) - SkipVerbatimSlash - 1}; + false -> + false + end. + +process_rest([P | Rest], Block) -> + process_list_or_p(P, Rest, Block). + +detect_rest(<>) when ?IS_BULLET(BulletList) -> + ul; +detect_rest(<>) when ?IS_NUMBERED(NumberedList) -> + ol; +detect_rest(_) -> + p. + +process_list_or_p(P, Rest, Block) -> + {StrippedP, SpaceCount} = strip_spaces(P, 0, infinity), + case detect_rest(StrippedP) of + List when List =:= ul; + List =:= ol -> + {Content, Rest1} = process_list(List, P, Rest, SpaceCount, Block), + Content ++ parse_md(Rest1, []); + _ -> + %% Note: It could be that some text has been indented + %% further than normal. If there is some rendering issue, + %% maybe here we need to strip P from spaces and re-run parse_md(P). + %% Not an issue, so far. + process_kind_block([StrippedP | Rest], Block) + end. + +process_list(Format, LineContent, Rest, SpaceCount, Block) -> + {Content, Rest1} = create_list(Format, [LineContent | Rest], SpaceCount, Block), + {Block ++ [create_item_list(Format, lists:reverse(Content))], Rest1}. + +create_item_list(ul, Items) when is_list(Items) -> + ul(Items); +create_item_list(ol, Items) when is_list(Items) -> + ol(Items). + +ul(Items) when is_list(Items) -> + {ul, [], Items}. + +ol(Items) when is_list(Items) -> + {ol, [], Items}. + +li(Items) when is_list(Items)-> + {li, [], Items}. + +create_list(Format, [Line | Rest], SpaceCount, Acc) -> + process_block(Format, [Line | Rest], SpaceCount, Acc). + +process_block(_Format, [], _SpaceCount, Acc) -> + {lists:reverse(Acc), []}; +process_block(Format, [Line | Rest], SpaceCount, Acc) -> + {Content, RemainingRest, Done} = get_next_block(Format, [Line | Rest], SpaceCount, Acc), + Items = case Content of + L when L =:= []; L =:= Acc -> + []; + _ -> + [li(parse_md(lists:reverse(Content), [])) | Acc] + end, + case Done of + true -> + {Items, RemainingRest}; + false -> + {Items2, Rest2} = process_block(Format, RemainingRest, SpaceCount, []), + {Items2 ++ Items, Rest2} + end. + +get_next_block(_Format, [], _SpaceCount, Acc) -> + {Acc, [], true}; +get_next_block(Format, [Line | Rest], SpaceCount, Acc) -> + {Stripped, NextCount} = strip_spaces(Line, 0, infinity), + case detect_next_kind(Format, Stripped, Rest, SpaceCount, NextCount) of + next -> + {NewLine, _} = strip_spaces(Line, 0, min(NextCount, 2)), + %% Try to remove extra space padding from line, so that when + %% the accumulated lines are processed by process_md, + %% there is no extra space to take into account. + %% + %% Example: + %% + %% ~"- ```erlang + %% foo() -> ok. + %% ```" + %% is seen by process_md later on as + %% ~"```erlang + %% foo() -> ok. + %% ```" + %% This step tries to to always remove extra space padding. + %% This is because markdown is not consistent in the spacing rules + %% and when we mix positioning of list blocks where the space + %% matters with places where space does not, it becomes ambiguous + %% to parse correctly. + %% + %% Example 2: + %% + %% ~" - First line in list + %% second line in list + %% and continue here" + %% + get_next_block(Format, Rest, SpaceCount, [NewLine | Acc]); + done -> + {Acc, [Line | Rest], true}; + list -> + {Acc, [strip_list_line(Stripped) | Rest], false} + end. + +detect_list_format_change(State, ExpectedFormat, Line, SpaceCount, NextCount) -> + ListType = detect_rest(Line), + case ExpectedFormat =:= ListType orelse ListType =:= p of + false when NextCount =< SpaceCount -> + done; + _ -> + State + end. + +detect_next_kind(Format, Line, Rest, SpaceCount, NextCount) -> + State = process_next_kind(Line, Rest, SpaceCount, NextCount), + detect_list_format_change(State, Format, Line, SpaceCount, NextCount). + +process_next_kind(<>, _, _SpaceCount, _NextCount) + when ?IS_BULLET(BulletFormat) -> + %% Important: otherwise it may consider the symbol to mean + %% a setext heading underline, when it was a mistake to ignore + list; +process_next_kind(<>, _, SpaceCount, NextCount) + when ?IS_BULLET(BulletFormat) andalso (NextCount =< SpaceCount) -> + list; +process_next_kind(<>, _, SpaceCount, NextCount) + when ?IS_NUMBERED(OrderedFormat) andalso (NextCount =< SpaceCount) -> + list; +process_next_kind(<<>>, [<<$\s, _/binary>> | _], _SpaceCount, _NextCount) -> + next; +process_next_kind(<<>>, _, _, _) -> + done; +process_next_kind(_A, _B, _C, _D) -> + next. + +strip_list_line(Line) -> + case Line of + <> + when ?IS_BULLET(BulletFormat) -> + %% Important: otherwise it may consider the symbol to mean + %% a setext heading underline, when it was a mistake to ignore + <<>>; + <> + when ?IS_BULLET(BulletFormat) -> + strip_list_line(Continuation); + <> + when ?IS_NUMBERED(OrderedFormat) -> + strip_list_line(Continuation); + <> + when ?IS_NUMBERED(OrderedFormat) -> + strip_list_line(Continuation); + _ -> + Line + end. + +%% +%% Headings +%% +process_kind_block([<<" ", Line/binary>> | Rest], Block) -> + process_kind_block([Line | Rest], Block); +process_kind_block([<<"# ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 1, + Block ++ process_heading(HeadingLevel, Heading, Rest); +process_kind_block([<<"## ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 2, + Block ++ process_heading(HeadingLevel, Heading, Rest); +process_kind_block([<<"### ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 3, + Block ++ process_heading(HeadingLevel, Heading, Rest); +process_kind_block([<<"#### ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 4, + Block ++ process_heading(HeadingLevel, Heading, Rest); +process_kind_block([<<"##### ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 5, + Block ++ process_heading(HeadingLevel, Heading, Rest); +process_kind_block([<<"###### ", Heading/binary>> | Rest], Block) -> + HeadingLevel = 6, + Block ++ process_heading(HeadingLevel, Heading, Rest); + +%% +%% Quotes where +%% +process_kind_block([<<">", _/binary>>=Line | Rest], Block) -> + Block ++ process_quote([Line | Rest], []); + +%% +%% process block code +%% +process_kind_block([<<"```", _Line/binary>> | Rest], Block) -> + Block ++ process_fence_code(Rest, []); +%% +%% New line +%% +process_kind_block([<<"">> | Rest], Block) -> + Block ++ parse_md(Rest, []); +%% +%% Comments +%% +process_kind_block([<<"">>) of + [_] -> + % Line is just comment, process next line + case process_comment(Rest) of + [] -> + %% closing comment not found + error(missing_close_comment); + Result -> + Result + end; + [_Comment, Text] -> + % Skip comment, return text plus continuation line + [Text | Rest] + end. + +-spec create_paragraph(Line) -> P when + Line :: binary(), + P :: p(). +create_paragraph(<<$\s, Line/binary>>) -> + create_paragraph(Line); +create_paragraph(Line) when is_binary(Line) -> + p(Line). + +-spec create_code(Lines :: [binary()]) -> code(). +create_code(CodeBlocks) when is_list(CodeBlocks) -> + %% assumes that the code block is in reverse order + Bin = trim_and_add_new_line(CodeBlocks), + {pre,[], [{code,[], [Bin]}]}. + +create_table(Table) when is_list(Table) -> + {pre,[], [{code,[], Table}]}. + + +-spec quote(Quote :: list()) -> quote(). +quote(List) when is_list(List) -> + {blockquote, [], List}. + +-spec p(Line :: binary()) -> p(). +p(X) when is_binary(X) -> + {p, [], [X]}. + +-spec code_inline(Text :: shell_docs:chunk_elements()) -> code_inline(). +code_inline(X) when is_list(X) -> + {code, [], X}. + +-spec i(Text :: shell_docs:chunk_elements()) -> i(). +i(X) when is_list(X) -> + {i, [], X}. + +-spec em(Text :: shell_docs:chunk_elements()) -> em(). +em(X) when is_list(X) -> + {em, [], X}. + +%% Assumes that the list is reversed, so Last is the last element. +-spec trim_and_add_new_line([binary()]) -> binary(). +trim_and_add_new_line([]) -> + ~"\n"; +trim_and_add_new_line(Lines) when is_list(Lines) -> + trim_and_add_new_line(Lines, <<>>). + +trim_and_add_new_line([], Acc) when is_binary(Acc) -> + Acc; +trim_and_add_new_line([Line | Rest], Acc) when is_binary(Line), is_binary(Acc) -> + Line1 = re:replace(Line, ~b"(\n|\r\n)", <<>>, [{return, binary}, global]), + trim_and_add_new_line(Rest, <>). diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 6db3bff7d4fa..ce919c92f1c5 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -101,6 +101,7 @@ shell, shell_default, shell_docs, + shell_docs_markdown, slave, sofs, string, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 1c19315e8a73..55d9acbdb7e3 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -88,6 +88,7 @@ MODULES= \ naughty_child \ shell_SUITE \ shell_docs_SUITE \ + shell_docs_markdown_SUITE \ sigils_SUITE \ supervisor_SUITE \ supervisor_bridge_SUITE \ diff --git a/lib/stdlib/test/shell_docs_SUITE.erl b/lib/stdlib/test/shell_docs_SUITE.erl index 8fc8eff95cbc..dd613d15eb91 100644 --- a/lib/stdlib/test/shell_docs_SUITE.erl +++ b/lib/stdlib/test/shell_docs_SUITE.erl @@ -133,26 +133,30 @@ render_smoke(_Config) -> E(shell_docs:render(Mod, D, Config)), E(shell_docs:render_type(Mod, D, Config)), E(shell_docs:render_callback(Mod, D, Config)), + Exports = try Mod:module_info(exports) catch _:undef -> [] end, %% nif file not available on this platform + DHTML = markdown_to_shelldoc(D), [try - E(shell_docs:render(Mod, F, A, D, Config)) + E(shell_docs:render(Mod, F, A, DHTML, Config)) catch _E:R:ST -> io:format("Failed to render ~p:~p/~p~n~p:~p~n~p~n", [Mod,F,A,R,ST,shell_docs:get_doc(Mod,F,A)]), erlang:raise(error,R,ST) end || {F,A} <- Exports], + [try - E(shell_docs:render_type(Mod, T, A, D, Config)) + E(shell_docs:render_type(Mod, T, A, DHTML, Config)) catch _E:R:ST -> io:format("Failed to render type ~p:~p/~p~n~p:~p~n~p~n", [Mod,T,A,R,ST,shell_docs:get_type_doc(Mod,T,A)]), erlang:raise(error,R,ST) end || {{type,T,A},_,_,_,_} <- Docs], + [try - E(shell_docs:render_callback(Mod, T, A, D, Config)) + E(shell_docs:render_callback(Mod, T, A, DHTML, Config)) catch _E:R:ST -> io:format("Failed to render callback ~p:~p/~p~n~p:~p~n~p~n", [Mod,T,A,R,ST,shell_docs:get_callback_doc(Mod,T,A)]), @@ -172,6 +176,38 @@ render_smoke(_Config) -> end), ok. +markdown_to_shelldoc(#docs_v1{format = Format}=Docs) -> + DefaultFormat = <<"text/markdown">>, + DFormat = binary_to_list(DefaultFormat), + case Format of + _ when Format =:= DefaultFormat orelse Format =:= DFormat -> + ModuleDoc = Docs#docs_v1.module_doc, + Doc = Docs#docs_v1.docs, + Docs#docs_v1{format = ?NATIVE_FORMAT, + module_doc = process_moduledoc(ModuleDoc), + docs = process_doc_attr(Doc)}; + _ -> + Docs + end. + +-spec process_moduledoc(Doc :: map() | none | hidden) -> map() | none | hidden. +process_moduledoc(Doc) when Doc =:= none orelse Doc =:= hidden -> + Doc; +process_moduledoc(Doc) when is_map(Doc) -> + maps:map(fun (_K, V) -> shell_docs_markdown:parse_md(V) end, Doc). + +process_doc_attr(Doc) -> + lists:map(fun process_doc/1, Doc). + +process_doc(Docs) when is_list(Docs) -> + lists:map(fun process_doc/1, Docs); +process_doc({_At, _A, _S, Doc, _M}=Entry) when Doc =:= none orelse Doc =:= hidden -> + Entry; +process_doc({Attributes, Anno, Signature, Doc, Metadata}) -> + Docs = maps:map(fun (_K, V) -> shell_docs_markdown:parse_md(V) end, Doc), + {Attributes, Anno, Signature, Docs, Metadata}. + + render_prop(Config) -> % dbg:tracer(),dbg:p(all,c),dbg:tpl(shell_docs_prop,[]), ct_property_test:quickcheck( diff --git a/lib/stdlib/test/shell_docs_markdown_SUITE.erl b/lib/stdlib/test/shell_docs_markdown_SUITE.erl new file mode 100644 index 000000000000..116c4ba6ccc0 --- /dev/null +++ b/lib/stdlib/test/shell_docs_markdown_SUITE.erl @@ -0,0 +1,1123 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(shell_docs_markdown_SUITE). + +%% callbacks +-export([all/0, groups/0, init_per_group/2, end_per_group/2]). + +%% test format +-export([convert_erlang_html/1, convert_unknown_format/1]). + +%% test non-existing moduledoc +-export([non_existing_moduledoc/1,hidden_moduledoc/1,existing_moduledoc/1]). + +%% test non-existing docs +-export([non_existing_doc/1, hidden_doc/1, existing_doc/1]). + +%% headings +-export([h1_test/1, h2_test/1, h3_test/1, h4_test/1, h5_test/1, h6_test/1, + setext_h1/1, setext_h2/1]). + +%% quotes +-export([single_line_quote_test/1, double_char_for_quote_test/1, + ignore_three_spaces_before_quote/1, multiple_line_quote_test/1, + paragraph_in_between_test/1, quote_with_anchor_test/1, quote_without_space/1]). + +%% paragraph +-export([paragraph_after_heading_test/1, quote_before_and_after_paragraph_test/1]). + +%% inline code +-export([single_line_code_test/1, multiple_line_code_test/1, paragraph_between_code_test/1]). + +%% fence code +-export([single_line_fence_code_test/1, multiple_line_fence_code_test/1, + paragraph_between_fence_code_test/1, fence_code_ignores_link_format_test/1, + fence_code_with_spaces/1]). + +%% br +-export([start_with_br_test/1, multiple_br_followed_by_paragraph_test/1, + multiple_lines_of_a_paragraph_test/1, ending_br_test/1]). + +%% Comments +-export([begin_comment_test/1, after_paragraph_comment/1, forget_closing_comment/1 ]). + +%% Format +-export([format_heading_test/1, format_paragraph_test/1, format_multiple_inline/1, + format_multiple_inline_format_short/1, format_multiple_inline_format_long/1, + format_multiple_inline_format_mixed/1, unmatched_format_simple/1, + unmatched_format_with_inline/1, unmatched_complex_format_with_inline/1, + format_inline_link_with_inline/1, complex_inline_format/1, skip_symbols_in_inline/1, + format_header_identifier/1, italic_in_middle_word_test/1, italic_with_colons/1, + list_format_with_italics_in_sentence/1, list_format_with_bold_in_sentence/1, + new_lines_test/1, format_separator_test/1, list_with_format/1, multi_word_format_test/1, + multiline_link/1, multiline_link_not_allowed/1, inline_mfa_link/1, + escaped_character/1]). + +%% Bullet lists +-export([singleton_bullet_list/1, singleton_bullet_list_followed_new_paragraph/1, singleton_bullet_list_with_format/1, + singleton_bullet_list_followed_inner_paragraph/1, singleton_bullet_list_followed_inner_paragraph2/1, + singleton_bullet_list_followed_inner_paragraph3/1, multiline_bullet_indented_list/1, multiline_bullet_indented_list2/1, + multiline_bullet_list/1, even_nested_bullet_list/1, odd_nested_bullet_list/1, + complex_nested_bullet_list/1, complex_nested_bullet_list2/1, complex_nested_bullet_list3/1, + bullet_list_mix_with_number_list/1, inline_code_list/1, bullet_list_with_anchor/1]). + +%% Numbered lists +-export([singleton_numbered_list/1, singleton_numbered_list_followed_new_paragraph/1, + singleton_numbered_list_with_format/1, singleton_numbered_list_followed_inner_paragraph/1, + singleton_numbered_list_followed_inner_paragraph2/1, multiline_numbered_indented_list/1, + multiline_numbered_indented_list2/1, multiline_numbered_list/1, even_nested_numbered_list/1, + odd_nested_numbered_list/1]). + +-export([table_with_rows/1, table_with_escaped_bars/1, fake_table_test/1]). + +-define(ERLANG_HTML, ~"application/erlang+html"). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/eep48.hrl"). +-include_lib("stdlib/include/assert.hrl"). + + +-define(EXPECTED_FUN(Expected), {{function, foo, 0}, [], [], Expected, #{}}). + +all() -> + [{group, different_format_generator}, + {group, module_generator}, + {group, doc_generator}, + {group, header_generator}, + {group, quote_generator}, + {group, paragraph_generator}, + {group, code_generator}, + {group, fence_code_generator}, + {group, br_generator}, + {group, comment_generator}, + {group, format_generator}, + {group, bullet_list_generator}, + {group, numbered_list_generator}, + {group, table_generator} + ]. + +groups() -> + [{different_format_generator, [sequence], different_format_conversion_tests()}, + {module_generator, [sequence], moduledoc_tests()}, + {doc_generator, [sequence], doc_tests()}, + {header_generator, [sequence], header_tests()}, + {quote_generator, [sequence], quote_tests()}, + {paragraph_generator, [sequence], paragraph_tests()}, + {code_generator, [sequence], code_tests()}, + {fence_code_generator, [sequence], fence_code_tests()}, + {br_generator, [sequence], br_tests()}, + {comment_generator, [sequence], comment_tests()}, + {format_generator, [sequence], format_tests()}, + {bullet_list_generator, [sequence], bullet_list_tests()}, + {numbered_list_generator, [sequence], numbered_list_tests()}, + {table_generator, [sequence], table_tests()} + ]. + +init_per_group(_, Config) -> + Config. + +end_per_group(_, _Config) -> + ok. + +different_format_conversion_tests() -> + [ convert_erlang_html, + convert_unknown_format + ]. + +moduledoc_tests() -> + [ non_existing_moduledoc, + hidden_moduledoc, + existing_moduledoc + ]. + +doc_tests() -> + [ non_existing_doc, + hidden_doc, + existing_doc + ]. + +header_tests() -> + [ h1_test, + h2_test, + h3_test, + h4_test, + h5_test, + h6_test, + setext_h1, + setext_h2 + ]. + +quote_tests() -> + [ single_line_quote_test, + double_char_for_quote_test, + ignore_three_spaces_before_quote, + multiple_line_quote_test, + paragraph_in_between_test, + quote_with_anchor_test, + quote_without_space + ]. + +paragraph_tests() -> + [ paragraph_after_heading_test, + quote_before_and_after_paragraph_test + ]. + +code_tests() -> + [ single_line_code_test, + multiple_line_code_test, + paragraph_between_code_test + ]. + +fence_code_tests() -> + [single_line_fence_code_test, + multiple_line_fence_code_test, + paragraph_between_fence_code_test, + fence_code_ignores_link_format_test, + fence_code_with_spaces + ]. + +br_tests() -> + [ start_with_br_test, + multiple_br_followed_by_paragraph_test, + multiple_lines_of_a_paragraph_test, + ending_br_test + ]. + +comment_tests() -> + [ begin_comment_test, + after_paragraph_comment, + forget_closing_comment + ]. + +format_tests() -> + [ format_heading_test, + format_paragraph_test, + format_multiple_inline, + format_multiple_inline_format_long, + format_multiple_inline_format_short, + format_multiple_inline_format_mixed, + unmatched_format_simple, + unmatched_format_with_inline, + unmatched_complex_format_with_inline, + format_inline_link_with_inline, + complex_inline_format, + skip_symbols_in_inline, + format_header_identifier, + italic_in_middle_word_test, + italic_with_colons, + list_format_with_italics_in_sentence, + list_format_with_bold_in_sentence, + new_lines_test, + format_separator_test, + list_with_format, + multi_word_format_test, + multiline_link, + multiline_link_not_allowed, + inline_mfa_link, + escaped_character + ]. + +bullet_list_tests() -> + [ singleton_bullet_list, + singleton_bullet_list_followed_new_paragraph, + singleton_bullet_list_with_format, + singleton_bullet_list_followed_inner_paragraph, + singleton_bullet_list_followed_inner_paragraph2, + singleton_bullet_list_followed_inner_paragraph3, + multiline_bullet_indented_list, + multiline_bullet_indented_list2, + multiline_bullet_list, + even_nested_bullet_list, + odd_nested_bullet_list, + complex_nested_bullet_list, + complex_nested_bullet_list2, + complex_nested_bullet_list3, + bullet_list_mix_with_number_list, + inline_code_list, + bullet_list_with_anchor + ]. + +numbered_list_tests() -> + [ singleton_numbered_list, + singleton_numbered_list_followed_new_paragraph, + singleton_numbered_list_with_format, + singleton_numbered_list_followed_inner_paragraph, + singleton_numbered_list_followed_inner_paragraph2, + multiline_numbered_indented_list, + multiline_numbered_indented_list2, + multiline_numbered_list, + even_nested_numbered_list, + odd_nested_numbered_list + ]. + +table_tests() -> + [ table_with_rows, + table_with_escaped_bars, + fake_table_test]. + +convert_erlang_html(_Conf) -> + Doc = #{~"en" => [{p, [], [~"Test"]}]}, + Functions = [{{function, foo, 0}, [], [], Doc, #{}}], + + Docs = create_eep48(erlang, ?ERLANG_HTML, none, #{}, Functions), + ok = shell_docs:validate(Docs), + ok. + +convert_unknown_format(_Conf) -> + Doc = #{~"en" => ~"Here"}, + Functions = create_fun(Doc), + + Docs = create_eep48(erlang, ~"xml", Doc, #{},Functions), + ok = try + shell_docs:validate(Docs) + catch + error:function_clause -> + ok + end, + ok. + +non_existing_moduledoc(_Conf) -> + Docs = create_eep48(erlang, ~"application/erlang+html", none, #{}, []), + _ = compile(Docs), + ok. + +hidden_moduledoc(_Conf) -> + Docs = create_eep48(erlang, ~"application/erlang+html", hidden, #{}, []), + _ = compile(Docs), + ok. + +existing_moduledoc(_Conf) -> + Docs = create_eep48_doc(~"# Here"), + HtmlDocs = compile(Docs), + #{~"en" := HtmlModDoc} = extract_moduledoc(HtmlDocs), + H1 = header(1, ~"Here"), + [H1] = HtmlModDoc, + ok. + +non_existing_doc(_Conf) -> + Docs = create_eep48(erlang, ~"application/erlang+html", none, #{}, create_fun(none)), + ok = shell_docs:validate(Docs), + ok. + +hidden_doc(_Conf) -> + Docs = create_eep48(erlang, ~"application/erlang+html", none, #{}, create_fun(hidden)), + ok = shell_docs:validate(Docs), + ok. + +existing_doc(_Conf) -> + Docs = create_eep48_doc(~"Test"), + ok = shell_docs:validate(Docs), + ok. + +h1_test(_Conf) -> + Input = ~"# Here", + Result = [header(1, ~"Here")], + compile_and_compare(Input, Result). + +h2_test(_Conf) -> + Input = ~"# Here\n## Header 2", + Result = [header(1, ~"Here"), header(2,~"Header 2")], + compile_and_compare(Input, Result). + +h3_test(_Conf) -> + Input = ~"# Here\n### Header 3", + Result = [header(1, ~"Here"), header(3, ~"Header 3")], + compile_and_compare(Input, Result). + +h4_test(_Conf) -> + Input = ~"### Here\n#### Header 4", + Result = [header(3, ~"Here"), header(4, ~"Header 4")], + compile_and_compare(Input, Result). + +h5_test(_Conf) -> + Convert = fun shell_docs_markdown:parse_md/1, + Doc = #{~"en" => Convert(~"### Here\n#### Header 4\n##### H5")}, + DocH5 = #{~"en" => Convert(~"##### H5")}, + Functions = [{{function, foo, 0}, [], [], Doc, #{}}, + {{function, bar, 0}, [], [], DocH5, #{}}], + Docs = create_eep48(erlang, ~"application/erlang+html", Doc, #{}, Functions), + + HtmlDocs = compile(Docs), + ExpectedH3 = #{~"en" => [ header(3, ~"Here"), + header(4, ~"Header 4"), + header(5, ~"H5")]}, + ExpectedH5 = #{~"en" => [ header(5, ~"H5") ]}, + ExpectedH3 = extract_moduledoc(HtmlDocs), + [ E1, E2 ] = extract_doc(HtmlDocs), + {{function, foo, 0}, [], [], ExpectedH3, #{}} = E1, + {{function, bar, 0}, [], [], ExpectedH5, #{}} = E2, + ok. + +h6_test(_Conf) -> + Convert = fun shell_docs_markdown:parse_md/1, + Doc = #{~"en" => Convert(~"### Here\n#### Header 4\n##### H5")}, + DocH6 = #{~"en" => Convert(~"###### H6\n## H2")}, + Functions = [{{function, foo, 0}, [], [], Doc, #{}}, + {{function, bar, 0}, [], [], DocH6, #{}}], + Docs = create_eep48(erlang, ~"application/erlang+html", Doc, #{}, Functions), + + HtmlDocs = compile(Docs), + ExpectedH3 = #{~"en" => [ header(3, ~"Here"), + header(4, ~"Header 4"), + header(5, ~"H5")]}, + ExpectedH6 = #{~"en" => [ header(6, ~"H6"), + header(2, ~"H2")]}, + ExpectedH3 = extract_moduledoc(HtmlDocs), + [ E1, E2 ] = extract_doc(HtmlDocs), + {{function, foo, 0}, [], [], ExpectedH3, #{}} = E1, + {{function, bar, 0}, [], [], ExpectedH6, #{}} = E2, + ok. + +setext_h1(_Config) -> + Input = ~"Here\n===\n\nNew text", + Result = [ header(1, ~"Here"), + p(~"New text")], + compile_and_compare(Input, Result). + +setext_h2(_Config) -> + Input = ~"Here\n--\n\nNew text", + Result = [ header(2, ~"Here"), + p(~"New text")], + compile_and_compare(Input, Result). + +single_line_quote_test(_Conf) -> + Input = ~"# Here\n> This is a quote", + Result = [ header(1, ~"Here"), + blockquote(p(~"This is a quote"))], + compile_and_compare(Input, Result). + +double_char_for_quote_test(_Conf) -> + Input = ~"# Here\n>> This is a quote", + Result = [ header(1, ~"Here"), + blockquote(p(~"This is a quote"))], + compile_and_compare(Input, Result). + +ignore_three_spaces_before_quote(_Conf) -> + Input = ~" > # Here", + Result = blockquote([header(1, ~"Here")]), + compile_and_compare(Input, Result). + +multiple_line_quote_test(_Conf) -> + Input = ~"> # Here\n> This is a quote", + Result = [ blockquote([header(1, ~"Here"), + p(~"This is a quote")])], + compile_and_compare(Input, Result). + +paragraph_in_between_test(_Conf) -> + Input = ~"# Header 1\nThis is text\n> A quote\n> continues\n## Header 2\nBody content", + Result = [ header(1, ~"Header 1"), + p(~"This is text"), + blockquote([p(~"A quote continues")]), + header(2, ~"Header 2"), + p(~"Body content")], + compile_and_compare(Input, Result). + +quote_with_anchor_test(_Config) -> + Input = +~"> #### Note{: .info } +> +> The [User's Guide](index.html) has examples and a +> [Getting Started](using_ssh.md) section.", + Result = [blockquote([header(4,~"Note"), + p([~"The User's Guide has examples and a Getting Started section."])])], + compile_and_compare(Input, Result). + +quote_without_space(_Config) -> + Input = +~"> #### Note{: .info } +> +>The [User's Guide](index.html) has examples and a +> [Getting Started](using_ssh.md) section.", + Result = [blockquote([header(4,~"Note"), + p([~"The User's Guide has examples and a Getting Started section."])])], + compile_and_compare(Input, Result). + +paragraph_after_heading_test(_Conf) -> + Input = ~"# Header 1\nThis is text\n\nBody content", + Result = [ header(1, ~"Header 1"), + p(~"This is text"), + p(~"Body content")], + compile_and_compare(Input, Result). + +quote_before_and_after_paragraph_test(_Conf) -> + Input = ~"> Quote 1\nThis is text\n> Quote 2\nBody content", + Result = [ blockquote(p(~"Quote 1")), + p(~"This is text"), + blockquote(p(~"Quote 2")), + p(~"Body content")], + compile_and_compare(Input, Result). + +single_line_code_test(_Conf) -> + Input = ~"# Here\n This is code", + Result = [ header(1, ~"Here"), + code(~"This is code\n")], + compile_and_compare(Input, Result). + +multiple_line_code_test(_Conf) -> + Input = ~" # Here\n This is code\n Nested Line", + Result = code(~"# Here\nThis is code\n Nested Line\n"), + compile_and_compare(Input, Result). + +paragraph_between_code_test(_Conf) -> + Input = <<"This is a paragraph\n", + "\n", + " # Here\n", + " This is code\n", + " Nested Line\n", + "Another paragraph">>, + Result = [ p(~"This is a paragraph"), + code(~"# Here\nThis is code\n Nested Line\n"), + p(~"Another paragraph")], + compile_and_compare(Input, Result). + +single_line_fence_code_test(_Conf) -> + Input = ~" +```erlang +test() -> ok. +```", + Result = [ code(~"test() -> ok.\n")], + compile_and_compare(Input, Result). + +multiple_line_fence_code_test(_Conf) -> + Input = ~" +```erlang +test() -> + ok. +```", + Result = [ code(~"test() ->\n ok.\n")], + compile_and_compare(Input, Result). + + +paragraph_between_fence_code_test(_Conf) -> + Input = ~"This is a test: +```erlang +test() -> + ok. +```", + Result = [p(~"This is a test:"), + code(~"test() ->\n ok.\n")], + compile_and_compare(Input, Result). + +fence_code_ignores_link_format_test(_Conf) -> + Input = ~"This is a test: +```erlang +[foo](bar) +```", + Result = [p(~"This is a test:"), + code(~"[foo](bar)\n")], + compile_and_compare(Input, Result). + +fence_code_with_spaces(_Config) -> + Input = +~" ```erlang + [foo](bar) +```", + Result = [code(~" [foo](bar)\n")], + compile_and_compare(Input, Result). + +start_with_br_test(_Conf) -> + Input = ~"\n\nAnother paragraph", + Result = [ p(~"Another paragraph")], + compile_and_compare(Input, Result). + +multiple_br_followed_by_paragraph_test(_Conf) -> + Input = ~"\nAnother paragraph\n\nAnother paragraph", + Result = [ p(~"Another paragraph"), + p(~"Another paragraph")], + compile_and_compare(Input, Result). + +multiple_lines_of_a_paragraph_test(_Conf) -> + Input = ~""" +Returns a new list `List3`, which is made from the elements of `List1` followed +by the elements of `List2`. +""", + Result = [p([~"Returns a new list ", + inline_code(~"List3"), + ~", which is made from the elements of ", + inline_code(~"List1"), ~" followed by the elements of ", + inline_code(~"List2"), ~"."])], + compile_and_compare(Input, Result). + +ending_br_test(_Conf) -> + Input = ~"Test\n", + Result = [ p(~"Test")], + compile_and_compare(Input, Result). + +begin_comment_test(_Conf) -> + Input = ~"Test", + Result = [ p(~"Test")], + compile_and_compare(Input, Result). + +after_paragraph_comment(_Conf) -> + Input = ~"Test\nTest", + Result = [ p(~"Test"), p(~"Test")], + compile_and_compare(Input, Result). + +forget_closing_comment(_Conf) -> + ok = try + create_eep48_doc(~"Test\n