diff --git a/src/markdown/dune b/src/markdown/dune new file mode 100644 index 0000000000..16895dd483 --- /dev/null +++ b/src/markdown/dune @@ -0,0 +1,6 @@ +(library + (name odoc_markdown) + (public_name odoc.markdown) + (instrumentation + (backend bisect_ppx)) + (libraries odoc_model odoc_document)) diff --git a/src/markdown/generator.ml b/src/markdown/generator.ml new file mode 100644 index 0000000000..91cd850e22 --- /dev/null +++ b/src/markdown/generator.ml @@ -0,0 +1,382 @@ +open Odoc_document +open Types +open Doctree + +module Markup : sig + type t + + val noop : t + + val break : t + + val nbsp : t + + val space : t + + val backticks : t + + val open_sq_bracket : t + + val close_sq_bracket : t + + val ( ++ ) : t -> t -> t + + val concat : t list -> t + + val inline' : string list -> t + + val block' : t list -> t + + val list : ?sep:t -> t list -> t + + val anchor' : string -> t + + val string : string -> t + + val str : ('a, unit, string, t) format4 -> 'a + + val escaped : ('a, unit, string, t) format4 -> 'a + + val open_parenthesis : t + + val close_parenthesis : t + + val pp : Format.formatter -> t -> unit +end = struct + type t = + | Block of t list + | Concat of t list + | Break + | Space + | Anchor of string + | String of string + | Backticks + | Nbsp + | OpenSqBracket + | CloseSqBracket + | OpenParenthesis + | CloseParenthesis + + let noop = Concat [] + + let break = Break + + let nbsp = Nbsp + + let space = Space + + let backticks = Backticks + + let open_sq_bracket, close_sq_bracket = (OpenSqBracket, CloseSqBracket) + + let open_parenthesis, close_parenthesis = (OpenParenthesis, CloseParenthesis) + + let append t1 t2 = + match (t1, t2) with + | Concat l1, Concat l2 -> Concat (l1 @ l2) + | Concat l1, e2 -> Concat (l1 @ [ e2 ]) + | e1, Concat l2 -> Concat (e1 :: l2) + | e1, e2 -> Concat [ e1; e2 ] + + let ( ++ ) = append + + let concat ts = Concat ts + + let rec intersperse ~sep = function + | [] -> [] + | [ h ] -> [ h ] + | h1 :: (_ :: _ as t) -> h1 :: sep :: intersperse ~sep t + + let list ?(sep = Concat []) l = concat @@ intersperse ~sep l + + let anchor' s = Anchor s + + let string s = String s + + let block' ts = Block ts + + let inline' l = List.map (fun s -> string s) l |> concat + + let str fmt = Format.ksprintf (fun s -> string s) fmt + + let escaped fmt = Format.ksprintf (fun s -> string s) fmt + + let rec pp fmt t = + match t with + | Block b -> + let inner = function + | [] -> () + | [ x ] -> Format.fprintf fmt "%a" pp x + | x :: xs -> Format.fprintf fmt "%a@\n%a" pp x pp (Block xs) + in + inner b + | Concat l -> pp_many fmt l + | Break -> Format.fprintf fmt "@\n" + | Space -> Format.fprintf fmt " " + | Anchor s -> Format.fprintf fmt "" s + | String s -> Format.fprintf fmt "%s" s + (* We use double backticks to take care of polymorphic variants or content + within backtick, and the spaces before and after the backticks for + clarity on what should be enclosed in backticks. For example, + "type nums = [ | `One | `Two ]" would be rendered as "``|`````Monday`` " + if the spaces were missing. + *) + | Backticks -> Format.fprintf fmt " `` " + | Nbsp -> Format.fprintf fmt "\u{00A0}" + | OpenSqBracket -> Format.fprintf fmt "[" + | CloseSqBracket -> Format.fprintf fmt "]" + | OpenParenthesis -> Format.fprintf fmt "(" + | CloseParenthesis -> Format.fprintf fmt ")" + + and pp_many fmt l = List.iter (pp fmt) l +end + +open Markup + +let entity e = + match e with "#45" -> escaped "-" | "gt" -> str ">" | s -> str "&%s;" s + +let raw_markup (_ : Raw_markup.t) = noop + +let style (style : style) content = + match style with + | `Bold -> string "**" ++ (content ++ str "**") + | `Italic | `Emphasis -> string "_" ++ (content ++ str "_") + | `Superscript -> string "" ++ content + | `Subscript -> string "" ++ content + +let make_hashes n = String.make n '#' + +type args = { generate_links : bool ref; md_flavour : string ref } + +let args = { generate_links = ref true; md_flavour = ref "" } + +let rec source_code (s : Source.t) nbsp = + match s with + | [] -> noop + | h :: t -> ( + let continue s = if s = [] then concat [] else source_code s nbsp in + match h with + | Source.Elt i -> inline i nbsp ++ continue t + | Tag (None, s) -> continue s ++ continue t + | Tag (Some _, s) -> continue s ++ continue t) + +and inline (l : Inline.t) nbsp = + match l with + | [] -> noop + | i :: rest -> ( + let continue i = if i = [] then noop else inline i nbsp in + let make_link c s = + open_sq_bracket ++ continue c ++ close_sq_bracket ++ open_parenthesis + ++ string s ++ close_parenthesis ++ continue rest + in + let cond then_clause else_clause = + if !(args.generate_links) then then_clause else else_clause + in + match i.desc with + | Text "" -> continue rest + | Text s -> ( + match s with + | "end" | "}" | "]" -> + string (make_hashes 6) ++ space ++ nbsp ++ string s + | _ -> + let l, _, rest = + Doctree.Take.until l ~classify:(function + | { Inline.desc = Text s; _ } -> Accum [ str "%s" s ] + | _ -> Stop_and_keep) + in + concat l ++ continue rest) + | Entity e -> + let x = entity e in + x ++ continue rest + | Styled (sty, content) -> style sty (continue content) ++ continue rest + | Linebreak -> break ++ continue rest + | Link (href, content) -> + cond + (match content with + | [] -> noop + | i :: rest -> + (match i.desc with + | Text _ -> make_link content href + | _ -> continue content ++ continue rest) + ++ continue rest) + (continue content ++ continue rest) + | InternalLink (Resolved (link, content)) -> + cond + (match link.page.parent with + | Some _ -> continue content ++ continue rest + | None -> make_link content (make_hashes 1 ^ link.anchor)) + (continue content ++ continue rest) + | InternalLink (Unresolved content) -> continue content ++ continue rest + | Source content -> + cond + (source_code content nbsp ++ continue rest) + (backticks ++ source_code content nbsp ++ backticks ++ continue rest) + | Raw_markup t -> raw_markup t ++ continue rest) + +let rec block (l : Block.t) nbsp = + match l with + | [] -> noop + | b :: rest -> ( + let continue r = if r = [] then noop else block r nbsp in + match b.desc with + | Inline i -> inline i nbsp ++ continue rest + | Paragraph i -> inline i nbsp ++ break ++ continue rest + | List (list_typ, l) -> + let f n b = + let bullet = + match list_typ with + | Unordered -> escaped "- " + | Ordered -> str "%d. " (n + 1) + in + bullet ++ block b nbsp ++ break + in + list ~sep:break (List.mapi f l) ++ continue rest + | Description _ -> + let descrs, _, rest = + Take.until l ~classify:(function + | { Block.desc = Description l; _ } -> Accum l + | _ -> Stop_and_keep) + in + let f i = + let key = inline i.Description.key nbsp in + let def = block i.Description.definition nbsp in + break ++ str "@" ++ key ++ str " : " ++ def ++ break ++ break + in + list ~sep:break (List.map f descrs) ++ continue rest + | Source content -> source_code content nbsp ++ continue rest + | Verbatim content -> + space ++ space ++ space ++ space ++ str "%s" content ++ continue rest + | Raw_markup t -> raw_markup t ++ continue rest) + +let heading { Heading.label; level; title } nbsp = + let title = inline title nbsp in + let level = + match level with + | 1 -> make_hashes 1 + | 2 -> make_hashes 2 + | 3 -> make_hashes 3 + | 4 -> make_hashes 4 + | 5 -> make_hashes 5 + | 6 -> make_hashes 6 + | _ -> "" + (* We can be sure that h6 will never be exceded! *) + in + match label with + | Some label -> ( + let label = str " {#%s}" label in + (* `---` forms a horizontal line below heading, except level one headings (h1)*) + let sep = str "---" in + let heading' level = string level ++ space ++ title in + let cond then_clause else_clause = + if !(args.md_flavour) = "pandoc" then then_clause else else_clause + in + match level with + (* This match forms a horizontal line below the heading (for readability reasons), + however, we ignore `h1` heading because by default a line is formed below it. *) + | "#" -> cond (heading' level ++ label) (heading' level) + | _ -> + cond + (heading' level ++ label ++ break ++ sep) + (heading' level ++ break ++ sep)) + | None -> string level ++ title + +let inline_subpage = function + | `Inline | `Open | `Default -> true + | `Closed -> false + +let item_prop nbsp = string (make_hashes 6) ++ space ++ nbsp + +let rec documented_src (l : DocumentedSrc.t) nbsp nbsp' = + match l with + | [] -> noop + | line :: rest -> ( + let continue r = if r = [] then noop else documented_src r nbsp nbsp' in + match line with + | Code c -> source_code c nbsp' ++ continue rest + | Alternative alt -> ( + match alt with Expansion e -> documented_src e.expansion nbsp nbsp') + | Subpage p -> subpage p.content nbsp ++ continue rest + | Documented _ | Nested _ -> + let lines, _, rest = + Take.until l ~classify:(function + | DocumentedSrc.Documented { code; doc; anchor; _ } -> + Accum [ (`D code, doc, anchor) ] + | DocumentedSrc.Nested { code; doc; anchor; _ } -> + Accum [ (`N code, doc, anchor) ] + | _ -> Stop_and_keep) + in + let f (content, doc, (anchor : Odoc_document.Url.t option)) = + let doc = match doc with [] -> noop | doc -> block doc nbsp in + let content = + match content with + | `D code -> inline code nbsp + | `N l -> documented_src l nbsp nbsp' + in + let item = item_prop nbsp ++ content ++ break ++ break ++ doc in + if !(args.generate_links) then + let anchor = + match anchor with Some a -> a.anchor | None -> "" + in + break ++ break ++ anchor' anchor ++ break ++ item + else break ++ item + in + let l = list ~sep:noop (List.map f lines) in + l ++ continue rest) + +and subpage { title = _; header = _; items; url = _ } nbsp = + let content = items in + let surround body = + if content = [] then break else break ++ break ++ body ++ break + in + surround @@ item nbsp content + +and item nbsp' (l : Item.t list) : Markup.t = + match l with + | [] -> noop + | i :: rest -> ( + let continue r = if r = [] then noop else item nbsp' r in + match i with + | Text b -> block b nbsp' ++ continue rest + | Heading h -> break ++ heading h nbsp' ++ break ++ break ++ continue rest + | Declaration { attr = _; anchor; content; doc } -> + let nbsp'' = nbsp ++ nbsp ++ nbsp ++ nbsp in + let decl = documented_src content (nbsp' ++ nbsp'') nbsp' in + let doc = match doc with [] -> noop | doc -> block doc nbsp' in + let item' = item_prop nbsp' ++ decl ++ break ++ break ++ doc in + if !(args.generate_links) then + let anchor = match anchor with Some x -> x.anchor | None -> "" in + anchor' anchor ++ break ++ item' ++ continue rest + else item' ++ continue rest + | Include + { attr = _; anchor = _; content = { summary; status; content }; doc } + -> + let d = + if inline_subpage status then item nbsp' content + else + let s = source_code summary nbsp' in + match doc with [] -> s | doc -> s ++ block doc nbsp' + in + d ++ continue rest) + +let on_sub subp = + match subp with + | `Page p -> if Link.should_inline p.Subpage.content.url then Some 1 else None + | `Include incl -> if inline_subpage incl.Include.status then Some 0 else None + +let page { Page.header; items; url; _ } = + let header = Shift.compute ~on_sub header in + let items = Shift.compute ~on_sub items in + block' + ([ inline' (Link.for_printing url) ] + @ [ item (str "") header ++ item (str "") items ]) + +let rec subpage subp = + let p = subp.Subpage.content in + if Link.should_inline p.url then [] else [ render p ] + +and render (p : Page.t) = + let content fmt = Format.fprintf fmt "%a" Markup.pp (page p) in + let children = Utils.flatmap ~f:subpage @@ Subpages.compute p in + let filename = Link.as_filename p.url in + { Odoc_document.Renderer.filename; content; children } diff --git a/src/markdown/generator.mli b/src/markdown/generator.mli new file mode 100644 index 0000000000..0735089e17 --- /dev/null +++ b/src/markdown/generator.mli @@ -0,0 +1,5 @@ +type args = { generate_links : bool ref; md_flavour : string ref } + +val args : args + +val render : Odoc_document.Types.Page.t -> Odoc_document.Renderer.page diff --git a/src/markdown/link.ml b/src/markdown/link.ml new file mode 100644 index 0000000000..6f16f54138 --- /dev/null +++ b/src/markdown/link.ml @@ -0,0 +1,31 @@ +open Odoc_document + +let for_printing url = List.map snd @@ Url.Path.to_list url + +let segment_to_string (kind, name) = + match kind with + | `Module | `Page | `LeafPage | `Class -> name + | _ -> Format.asprintf "%a-%s" Odoc_document.Url.Path.pp_kind kind name + +let as_filename (url : Url.Path.t) = + let components = Url.Path.to_list url in + let dir, path = + Url.Path.split ~is_dir:(function `Page -> true | _ -> false) components + in + let dir = List.map segment_to_string dir in + let path = String.concat "." (List.map segment_to_string path) in + let str_path = String.concat Fpath.dir_sep (dir @ [ path ]) in + Fpath.(v str_path + ".md") + +let rec is_class_or_module_path (url : Url.Path.t) = + match url.kind with + | `Module | `LeafPage | `Page | `Class -> ( + match url.parent with + | None -> true + | Some url -> is_class_or_module_path url) + | _ -> false + +let should_inline x = not @@ is_class_or_module_path x + +let files_of_url url = + if is_class_or_module_path url then [ as_filename url ] else [] diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index f198ccd49c..e0bf42f582 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -572,6 +572,30 @@ module Odoc_latex = Make_renderer (struct Term.(const f $ with_children) end) +module Odoc_markdown = Make_renderer (struct + type args = Markdown.args + + let renderer = Markdown.renderer + + let generate_links = + let doc = "Generate links in markdown." in + Arg.(value & flag (info ~doc [ "generate-links" ])) + + let md_flavour = + let doc = + "The markdown renderer you are targeting, though only\n\ + \ Pandoc and Github Flavoured Markdown are supported, the default \ + being GFM." + in + Arg.( + value & opt string "" + & info ~docv:"MARKDOWN_FLAVOUR" ~doc [ "md-flavour" ]) + + let extra_args = + let f generate_links md_flavour = { Markdown.generate_links; md_flavour } in + Term.(const f $ generate_links $ md_flavour) +end) + module Depends = struct module Compile = struct let list_dependencies input_file = @@ -720,6 +744,9 @@ let () = Odoc_html.process; Odoc_html.targets; Odoc_html.generate; + Odoc_markdown.process; + Odoc_markdown.targets; + Odoc_markdown.generate; Odoc_manpage.process; Odoc_manpage.targets; Odoc_manpage.generate; diff --git a/src/odoc/dune b/src/odoc/dune index 5ca7d74d2e..362638c66b 100644 --- a/src/odoc/dune +++ b/src/odoc/dune @@ -2,7 +2,7 @@ (name odoc_odoc) (public_name odoc.odoc) (libraries compiler-libs.common fpath odoc_html odoc_manpage odoc_latex - odoc_loader odoc_model odoc_xref2 tyxml unix) + odoc_markdown odoc_loader odoc_model odoc_xref2 tyxml unix) (instrumentation (backend bisect_ppx))) diff --git a/src/odoc/markdown.ml b/src/odoc/markdown.ml new file mode 100644 index 0000000000..f5d636aebe --- /dev/null +++ b/src/odoc/markdown.ml @@ -0,0 +1,13 @@ +open Odoc_document + +type args = { generate_links : bool; md_flavour : string } + +let render args (page : Odoc_document.Types.Page.t) : + Odoc_document.Renderer.page = + Odoc_markdown.Generator.args.md_flavour := args.md_flavour; + Odoc_markdown.Generator.args.generate_links := args.generate_links; + Odoc_markdown.Generator.render page + +let files_of_url url = Odoc_markdown.Link.files_of_url url + +let renderer = { Renderer.name = "markdown"; render; files_of_url } diff --git a/test/generators/dune b/test/generators/dune index ba813043e2..3391793980 100644 --- a/test/generators/dune +++ b/test/generators/dune @@ -5,7 +5,8 @@ (glob_files cases/*) (glob_files html/*.targets) (glob_files latex/*.targets) - (glob_files man/*.targets)) + (glob_files man/*.targets) + (glob_files markdown/*.targets)) (enabled_if (>= %{ocaml_version} 4.04)) (action diff --git a/test/generators/gen_rules/gen_rules.ml b/test/generators/gen_rules/gen_rules.ml index 617e01fa01..6f0a7ccac6 100644 --- a/test/generators/gen_rules/gen_rules.ml +++ b/test/generators/gen_rules/gen_rules.ml @@ -37,6 +37,17 @@ let man_target_rule path = Gen_rules_lib.Dune.arg_dep path; ] +let markdown_target_rule path = + [ + "odoc"; + "markdown-generate"; + "-o"; + "."; + "--extra-suffix"; + "gen"; + Gen_rules_lib.Dune.arg_dep path; + ] + (** Returns filenames, not paths. *) let read_files_from_dir dir = let arr = Sys.readdir (Fpath.to_string dir) in @@ -100,6 +111,7 @@ let () = (html_target_rule, Fpath.v "html", Some "--flat"); (latex_target_rule, Fpath.v "latex", None); (man_target_rule, Fpath.v "man", None); + (markdown_target_rule, Fpath.v "markdown", None); ] cases in diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc index 9a8f60e4b6..b7dad71dae 100644 --- a/test/generators/link.dune.inc +++ b/test/generators/link.dune.inc @@ -551,6 +551,33 @@ (action (diff alias.targets alias.targets.gen)))) +(subdir + markdown + (rule + (targets Alias.md.gen Alias.X.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../alias.odocl}))) + (rule + (alias runtest) + (action + (diff Alias.md Alias.md.gen))) + (rule + (alias runtest) + (action + (diff Alias.X.md Alias.X.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + alias.targets.gen + (run odoc markdown-targets -o . %{dep:../alias.odocl})))) + (rule + (alias runtest) + (action + (diff alias.targets alias.targets.gen)))) + (subdir html (rule @@ -629,6 +656,29 @@ (action (diff bugs.targets bugs.targets.gen)))) +(subdir + markdown + (rule + (targets Bugs.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../bugs.odocl}))) + (rule + (alias runtest) + (action + (diff Bugs.md Bugs.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + bugs.targets.gen + (run odoc markdown-targets -o . %{dep:../bugs.odocl})))) + (rule + (alias runtest) + (action + (diff bugs.targets bugs.targets.gen)))) + (subdir html (rule @@ -776,6 +826,50 @@ (enabled_if (>= %{ocaml_version} 4.06)))) +(subdir + markdown + (rule + (targets Bugs_post_406.md.gen Bugs_post_406.let_open'.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../bugs_post_406.odocl})) + (enabled_if + (>= %{ocaml_version} 4.06))) + (rule + (alias runtest) + (action + (diff Bugs_post_406.md Bugs_post_406.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.06))) + (rule + (alias runtest) + (action + (diff Bugs_post_406.let_open'.md Bugs_post_406.let_open'.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.06)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + bugs_post_406.targets.gen + (run odoc markdown-targets -o . %{dep:../bugs_post_406.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.06))) + (rule + (alias runtest) + (action + (diff bugs_post_406.targets bugs_post_406.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.06)))) + (subdir html (rule @@ -892,6 +986,22 @@ (enabled_if (<= %{ocaml_version} 4.09)))) +(subdir + markdown + (rule + (action + (with-outputs-to + bugs_pre_410.targets.gen + (run odoc markdown-targets -o . %{dep:../bugs_pre_410.odocl}))) + (enabled_if + (<= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff bugs_pre_410.targets bugs_pre_410.targets.gen)) + (enabled_if + (<= %{ocaml_version} 4.09)))) + (subdir html (rule @@ -1062,6 +1172,50 @@ (action (diff class.targets class.targets.gen)))) +(subdir + markdown + (rule + (targets + Class.md.gen + Class.mutually'.md.gen + Class.recursive'.md.gen + Class.empty_virtual'.md.gen + Class.polymorphic'.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../class.odocl}))) + (rule + (alias runtest) + (action + (diff Class.md Class.md.gen))) + (rule + (alias runtest) + (action + (diff Class.mutually'.md Class.mutually'.md.gen))) + (rule + (alias runtest) + (action + (diff Class.recursive'.md Class.recursive'.md.gen))) + (rule + (alias runtest) + (action + (diff Class.empty_virtual'.md Class.empty_virtual'.md.gen))) + (rule + (alias runtest) + (action + (diff Class.polymorphic'.md Class.polymorphic'.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + class.targets.gen + (run odoc markdown-targets -o . %{dep:../class.odocl})))) + (rule + (alias runtest) + (action + (diff class.targets class.targets.gen)))) + (subdir html (rule @@ -1140,6 +1294,36 @@ (action (diff external.targets external.targets.gen)))) +(subdir + markdown + (rule + (targets External.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../external.odocl}))) + (rule + (alias runtest) + (action + (diff External.md External.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + external.targets.gen + (run odoc markdown-targets -o . %{dep:../external.odocl})))) + (rule + (alias runtest) + (action + (diff external.targets external.targets.gen)))) + (subdir html (rule @@ -1333,6 +1517,62 @@ (action (diff functor.targets functor.targets.gen)))) +(subdir + markdown + (rule + (targets + Functor.md.gen + Functor.F1.md.gen + Functor.F2.md.gen + Functor.F3.md.gen + Functor.F4.md.gen + Functor.F5.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../functor.odocl}))) + (rule + (alias runtest) + (action + (diff Functor.md Functor.md.gen))) + (rule + (alias runtest) + (action + (diff Functor.F1.md Functor.F1.md.gen))) + (rule + (alias runtest) + (action + (diff Functor.F2.md Functor.F2.md.gen))) + (rule + (alias runtest) + (action + (diff Functor.F3.md Functor.F3.md.gen))) + (rule + (alias runtest) + (action + (diff Functor.F4.md Functor.F4.md.gen))) + (rule + (alias runtest) + (action + (diff Functor.F5.md Functor.F5.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + functor.targets.gen + (run odoc markdown-targets -o . %{dep:../functor.odocl})))) + (rule + (alias runtest) + (action + (diff functor.targets functor.targets.gen)))) + (subdir html (rule @@ -1459,6 +1699,40 @@ (action (diff functor2.targets functor2.targets.gen)))) +(subdir + markdown + (rule + (targets Functor2.md.gen Functor2.X.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../functor2.odocl}))) + (rule + (alias runtest) + (action + (diff Functor2.md Functor2.md.gen))) + (rule + (alias runtest) + (action + (diff Functor2.X.md Functor2.X.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + functor2.targets.gen + (run odoc markdown-targets -o . %{dep:../functor2.odocl})))) + (rule + (alias runtest) + (action + (diff functor2.targets functor2.targets.gen)))) + (subdir html (rule @@ -1580,6 +1854,36 @@ (action (diff include.targets include.targets.gen)))) +(subdir + markdown + (rule + (targets Include.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../include.odocl}))) + (rule + (alias runtest) + (action + (diff Include.md Include.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + include.targets.gen + (run odoc markdown-targets -o . %{dep:../include.odocl})))) + (rule + (alias runtest) + (action + (diff include.targets include.targets.gen)))) + (subdir html (rule @@ -1703,40 +2007,91 @@ (diff include2.targets include2.targets.gen)))) (subdir - html + markdown (rule (targets - Include_sections.html.gen - Include_sections-module-type-Something.html.gen) + Include2.md.gen + Include2.X.md.gen + Include2.Y.md.gen + Include2.Y_include_synopsis.md.gen + Include2.Y_include_doc.md.gen) (action (run odoc - html-generate - --indent - --flat - --extra-suffix - gen + markdown-generate -o . - %{dep:../include_sections.odocl}))) + --extra-suffix + gen + %{dep:../include2.odocl}))) (rule (alias runtest) (action - (diff Include_sections.html Include_sections.html.gen))) + (diff Include2.md Include2.md.gen))) (rule (alias runtest) (action - (diff - Include_sections-module-type-Something.html - Include_sections-module-type-Something.html.gen)))) - -(subdir - html + (diff Include2.X.md Include2.X.md.gen))) (rule + (alias runtest) (action - (with-outputs-to - include_sections.targets.gen - (run odoc html-targets -o . %{dep:../include_sections.odocl} --flat)))) + (diff Include2.Y.md Include2.Y.md.gen))) + (rule + (alias runtest) + (action + (diff Include2.Y_include_synopsis.md Include2.Y_include_synopsis.md.gen))) + (rule + (alias runtest) + (action + (diff Include2.Y_include_doc.md Include2.Y_include_doc.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + include2.targets.gen + (run odoc markdown-targets -o . %{dep:../include2.odocl})))) + (rule + (alias runtest) + (action + (diff include2.targets include2.targets.gen)))) + +(subdir + html + (rule + (targets + Include_sections.html.gen + Include_sections-module-type-Something.html.gen) + (action + (run + odoc + html-generate + --indent + --flat + --extra-suffix + gen + -o + . + %{dep:../include_sections.odocl}))) + (rule + (alias runtest) + (action + (diff Include_sections.html Include_sections.html.gen))) + (rule + (alias runtest) + (action + (diff + Include_sections-module-type-Something.html + Include_sections-module-type-Something.html.gen)))) + +(subdir + html + (rule + (action + (with-outputs-to + include_sections.targets.gen + (run odoc html-targets -o . %{dep:../include_sections.odocl} --flat)))) (rule (alias runtest) (action @@ -1802,6 +2157,36 @@ (action (diff include_sections.targets include_sections.targets.gen)))) +(subdir + markdown + (rule + (targets Include_sections.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../include_sections.odocl}))) + (rule + (alias runtest) + (action + (diff Include_sections.md Include_sections.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + include_sections.targets.gen + (run odoc markdown-targets -o . %{dep:../include_sections.odocl})))) + (rule + (alias runtest) + (action + (diff include_sections.targets include_sections.targets.gen)))) + (subdir html (rule @@ -1887,6 +2272,36 @@ (action (diff interlude.targets interlude.targets.gen)))) +(subdir + markdown + (rule + (targets Interlude.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../interlude.odocl}))) + (rule + (alias runtest) + (action + (diff Interlude.md Interlude.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + interlude.targets.gen + (run odoc markdown-targets -o . %{dep:../interlude.odocl})))) + (rule + (alias runtest) + (action + (diff interlude.targets interlude.targets.gen)))) + (subdir html (rule @@ -2036,6 +2451,56 @@ (enabled_if (>= %{ocaml_version} 4.09)))) +(subdir + markdown + (rule + (targets Labels.md.gen Labels.A.md.gen Labels.c.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../labels.odocl})) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Labels.md Labels.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Labels.A.md Labels.A.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Labels.c.md Labels.c.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + labels.targets.gen + (run odoc markdown-targets -o . %{dep:../labels.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff labels.targets labels.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + (subdir html (rule @@ -2130,6 +2595,44 @@ (action (diff markup.targets markup.targets.gen)))) +(subdir + markdown + (rule + (targets Markup.md.gen Markup.X.md.gen Markup.Y.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../markup.odocl}))) + (rule + (alias runtest) + (action + (diff Markup.md Markup.md.gen))) + (rule + (alias runtest) + (action + (diff Markup.X.md Markup.X.md.gen))) + (rule + (alias runtest) + (action + (diff Markup.Y.md Markup.Y.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + markup.targets.gen + (run odoc markdown-targets -o . %{dep:../markup.odocl})))) + (rule + (alias runtest) + (action + (diff markup.targets markup.targets.gen)))) + (subdir html (rule @@ -2208,6 +2711,36 @@ (action (diff page-mld.targets page-mld.targets.gen)))) +(subdir + markdown + (rule + (targets mld.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../page-mld.odocl}))) + (rule + (alias runtest) + (action + (diff mld.md mld.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + page-mld.targets.gen + (run odoc markdown-targets -o . %{dep:../page-mld.odocl})))) + (rule + (alias runtest) + (action + (diff page-mld.targets page-mld.targets.gen)))) + (subdir html (rule @@ -2383,6 +2916,52 @@ (action (diff module.targets module.targets.gen)))) +(subdir + markdown + (rule + (targets + Module.md.gen + Module.M'.md.gen + Module.Mutually.md.gen + Module.Recursive.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../module.odocl}))) + (rule + (alias runtest) + (action + (diff Module.md Module.md.gen))) + (rule + (alias runtest) + (action + (diff Module.M'.md Module.M'.md.gen))) + (rule + (alias runtest) + (action + (diff Module.Mutually.md Module.Mutually.md.gen))) + (rule + (alias runtest) + (action + (diff Module.Recursive.md Module.Recursive.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + module.targets.gen + (run odoc markdown-targets -o . %{dep:../module.odocl})))) + (rule + (alias runtest) + (action + (diff module.targets module.targets.gen)))) + (subdir html (rule @@ -2532,6 +3111,36 @@ (action (diff module_type_alias.targets module_type_alias.targets.gen)))) +(subdir + markdown + (rule + (targets Module_type_alias.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../module_type_alias.odocl}))) + (rule + (alias runtest) + (action + (diff Module_type_alias.md Module_type_alias.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + module_type_alias.targets.gen + (run odoc markdown-targets -o . %{dep:../module_type_alias.odocl})))) + (rule + (alias runtest) + (action + (diff module_type_alias.targets module_type_alias.targets.gen)))) + (subdir html (rule @@ -2581,9 +3190,25 @@ (>= %{ocaml_version} 4.13)))) (subdir - html + markdown (rule - (targets + (action + (with-outputs-to + module_type_subst.targets.gen + (run odoc markdown-targets -o . %{dep:../module_type_subst.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.13))) + (rule + (alias runtest) + (action + (diff module_type_subst.targets module_type_subst.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.13)))) + +(subdir + html + (rule + (targets Nested.html.gen Nested-X.html.gen Nested-module-type-Y.html.gen @@ -2731,6 +3356,57 @@ (action (diff nested.targets nested.targets.gen)))) +(subdir + markdown + (rule + (targets + Nested.md.gen + Nested.X.md.gen + Nested.F.md.gen + Nested.z.md.gen + Nested.inherits.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../nested.odocl}))) + (rule + (alias runtest) + (action + (diff Nested.md Nested.md.gen))) + (rule + (alias runtest) + (action + (diff Nested.X.md Nested.X.md.gen))) + (rule + (alias runtest) + (action + (diff Nested.F.md Nested.F.md.gen))) + (rule + (alias runtest) + (action + (diff Nested.z.md Nested.z.md.gen))) + (rule + (alias runtest) + (action + (diff Nested.inherits.md Nested.inherits.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + nested.targets.gen + (run odoc markdown-targets -o . %{dep:../nested.odocl})))) + (rule + (alias runtest) + (action + (diff nested.targets nested.targets.gen)))) + (subdir html (rule @@ -5042,126 +5718,795 @@ (>= %{ocaml_version} 4.07)))) (subdir - html + markdown (rule (targets - Recent.html.gen - Recent-module-type-S.html.gen - Recent-module-type-S1.html.gen - Recent-module-type-S1-argument-1-_.html.gen - Recent-Z.html.gen - Recent-Z-Y.html.gen - Recent-Z-Y-X.html.gen - Recent-X.html.gen - Recent-module-type-PolyS.html.gen) + Ocamlary.md.gen + Ocamlary.Empty.md.gen + Ocamlary.ModuleWithSignature.md.gen + Ocamlary.ModuleWithSignatureAlias.md.gen + Ocamlary.One.md.gen + Ocamlary.Buffer.md.gen + Ocamlary.CollectionModule.md.gen + Ocamlary.CollectionModule.InnerModuleA.md.gen + Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md.gen + Ocamlary.Recollection.md.gen + Ocamlary.Recollection.InnerModuleA.md.gen + Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md.gen + Ocamlary.FunctorTypeOf.md.gen + Ocamlary.IncludedA.md.gen + Ocamlary.ExtMod.md.gen + Ocamlary.empty_class.md.gen + Ocamlary.one_method_class.md.gen + Ocamlary.two_method_class.md.gen + Ocamlary.param_class.md.gen + Ocamlary.Dep1.md.gen + Ocamlary.Dep1.X.md.gen + Ocamlary.Dep1.X.Y.md.gen + Ocamlary.Dep1.X.Y.c.md.gen + Ocamlary.Dep2.md.gen + Ocamlary.Dep2.A.md.gen + Ocamlary.Dep3.md.gen + Ocamlary.Dep4.md.gen + Ocamlary.Dep4.X.md.gen + Ocamlary.Dep5.md.gen + Ocamlary.Dep5.Z.md.gen + Ocamlary.Dep6.md.gen + Ocamlary.Dep6.X.md.gen + Ocamlary.Dep6.X.Y.md.gen + Ocamlary.Dep7.md.gen + Ocamlary.Dep7.M.md.gen + Ocamlary.Dep8.md.gen + Ocamlary.Dep9.md.gen + Ocamlary.Dep11.md.gen + Ocamlary.Dep12.md.gen + Ocamlary.Dep13.md.gen + Ocamlary.Dep13.c.md.gen + Ocamlary.With2.md.gen + Ocamlary.With3.md.gen + Ocamlary.With3.N.md.gen + Ocamlary.With4.md.gen + Ocamlary.With4.N.md.gen + Ocamlary.With5.md.gen + Ocamlary.With5.N.md.gen + Ocamlary.With6.md.gen + Ocamlary.With7.md.gen + Ocamlary.With9.md.gen + Ocamlary.With10.md.gen + Ocamlary.DoubleInclude1.md.gen + Ocamlary.DoubleInclude1.DoubleInclude2.md.gen + Ocamlary.DoubleInclude3.md.gen + Ocamlary.DoubleInclude3.DoubleInclude2.md.gen + Ocamlary.IncludeInclude1.md.gen + Ocamlary.IncludeInclude1.IncludeInclude2_M.md.gen + Ocamlary.IncludeInclude2_M.md.gen + Ocamlary.CanonicalTest.md.gen + Ocamlary.CanonicalTest.Base.md.gen + Ocamlary.CanonicalTest.Base.List.md.gen + Ocamlary.CanonicalTest.Base_Tests.md.gen + Ocamlary.CanonicalTest.Base_Tests.C.md.gen + Ocamlary.CanonicalTest.List_modif.md.gen + Ocamlary.Aliases.md.gen + Ocamlary.Aliases.Foo.md.gen + Ocamlary.Aliases.Foo.A.md.gen + Ocamlary.Aliases.Foo.B.md.gen + Ocamlary.Aliases.Foo.C.md.gen + Ocamlary.Aliases.Foo.D.md.gen + Ocamlary.Aliases.Foo.E.md.gen + Ocamlary.Aliases.Std.md.gen + Ocamlary.Aliases.E.md.gen + Ocamlary.Aliases.P1.md.gen + Ocamlary.Aliases.P1.Y.md.gen + Ocamlary.Aliases.P2.md.gen + Ocamlary.M.md.gen + Ocamlary.Only_a_module.md.gen) (action (run odoc - html-generate - --indent - --flat - --extra-suffix - gen + markdown-generate -o . - %{dep:../recent.odocl})) + --extra-suffix + gen + %{dep:../ocamlary.odocl})) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent.html Recent.html.gen)) + (diff Ocamlary.md Ocamlary.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-module-type-S.html Recent-module-type-S.html.gen)) + (diff Ocamlary.Empty.md Ocamlary.Empty.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-module-type-S1.html Recent-module-type-S1.html.gen)) + (diff Ocamlary.ModuleWithSignature.md Ocamlary.ModuleWithSignature.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action (diff - Recent-module-type-S1-argument-1-_.html - Recent-module-type-S1-argument-1-_.html.gen)) + Ocamlary.ModuleWithSignatureAlias.md + Ocamlary.ModuleWithSignatureAlias.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-Z.html Recent-Z.html.gen)) + (diff Ocamlary.One.md Ocamlary.One.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-Z-Y.html Recent-Z-Y.html.gen)) + (diff Ocamlary.Buffer.md Ocamlary.Buffer.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-Z-Y-X.html Recent-Z-Y-X.html.gen)) + (diff Ocamlary.CollectionModule.md Ocamlary.CollectionModule.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-X.html Recent-X.html.gen)) + (diff + Ocamlary.CollectionModule.InnerModuleA.md + Ocamlary.CollectionModule.InnerModuleA.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff Recent-module-type-PolyS.html Recent-module-type-PolyS.html.gen)) + (diff + Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md + Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09)))) - -(subdir - html + (>= %{ocaml_version} 4.07))) (rule + (alias runtest) (action - (with-outputs-to - recent.targets.gen - (run odoc html-targets -o . %{dep:../recent.odocl} --flat))) + (diff Ocamlary.Recollection.md Ocamlary.Recollection.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09))) + (>= %{ocaml_version} 4.07))) (rule (alias runtest) (action - (diff recent.targets recent.targets.gen)) + (diff + Ocamlary.Recollection.InnerModuleA.md + Ocamlary.Recollection.InnerModuleA.md.gen)) (enabled_if - (>= %{ocaml_version} 4.09)))) - -(subdir - latex + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md + Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.FunctorTypeOf.md Ocamlary.FunctorTypeOf.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.IncludedA.md Ocamlary.IncludedA.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.ExtMod.md Ocamlary.ExtMod.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.empty_class.md Ocamlary.empty_class.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.one_method_class.md Ocamlary.one_method_class.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.two_method_class.md Ocamlary.two_method_class.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.param_class.md Ocamlary.param_class.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep1.md Ocamlary.Dep1.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep1.X.md Ocamlary.Dep1.X.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep1.X.Y.md Ocamlary.Dep1.X.Y.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep1.X.Y.c.md Ocamlary.Dep1.X.Y.c.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep2.md Ocamlary.Dep2.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep2.A.md Ocamlary.Dep2.A.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep3.md Ocamlary.Dep3.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep4.md Ocamlary.Dep4.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep4.X.md Ocamlary.Dep4.X.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep5.md Ocamlary.Dep5.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep5.Z.md Ocamlary.Dep5.Z.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep6.md Ocamlary.Dep6.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep6.X.md Ocamlary.Dep6.X.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep6.X.Y.md Ocamlary.Dep6.X.Y.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep7.md Ocamlary.Dep7.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep7.M.md Ocamlary.Dep7.M.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep8.md Ocamlary.Dep8.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep9.md Ocamlary.Dep9.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep11.md Ocamlary.Dep11.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep12.md Ocamlary.Dep12.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep13.md Ocamlary.Dep13.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Dep13.c.md Ocamlary.Dep13.c.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With2.md Ocamlary.With2.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With3.md Ocamlary.With3.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With3.N.md Ocamlary.With3.N.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With4.md Ocamlary.With4.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With4.N.md Ocamlary.With4.N.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With5.md Ocamlary.With5.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With5.N.md Ocamlary.With5.N.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With6.md Ocamlary.With6.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With7.md Ocamlary.With7.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With9.md Ocamlary.With9.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.With10.md Ocamlary.With10.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.DoubleInclude1.md Ocamlary.DoubleInclude1.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.DoubleInclude1.DoubleInclude2.md + Ocamlary.DoubleInclude1.DoubleInclude2.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.DoubleInclude3.md Ocamlary.DoubleInclude3.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.DoubleInclude3.DoubleInclude2.md + Ocamlary.DoubleInclude3.DoubleInclude2.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.IncludeInclude1.md Ocamlary.IncludeInclude1.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.IncludeInclude1.IncludeInclude2_M.md + Ocamlary.IncludeInclude1.IncludeInclude2_M.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.IncludeInclude2_M.md Ocamlary.IncludeInclude2_M.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.CanonicalTest.md Ocamlary.CanonicalTest.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.CanonicalTest.Base.md Ocamlary.CanonicalTest.Base.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.CanonicalTest.Base.List.md + Ocamlary.CanonicalTest.Base.List.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.CanonicalTest.Base_Tests.md + Ocamlary.CanonicalTest.Base_Tests.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.CanonicalTest.Base_Tests.C.md + Ocamlary.CanonicalTest.Base_Tests.C.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff + Ocamlary.CanonicalTest.List_modif.md + Ocamlary.CanonicalTest.List_modif.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.md Ocamlary.Aliases.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.md Ocamlary.Aliases.Foo.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.A.md Ocamlary.Aliases.Foo.A.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.B.md Ocamlary.Aliases.Foo.B.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.C.md Ocamlary.Aliases.Foo.C.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.D.md Ocamlary.Aliases.Foo.D.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Foo.E.md Ocamlary.Aliases.Foo.E.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.Std.md Ocamlary.Aliases.Std.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.E.md Ocamlary.Aliases.E.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.P1.md Ocamlary.Aliases.P1.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.P1.Y.md Ocamlary.Aliases.P1.Y.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Aliases.P2.md Ocamlary.Aliases.P2.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.M.md Ocamlary.M.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff Ocamlary.Only_a_module.md Ocamlary.Only_a_module.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.07)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + ocamlary.targets.gen + (run odoc markdown-targets -o . %{dep:../ocamlary.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.07))) + (rule + (alias runtest) + (action + (diff ocamlary.targets ocamlary.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.07)))) + +(subdir + html + (rule + (targets + Recent.html.gen + Recent-module-type-S.html.gen + Recent-module-type-S1.html.gen + Recent-module-type-S1-argument-1-_.html.gen + Recent-Z.html.gen + Recent-Z-Y.html.gen + Recent-Z-Y-X.html.gen + Recent-X.html.gen + Recent-module-type-PolyS.html.gen) + (action + (run + odoc + html-generate + --indent + --flat + --extra-suffix + gen + -o + . + %{dep:../recent.odocl})) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent.html Recent.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-module-type-S.html Recent-module-type-S.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-module-type-S1.html Recent-module-type-S1.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff + Recent-module-type-S1-argument-1-_.html + Recent-module-type-S1-argument-1-_.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-Z.html Recent-Z.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-Z-Y.html Recent-Z-Y.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-Z-Y-X.html Recent-Z-Y-X.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-X.html Recent-X.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent-module-type-PolyS.html Recent-module-type-PolyS.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + html + (rule + (action + (with-outputs-to + recent.targets.gen + (run odoc html-targets -o . %{dep:../recent.odocl} --flat))) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff recent.targets recent.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + latex + (rule + (targets Recent.tex.gen) + (action + (run odoc latex-generate -o . --extra-suffix gen %{dep:../recent.odocl})) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent.tex Recent.tex.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + latex + (rule + (action + (with-outputs-to + recent.targets.gen + (run odoc latex-targets -o . %{dep:../recent.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff recent.targets recent.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + man + (rule + (targets + Recent.3o.gen + Recent.Z.3o.gen + Recent.Z.Y.3o.gen + Recent.Z.Y.X.3o.gen + Recent.X.3o.gen) + (action + (run odoc man-generate -o . --extra-suffix gen %{dep:../recent.odocl})) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent.3o Recent.3o.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent.Z.3o Recent.Z.3o.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent.Z.Y.3o Recent.Z.Y.3o.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) (rule - (targets Recent.tex.gen) + (alias runtest) (action - (run odoc latex-generate -o . --extra-suffix gen %{dep:../recent.odocl})) + (diff Recent.Z.Y.X.3o Recent.Z.Y.X.3o.gen)) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.tex Recent.tex.gen)) + (diff Recent.X.3o Recent.X.3o.gen)) (enabled_if (>= %{ocaml_version} 4.09)))) (subdir - latex + man (rule (action (with-outputs-to recent.targets.gen - (run odoc latex-targets -o . %{dep:../recent.odocl}))) + (run odoc man-targets -o . %{dep:../recent.odocl}))) (enabled_if (>= %{ocaml_version} 4.09))) (rule @@ -5172,56 +6517,63 @@ (>= %{ocaml_version} 4.09)))) (subdir - man + markdown (rule (targets - Recent.3o.gen - Recent.Z.3o.gen - Recent.Z.Y.3o.gen - Recent.Z.Y.X.3o.gen - Recent.X.3o.gen) + Recent.md.gen + Recent.Z.md.gen + Recent.Z.Y.md.gen + Recent.Z.Y.X.md.gen + Recent.X.md.gen) (action - (run odoc man-generate -o . --extra-suffix gen %{dep:../recent.odocl})) + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../recent.odocl})) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.3o Recent.3o.gen)) + (diff Recent.md Recent.md.gen)) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.Z.3o Recent.Z.3o.gen)) + (diff Recent.Z.md Recent.Z.md.gen)) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.Z.Y.3o Recent.Z.Y.3o.gen)) + (diff Recent.Z.Y.md Recent.Z.Y.md.gen)) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.Z.Y.X.3o Recent.Z.Y.X.3o.gen)) + (diff Recent.Z.Y.X.md Recent.Z.Y.X.md.gen)) (enabled_if (>= %{ocaml_version} 4.09))) (rule (alias runtest) (action - (diff Recent.X.3o Recent.X.3o.gen)) + (diff Recent.X.md Recent.X.md.gen)) (enabled_if (>= %{ocaml_version} 4.09)))) (subdir - man + markdown (rule (action (with-outputs-to recent.targets.gen - (run odoc man-targets -o . %{dep:../recent.odocl}))) + (run odoc markdown-targets -o . %{dep:../recent.odocl}))) (enabled_if (>= %{ocaml_version} 4.09))) (rule @@ -5445,6 +6797,73 @@ (enabled_if (>= %{ocaml_version} 4.09)))) +(subdir + markdown + (rule + (targets + Recent_impl.md.gen + Recent_impl.Foo.md.gen + Recent_impl.Foo.A.md.gen + Recent_impl.Foo.B.md.gen + Recent_impl.B.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../recent_impl.odocl})) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent_impl.md Recent_impl.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent_impl.Foo.md Recent_impl.Foo.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent_impl.Foo.A.md Recent_impl.Foo.A.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent_impl.Foo.B.md Recent_impl.Foo.B.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff Recent_impl.B.md Recent_impl.B.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + recent_impl.targets.gen + (run odoc markdown-targets -o . %{dep:../recent_impl.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.09))) + (rule + (alias runtest) + (action + (diff recent_impl.targets recent_impl.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.09)))) + (subdir html (rule @@ -5523,6 +6942,36 @@ (action (diff section.targets section.targets.gen)))) +(subdir + markdown + (rule + (targets Section.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../section.odocl}))) + (rule + (alias runtest) + (action + (diff Section.md Section.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + section.targets.gen + (run odoc markdown-targets -o . %{dep:../section.odocl})))) + (rule + (alias runtest) + (action + (diff section.targets section.targets.gen)))) + (subdir html (rule @@ -5609,6 +7058,33 @@ (action (diff stop.targets stop.targets.gen)))) +(subdir + markdown + (rule + (targets Stop.md.gen Stop.N.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../stop.odocl}))) + (rule + (alias runtest) + (action + (diff Stop.md Stop.md.gen))) + (rule + (alias runtest) + (action + (diff Stop.N.md Stop.N.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + stop.targets.gen + (run odoc markdown-targets -o . %{dep:../stop.odocl})))) + (rule + (alias runtest) + (action + (diff stop.targets stop.targets.gen)))) + (subdir html (rule @@ -5737,6 +7213,50 @@ (enabled_if (>= %{ocaml_version} 4.04)))) +(subdir + markdown + (rule + (targets Stop_dead_link_doc.md.gen Stop_dead_link_doc.Foo.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../stop_dead_link_doc.odocl})) + (enabled_if + (>= %{ocaml_version} 4.04))) + (rule + (alias runtest) + (action + (diff Stop_dead_link_doc.md Stop_dead_link_doc.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.04))) + (rule + (alias runtest) + (action + (diff Stop_dead_link_doc.Foo.md Stop_dead_link_doc.Foo.md.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + stop_dead_link_doc.targets.gen + (run odoc markdown-targets -o . %{dep:../stop_dead_link_doc.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.04))) + (rule + (alias runtest) + (action + (diff stop_dead_link_doc.targets stop_dead_link_doc.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) + (subdir html (rule @@ -5977,6 +7497,88 @@ (action (diff toplevel_comments.targets toplevel_comments.targets.gen)))) +(subdir + markdown + (rule + (targets + Toplevel_comments.md.gen + Toplevel_comments.Include_inline.md.gen + Toplevel_comments.Include_inline'.md.gen + Toplevel_comments.M.md.gen + Toplevel_comments.M'.md.gen + Toplevel_comments.M''.md.gen + Toplevel_comments.Alias.md.gen + Toplevel_comments.c1.md.gen + Toplevel_comments.c2.md.gen + Toplevel_comments.Ref_in_synopsis.md.gen) + (action + (run + odoc + markdown-generate + -o + . + --extra-suffix + gen + %{dep:../toplevel_comments.odocl}))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.md Toplevel_comments.md.gen))) + (rule + (alias runtest) + (action + (diff + Toplevel_comments.Include_inline.md + Toplevel_comments.Include_inline.md.gen))) + (rule + (alias runtest) + (action + (diff + Toplevel_comments.Include_inline'.md + Toplevel_comments.Include_inline'.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.M.md Toplevel_comments.M.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.M'.md Toplevel_comments.M'.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.M''.md Toplevel_comments.M''.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.Alias.md Toplevel_comments.Alias.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.c1.md Toplevel_comments.c1.md.gen))) + (rule + (alias runtest) + (action + (diff Toplevel_comments.c2.md Toplevel_comments.c2.md.gen))) + (rule + (alias runtest) + (action + (diff + Toplevel_comments.Ref_in_synopsis.md + Toplevel_comments.Ref_in_synopsis.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + toplevel_comments.targets.gen + (run odoc markdown-targets -o . %{dep:../toplevel_comments.odocl})))) + (rule + (alias runtest) + (action + (diff toplevel_comments.targets toplevel_comments.targets.gen)))) + (subdir html (rule @@ -6059,6 +7661,29 @@ (action (diff type.targets type.targets.gen)))) +(subdir + markdown + (rule + (targets Type.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../type.odocl}))) + (rule + (alias runtest) + (action + (diff Type.md Type.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + type.targets.gen + (run odoc markdown-targets -o . %{dep:../type.odocl})))) + (rule + (alias runtest) + (action + (diff type.targets type.targets.gen)))) + (subdir html (rule @@ -6136,3 +7761,26 @@ (alias runtest) (action (diff val.targets val.targets.gen)))) + +(subdir + markdown + (rule + (targets Val.md.gen) + (action + (run odoc markdown-generate -o . --extra-suffix gen %{dep:../val.odocl}))) + (rule + (alias runtest) + (action + (diff Val.md Val.md.gen)))) + +(subdir + markdown + (rule + (action + (with-outputs-to + val.targets.gen + (run odoc markdown-targets -o . %{dep:../val.odocl})))) + (rule + (alias runtest) + (action + (diff val.targets val.targets.gen)))) diff --git a/test/generators/markdown/Alias.X.md b/test/generators/markdown/Alias.X.md new file mode 100644 index 0000000000..65d5e91fdb --- /dev/null +++ b/test/generators/markdown/Alias.X.md @@ -0,0 +1,7 @@ +AliasX + +Module `` Alias.X `` + +###### type t = int + +Module Foo__X documentation. This should appear in the documentation for the alias to this module 'X' diff --git a/test/generators/markdown/Alias.md b/test/generators/markdown/Alias.md new file mode 100644 index 0000000000..1ea881bb13 --- /dev/null +++ b/test/generators/markdown/Alias.md @@ -0,0 +1,12 @@ +Alias + +Module `` Alias `` + +###### module X : sig + +######     type t = int + +Module Foo__X documentation. This should appear in the documentation for the alias to this module 'X' + +###### end + diff --git a/test/generators/markdown/Bugs.md b/test/generators/markdown/Bugs.md new file mode 100644 index 0000000000..101bfa075f --- /dev/null +++ b/test/generators/markdown/Bugs.md @@ -0,0 +1,9 @@ +Bugs + +Module `` Bugs `` + +###### type 'a opt = 'a option + +###### val foo : ?bar:'a -> unit -> unit + +Triggers an assertion failure when https://github.com/ocaml/odoc/issues/101 is not fixed. diff --git a/test/generators/markdown/Bugs_post_406.let_open'.md b/test/generators/markdown/Bugs_post_406.let_open'.md new file mode 100644 index 0000000000..5d87d89455 --- /dev/null +++ b/test/generators/markdown/Bugs_post_406.let_open'.md @@ -0,0 +1,4 @@ +Bugs_post_406let_open' + +Class `` Bugs_post_406.let_open' `` + diff --git a/test/generators/markdown/Bugs_post_406.md b/test/generators/markdown/Bugs_post_406.md new file mode 100644 index 0000000000..c5c33dab83 --- /dev/null +++ b/test/generators/markdown/Bugs_post_406.md @@ -0,0 +1,11 @@ +Bugs_post_406 + +Module `` Bugs_post_406 `` + +Let-open in class types, https://github.com/ocaml/odoc/issues/543 This was added to the language in 4.06 +###### class type let_open = object +###### end + +###### class let_open' : object +###### end + diff --git a/test/generators/markdown/Class.empty_virtual'.md b/test/generators/markdown/Class.empty_virtual'.md new file mode 100644 index 0000000000..49db7d08fd --- /dev/null +++ b/test/generators/markdown/Class.empty_virtual'.md @@ -0,0 +1,4 @@ +Classempty_virtual' + +Class `` Class.empty_virtual' `` + diff --git a/test/generators/markdown/Class.md b/test/generators/markdown/Class.md new file mode 100644 index 0000000000..4e9f80f725 --- /dev/null +++ b/test/generators/markdown/Class.md @@ -0,0 +1,31 @@ +Class + +Module `` Class `` + +###### class type empty = object +###### end + +###### class type mutually = object +###### end + +###### class type recursive = object +###### end + +###### class mutually' : object +###### end + +###### class recursive' : object +###### end + +###### class type virtual empty_virtual = object +###### end + +###### class virtual empty_virtual' : object +###### end + +###### class type 'a polymorphic = object +###### end + +###### class 'a polymorphic' : object +###### end + diff --git a/test/generators/markdown/Class.mutually'.md b/test/generators/markdown/Class.mutually'.md new file mode 100644 index 0000000000..aa33ab2537 --- /dev/null +++ b/test/generators/markdown/Class.mutually'.md @@ -0,0 +1,4 @@ +Classmutually' + +Class `` Class.mutually' `` + diff --git a/test/generators/markdown/Class.polymorphic'.md b/test/generators/markdown/Class.polymorphic'.md new file mode 100644 index 0000000000..1f37b869f0 --- /dev/null +++ b/test/generators/markdown/Class.polymorphic'.md @@ -0,0 +1,4 @@ +Classpolymorphic' + +Class `` Class.polymorphic' `` + diff --git a/test/generators/markdown/Class.recursive'.md b/test/generators/markdown/Class.recursive'.md new file mode 100644 index 0000000000..cd5d124122 --- /dev/null +++ b/test/generators/markdown/Class.recursive'.md @@ -0,0 +1,4 @@ +Classrecursive' + +Class `` Class.recursive' `` + diff --git a/test/generators/markdown/External.md b/test/generators/markdown/External.md new file mode 100644 index 0000000000..0688eddb05 --- /dev/null +++ b/test/generators/markdown/External.md @@ -0,0 +1,7 @@ +External + +Module `` External `` + +###### val foo : unit -> unit + +Foo _bar_. diff --git a/test/generators/markdown/Functor.F1.md b/test/generators/markdown/Functor.F1.md new file mode 100644 index 0000000000..3072c49650 --- /dev/null +++ b/test/generators/markdown/Functor.F1.md @@ -0,0 +1,19 @@ +FunctorF1 + +Module `` Functor.F1 `` + + +# Parameters + +###### module Arg : sig + +######     type t + + +###### end + + +# Signature + +###### type t + diff --git a/test/generators/markdown/Functor.F2.md b/test/generators/markdown/Functor.F2.md new file mode 100644 index 0000000000..062671caa6 --- /dev/null +++ b/test/generators/markdown/Functor.F2.md @@ -0,0 +1,19 @@ +FunctorF2 + +Module `` Functor.F2 `` + + +# Parameters + +###### module Arg : sig + +######     type t + + +###### end + + +# Signature + +###### type t = Arg.t + diff --git a/test/generators/markdown/Functor.F3.md b/test/generators/markdown/Functor.F3.md new file mode 100644 index 0000000000..553c134cb7 --- /dev/null +++ b/test/generators/markdown/Functor.F3.md @@ -0,0 +1,19 @@ +FunctorF3 + +Module `` Functor.F3 `` + + +# Parameters + +###### module Arg : sig + +######     type t + + +###### end + + +# Signature + +###### type t = Arg.t + diff --git a/test/generators/markdown/Functor.F4.md b/test/generators/markdown/Functor.F4.md new file mode 100644 index 0000000000..86916ca7da --- /dev/null +++ b/test/generators/markdown/Functor.F4.md @@ -0,0 +1,19 @@ +FunctorF4 + +Module `` Functor.F4 `` + + +# Parameters + +###### module Arg : sig + +######     type t + + +###### end + + +# Signature + +###### type t + diff --git a/test/generators/markdown/Functor.F5.md b/test/generators/markdown/Functor.F5.md new file mode 100644 index 0000000000..7216e7b3cc --- /dev/null +++ b/test/generators/markdown/Functor.F5.md @@ -0,0 +1,12 @@ +FunctorF5 + +Module `` Functor.F5 `` + + +# Parameters + + +# Signature + +###### type t + diff --git a/test/generators/markdown/Functor.md b/test/generators/markdown/Functor.md new file mode 100644 index 0000000000..bcf5634f57 --- /dev/null +++ b/test/generators/markdown/Functor.md @@ -0,0 +1,126 @@ +Functor + +Module `` Functor `` + +###### module type S = sig + +######     type t + + +###### end + +###### module type S1 = sig + + +## Parameters +--- + +######     module _ : sig + +######         type t + + +######     end + + +## Signature +--- + +######     type t + + +###### end + +###### module F1 : sig + + +# Parameters + +######     module Arg : sig + +######         type t + + +######     end + + +# Signature + +######     type t + + +###### end + +###### module F2 : sig + + +# Parameters + +######     module Arg : sig + +######         type t + + +######     end + + +# Signature + +######     type t = Arg.t + + +###### end + +###### module F3 : sig + + +# Parameters + +######     module Arg : sig + +######         type t + + +######     end + + +# Signature + +######     type t = Arg.t + + +###### end + +###### module F4 : sig + + +# Parameters + +######     module Arg : sig + +######         type t + + +######     end + + +# Signature + +######     type t + + +###### end + +###### module F5 : sig + + +# Parameters + + +# Signature + +######     type t + + +###### end + diff --git a/test/generators/markdown/Functor2.X.md b/test/generators/markdown/Functor2.X.md new file mode 100644 index 0000000000..1d23a61724 --- /dev/null +++ b/test/generators/markdown/Functor2.X.md @@ -0,0 +1,30 @@ +Functor2X + +Module `` Functor2.X `` + + +# Parameters + +###### module Y : sig + +######     type t + + +###### end + +###### module Z : sig + +######     type t + + +###### end + + +# Signature + +###### type y_t = Y.t + +###### type z_t = Z.t + +###### type x_t = y_t + diff --git a/test/generators/markdown/Functor2.md b/test/generators/markdown/Functor2.md new file mode 100644 index 0000000000..9ee21f5557 --- /dev/null +++ b/test/generators/markdown/Functor2.md @@ -0,0 +1,75 @@ +Functor2 + +Module `` Functor2 `` + +###### module type S = sig + +######     type t + + +###### end + +###### module X : sig + + +# Parameters + +######     module Y : sig + +######         type t + + +######     end + +######     module Z : sig + +######         type t + + +######     end + + +# Signature + +######     type y_t = Y.t + +######     type z_t = Z.t + +######     type x_t = y_t + + +###### end + +###### module type XF = sig + + +## Parameters +--- + +######     module Y : sig + +######         type t + + +######     end + +######     module Z : sig + +######         type t + + +######     end + + +## Signature +--- + +######     type y_t = Y.t + +######     type z_t = Z.t + +######     type x_t = y_t + + +###### end + diff --git a/test/generators/markdown/Include.md b/test/generators/markdown/Include.md new file mode 100644 index 0000000000..d459106511 --- /dev/null +++ b/test/generators/markdown/Include.md @@ -0,0 +1,54 @@ +Include + +Module `` Include `` + +###### module type Not_inlined = sig + +######     type t + + +###### end + +###### type t + +###### module type Inlined = sig + +######     type u + + +###### end + +###### type u + +###### module type Not_inlined_and_closed = sig + +######     type v + + +###### end + +include Not_inlined_and_closed###### module type Not_inlined_and_opened = sig + +######     type w + + +###### end + +###### type w + +###### module type Inherent_Module = sig + +######     val a : t + + +###### end + +###### module type Dorminant_Module = sig + +######     val a : u + + +###### end + +###### val a : u + diff --git a/test/generators/markdown/Include2.X.md b/test/generators/markdown/Include2.X.md new file mode 100644 index 0000000000..a1dba80faa --- /dev/null +++ b/test/generators/markdown/Include2.X.md @@ -0,0 +1,7 @@ +Include2X + +Module `` Include2.X `` + +Comment about X that should not appear when including X below. +###### type t = int + diff --git a/test/generators/markdown/Include2.Y.md b/test/generators/markdown/Include2.Y.md new file mode 100644 index 0000000000..2416700427 --- /dev/null +++ b/test/generators/markdown/Include2.Y.md @@ -0,0 +1,7 @@ +Include2Y + +Module `` Include2.Y `` + +Top-comment of Y. +###### type t + diff --git a/test/generators/markdown/Include2.Y_include_doc.md b/test/generators/markdown/Include2.Y_include_doc.md new file mode 100644 index 0000000000..5fff05871e --- /dev/null +++ b/test/generators/markdown/Include2.Y_include_doc.md @@ -0,0 +1,6 @@ +Include2Y_include_doc + +Module `` Include2.Y_include_doc `` + +###### type t = Y.t + diff --git a/test/generators/markdown/Include2.Y_include_synopsis.md b/test/generators/markdown/Include2.Y_include_synopsis.md new file mode 100644 index 0000000000..131824bdb0 --- /dev/null +++ b/test/generators/markdown/Include2.Y_include_synopsis.md @@ -0,0 +1,7 @@ +Include2Y_include_synopsis + +Module `` Include2.Y_include_synopsis `` + +The `` include Y `` below should have the synopsis from `` Y `` 's top-comment attached to it. +###### type t = Y.t + diff --git a/test/generators/markdown/Include2.md b/test/generators/markdown/Include2.md new file mode 100644 index 0000000000..96d50da45d --- /dev/null +++ b/test/generators/markdown/Include2.md @@ -0,0 +1,38 @@ +Include2 + +Module `` Include2 `` + +###### module X : sig + +######     type t = int + + +###### end + +Comment about X that should not appear when including X below. +Comment about X that should not appear when including X below. +###### type t = int + +###### module Y : sig + +######     type t + + +###### end + +Top-comment of Y. +###### module Y_include_synopsis : sig + +######     type t = Y.t + + +###### end + +The `` include Y `` below should have the synopsis from `` Y `` 's top-comment attached to it. +###### module Y_include_doc : sig + +######     type t = Y.t + + +###### end + diff --git a/test/generators/markdown/Include_sections.md b/test/generators/markdown/Include_sections.md new file mode 100644 index 0000000000..05e8423937 --- /dev/null +++ b/test/generators/markdown/Include_sections.md @@ -0,0 +1,103 @@ +Include_sections + +Module `` Include_sections `` + +###### module type Something = sig + +######     val something : unit + + +## Something 1 +--- + +foo +######     val foo : unit + + +### Something 2 +--- + +######     val bar : unit + +foo bar + +## Something 1-bis +--- + +Some text. + +###### end + +A module type. +Let's include `` Something `` once + +# Something 1 + +foo + +## Something 2 +--- + + +# Something 1-bis + +Some text. + +# Second include + +Let's include `` Something `` a second time: the heading level should be shift here. + +## Something 1 +--- + +foo + +### Something 2 +--- + + +## Something 1-bis +--- + +Some text. + +## Third include +--- + +Shifted some more. + +### Something 1 +--- + +foo + +#### Something 2 +--- + + +### Something 1-bis +--- + +Some text. +And let's include it again, but without inlining it this time: the ToC shouldn't grow. +###### val something : unit + + +### Something 1 +--- + +foo +###### val foo : unit + + +#### Something 2 +--- + +###### val bar : unit + +foo bar + +### Something 1-bis +--- + +Some text. diff --git a/test/generators/markdown/Interlude.md b/test/generators/markdown/Interlude.md new file mode 100644 index 0000000000..49c5500d82 --- /dev/null +++ b/test/generators/markdown/Interlude.md @@ -0,0 +1,22 @@ +Interlude + +Module `` Interlude `` + +This is the comment associated to the module. +Some separate stray text at the top of the module. +###### val foo : unit + +Foo. +Some stray text that is not associated with any signature item. +It has multiple paragraphs. +A separate block of stray text, adjacent to the preceding one. +###### val bar : unit + +Bar. +###### val multiple : unit + +###### val signature : unit + +###### val items : unit + +Stray text at the bottom of the module. diff --git a/test/generators/markdown/Labels.A.md b/test/generators/markdown/Labels.A.md new file mode 100644 index 0000000000..138c63d155 --- /dev/null +++ b/test/generators/markdown/Labels.A.md @@ -0,0 +1,7 @@ +LabelsA + +Module `` Labels.A `` + + +# Attached to module + diff --git a/test/generators/markdown/Labels.c.md b/test/generators/markdown/Labels.c.md new file mode 100644 index 0000000000..7e5b385702 --- /dev/null +++ b/test/generators/markdown/Labels.c.md @@ -0,0 +1,7 @@ +Labelsc + +Class `` Labels.c `` + + +# Attached to class + diff --git a/test/generators/markdown/Labels.md b/test/generators/markdown/Labels.md new file mode 100644 index 0000000000..3fb1ab7085 --- /dev/null +++ b/test/generators/markdown/Labels.md @@ -0,0 +1,108 @@ +Labels + +Module `` Labels `` + + +# Attached to unit + + +# Attached to nothing + +###### module A : sig + + +# Attached to module + + +###### end + +###### type t + +Attached to type +###### val f : t + +Attached to value +###### val e : unit -> t + +Attached to external +###### module type S = sig + + +### Attached to module type +--- + + +###### end + +###### class c : object + + +# Attached to class + + +###### end + +###### class type cs = object + + +### Attached to class type +--- + + +###### end + +###### exception E + +Attached to exception +###### type x = .. + +###### type x += +######     | X + + + +Attached to extension +###### module S := A + +Attached to module subst +###### type s := t + +Attached to type subst +###### type u = +######     | A' + +Attached to constructor + + +###### type v = { +######      `` f : t; `` + +Attached to field +###### } + +Testing that labels can be referenced +- Attached to unit + +- Attached to nothing + +- Attached to module + +- Attached to type + +- Attached to value + +- Attached to class + +- Attached to class type + +- Attached to exception + +- Attached to extension + +- Attached to module subst + +- Attached to type subst + +- Attached to constructor + +- Attached to field diff --git a/test/generators/markdown/Markup.X.md b/test/generators/markdown/Markup.X.md new file mode 100644 index 0000000000..49833b46db --- /dev/null +++ b/test/generators/markdown/Markup.X.md @@ -0,0 +1,4 @@ +MarkupX + +Module `` Markup.X `` + diff --git a/test/generators/markdown/Markup.Y.md b/test/generators/markdown/Markup.Y.md new file mode 100644 index 0000000000..56b1efa34d --- /dev/null +++ b/test/generators/markdown/Markup.Y.md @@ -0,0 +1,4 @@ +MarkupY + +Module `` Markup.Y `` + diff --git a/test/generators/markdown/Markup.md b/test/generators/markdown/Markup.md new file mode 100644 index 0000000000..852ca93405 --- /dev/null +++ b/test/generators/markdown/Markup.md @@ -0,0 +1,176 @@ +Markup + +Module `` Markup `` + +Here, we test the rendering of comment markup. + +# Sections + +Let's get these done first, because sections will be used to break up the rest of this test. +Besides the section heading above, there are also + +## Subsection headings +--- + +and + +### Sub-subsection headings +--- + +but odoc has banned deeper headings. There are also title headings, but they are only allowed in mld files. + +### Anchors +--- + +Sections can have attached Anchors, and it is possible to link to them. Links to section headers should not be set in source code style. + +#### Paragraph +--- + +Individual paragraphs can have a heading. + +##### Subparagraph +--- + +Parts of a longer paragraph that can be considered alone can also have headings. + +# Styling + +This paragraph has some styled elements: **bold** and _italic_, **_bold italic_**, _emphasis_, __emphasis_ within emphasis_, **_bold italic_**, superscript, subscript. The line spacing should be enough for superscripts and subscripts not to look odd. +Note: _In italics _emphasis_ is rendered as normal text while _emphasis _in_ emphasis_ is rendered in italics._ _It also work the same in links in italics with _emphasis _in_ emphasis_._ + `` code `` is a different kind of markup that doesn't allow nested markup. +It's possible for two markup elements to appear **next** _to_ each other and have a space, and appear **next**_to_ each other with no space. It doesn't matter **how** _much_ space it was in the source: in this sentence, it was two space characters. And in this one, there is **a** _newline_. +This is also true between _non-_ `` code `` markup _and_ `` code `` . +Code can appear **inside `` other `` markup**. Its display shouldn't be affected. + +# Links and references + +This is a link. It sends you to the top of this page. Links can have markup inside them: **bold**, _italics_, _emphasis_, superscript, subscript, and `` code `` . Links can also be nested _inside_ markup. Links cannot be nested inside each other. This link has no replacement text: #. The text is filled in by odoc. This is a shorthand link: #. The text is also filled in by odoc in this case. +This is a reference to `` foo `` . References can have replacement text: the value foo. Except for the special lookup support, references are pretty much just like links. The replacement text can have nested styles: **bold**, _italic_, _emphasis_, superscript, subscript, and `` code `` . It's also possible to surround a reference in a style: ** `` foo `` **. References can't be nested inside references, and links and references can't be nested inside each other. + +# Preformatted text + +This is a code block: +let foo = () +(** There are some nested comments in here, but an unpaired comment + terminator would terminate the whole doc surrounding comment. It's + best to keep code blocks no wider than 72 characters. *) + +let bar = + ignore fooThere are also verbatim blocks: + The main difference is these don't get syntax highlighting. +# Lists + +- This is a + +- shorthand bulleted list, + +- and the paragraphs in each list item support _styling_. +1. This is a + +2. shorthand numbered list. +- Shorthand list items can span multiple lines, however trying to put two paragraphs into a shorthand list item using a double line break +just creates a paragraph outside the list. +- Similarly, inserting a blank line between two list items +- creates two separate lists. +- To get around this limitation, one +can use explicitly-delimited lists. + + +- This one is bulleted, +1. but there is also the numbered variant. +- - lists + +- can be nested + +- and can include references + +- `` foo `` + + +# Unicode + +The parser supports any ASCII-compatible encoding, in particuλar UTF-8. + +# Raw HTML + +Raw HTML can be as inline elements into sentences. + +# Modules + + +@ `` X `` : + + + +@ `` X `` : + + + +@ `` Y `` : + + +# Tags + +Each comment can end with zero or more tags. Here are some examples: + +@author : antron + + + +@deprecated : a _long_ time ago + + + + +@parameter foo : unused + + + + +@raises Failure : always + + + + +@returns : never + + + + +@see # : this url + + + + +@see `` foo.ml `` : this file + + + + +@see Foo : this document + + + + +@since : 0 + + + +@before 1.0 : it was in beta + + + + +@version : -1 + +###### val foo : unit + +Comments in structure items **support** _markup_, too. +Some modules to support references. +###### module X : sig +###### end + +###### module Y : sig +###### end + diff --git a/test/generators/markdown/Module.M'.md b/test/generators/markdown/Module.M'.md new file mode 100644 index 0000000000..8ae5b91be7 --- /dev/null +++ b/test/generators/markdown/Module.M'.md @@ -0,0 +1,4 @@ +ModuleM' + +Module `` Module.M' `` + diff --git a/test/generators/markdown/Module.Mutually.md b/test/generators/markdown/Module.Mutually.md new file mode 100644 index 0000000000..79742064be --- /dev/null +++ b/test/generators/markdown/Module.Mutually.md @@ -0,0 +1,4 @@ +ModuleMutually + +Module `` Module.Mutually `` + diff --git a/test/generators/markdown/Module.Recursive.md b/test/generators/markdown/Module.Recursive.md new file mode 100644 index 0000000000..cf775d709b --- /dev/null +++ b/test/generators/markdown/Module.Recursive.md @@ -0,0 +1,4 @@ +ModuleRecursive + +Module `` Module.Recursive `` + diff --git a/test/generators/markdown/Module.md b/test/generators/markdown/Module.md new file mode 100644 index 0000000000..d4d6119ff8 --- /dev/null +++ b/test/generators/markdown/Module.md @@ -0,0 +1,128 @@ +Module + +Module `` Module `` + +Foo. +###### val foo : unit + +The module needs at least one signature item, otherwise a bug causes the compiler to drop the module comment (above). See https://caml.inria.fr/mantis/view.php?id=7701. +###### module type S = sig + +######     type t + +######     type u + +######     type 'a v + +######     type ('a, 'b) w + +######     module M : sig +######     end + + +###### end + +###### module type S1 + +###### module type S2 = S + +###### module type S3 = sig + +######     type t = int + +######     type u = string + +######     type 'a v + +######     type ('a, 'b) w + +######     module M : sig +######     end + + +###### end + +###### module type S4 = sig + +######     type u + +######     type 'a v + +######     type ('a, 'b) w + +######     module M : sig +######     end + + +###### end + +###### module type S5 = sig + +######     type t + +######     type u + +######     type ('a, 'b) w + +######     module M : sig +######     end + + +###### end + +###### type ('a, 'b) result + +###### module type S6 = sig + +######     type t + +######     type u + +######     type 'a v + +######     module M : sig +######     end + + +###### end + +###### module M' : sig +###### end + +###### module type S7 = sig + +######     type t + +######     type u + +######     type 'a v + +######     type ('a, 'b) w + +######     module M = M' + + +###### end + +###### module type S8 = sig + +######     type t + +######     type u + +######     type 'a v + +######     type ('a, 'b) w + + +###### end + +###### module type S9 = sig +###### end + +###### module Mutually : sig +###### end + +###### module Recursive : sig +###### end + diff --git a/test/generators/markdown/Module_type_alias.md b/test/generators/markdown/Module_type_alias.md new file mode 100644 index 0000000000..1d5c658fc3 --- /dev/null +++ b/test/generators/markdown/Module_type_alias.md @@ -0,0 +1,89 @@ +Module_type_alias + +Module `` Module_type_alias `` + +Module Type Aliases +###### module type A = sig + +######     type a + + +###### end + +###### module type B = sig + + +## Parameters +--- + +######     module C : sig + +######         type c + + +######     end + + +## Signature +--- + +######     type b + + +###### end + +###### module type D = A + +###### module type E = sig + + +## Parameters +--- + +######     module F : sig + +######         type f + + +######     end + +######     module C : sig + +######         type c + + +######     end + + +## Signature +--- + +######     type b + + +###### end + +###### module type G = sig + + +## Parameters +--- + +######     module H : sig + +######         type h + + +######     end + + +## Signature +--- + +######     type a + + +###### end + +###### module type I = B + diff --git a/test/generators/markdown/Nested.F.md b/test/generators/markdown/Nested.F.md new file mode 100644 index 0000000000..ec8517c02e --- /dev/null +++ b/test/generators/markdown/Nested.F.md @@ -0,0 +1,49 @@ +NestedF + +Module `` Nested.F `` + +This is a functor F. +Some additional comments. + +# Type + + +# Parameters + +###### module Arg1 : sig + + +### Type +--- + +######     type t + +Some type. + +### Values +--- + +######     val y : t + +The value of y. + +###### end + +###### module Arg2 : sig + + +### Type +--- + +######     type t + +Some type. + +###### end + + +# Signature + +###### type t = Arg1.t * Arg2.t + +Some type. diff --git a/test/generators/markdown/Nested.X.md b/test/generators/markdown/Nested.X.md new file mode 100644 index 0000000000..3cdf0559e3 --- /dev/null +++ b/test/generators/markdown/Nested.X.md @@ -0,0 +1,18 @@ +NestedX + +Module `` Nested.X `` + +This is module X. +Some additional comments. + +# Type + +###### type t + +Some type. + +# Values + +###### val x : t + +The value of x. diff --git a/test/generators/markdown/Nested.inherits.md b/test/generators/markdown/Nested.inherits.md new file mode 100644 index 0000000000..4071d2b85e --- /dev/null +++ b/test/generators/markdown/Nested.inherits.md @@ -0,0 +1,6 @@ +Nestedinherits + +Class `` Nested.inherits `` + +###### inherit z + diff --git a/test/generators/markdown/Nested.md b/test/generators/markdown/Nested.md new file mode 100644 index 0000000000..b9674cb5ff --- /dev/null +++ b/test/generators/markdown/Nested.md @@ -0,0 +1,127 @@ +Nested + +Module `` Nested `` + +This comment needs to be here before #235 is fixed. + +# Module + +###### module X : sig + + +# Type + +######     type t + +Some type. + +# Values + +######     val x : t + +The value of x. + +###### end + +This is module X. + +# Module type + +###### module type Y = sig + + +### Type +--- + +######     type t + +Some type. + +### Values +--- + +######     val y : t + +The value of y. + +###### end + +This is module type Y. + +# Functor + +###### module F : sig + + +# Type + + +# Parameters + +######     module Arg1 : sig + + +# Type + +######         type t + +Some type. + +# Values + +######         val y : t + +The value of y. + +######     end + +######     module Arg2 : sig + + +# Type + +######         type t + +Some type. + +######     end + + +# Signature + +######     type t = Arg1.t * Arg2.t + +Some type. + +###### end + +This is a functor F. + +# Class + +###### class virtual z : object + +######     val y : int + +Some value. +######     val mutable virtual y' : int + + +# Methods + +######     method z : int + +Some method. +######     method private virtual z' : int + + +###### end + +This is class z. +###### class virtual inherits : object + +######     inherit z + + +###### end + diff --git a/test/generators/markdown/Nested.z.md b/test/generators/markdown/Nested.z.md new file mode 100644 index 0000000000..df3348ddfa --- /dev/null +++ b/test/generators/markdown/Nested.z.md @@ -0,0 +1,19 @@ +Nestedz + +Class `` Nested.z `` + +This is class z. +Some additional comments. +###### val y : int + +Some value. +###### val mutable virtual y' : int + + +# Methods + +###### method z : int + +Some method. +###### method private virtual z' : int + diff --git a/test/generators/markdown/Ocamlary.Aliases.E.md b/test/generators/markdown/Ocamlary.Aliases.E.md new file mode 100644 index 0000000000..83348194b3 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.E.md @@ -0,0 +1,8 @@ +OcamlaryAliasesE + +Module `` Aliases.E `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.A.md b/test/generators/markdown/Ocamlary.Aliases.Foo.A.md new file mode 100644 index 0000000000..78c0fe492c --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.A.md @@ -0,0 +1,8 @@ +OcamlaryAliasesFooA + +Module `` Foo.A `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.B.md b/test/generators/markdown/Ocamlary.Aliases.Foo.B.md new file mode 100644 index 0000000000..be70e8d501 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.B.md @@ -0,0 +1,8 @@ +OcamlaryAliasesFooB + +Module `` Foo.B `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.C.md b/test/generators/markdown/Ocamlary.Aliases.Foo.C.md new file mode 100644 index 0000000000..efd89480ef --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.C.md @@ -0,0 +1,8 @@ +OcamlaryAliasesFooC + +Module `` Foo.C `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.D.md b/test/generators/markdown/Ocamlary.Aliases.Foo.D.md new file mode 100644 index 0000000000..9925e381a1 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.D.md @@ -0,0 +1,8 @@ +OcamlaryAliasesFooD + +Module `` Foo.D `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.E.md b/test/generators/markdown/Ocamlary.Aliases.Foo.E.md new file mode 100644 index 0000000000..8691c1596e --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.E.md @@ -0,0 +1,8 @@ +OcamlaryAliasesFooE + +Module `` Foo.E `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.Foo.md b/test/generators/markdown/Ocamlary.Aliases.Foo.md new file mode 100644 index 0000000000..cfec2437cd --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Foo.md @@ -0,0 +1,49 @@ +OcamlaryAliasesFoo + +Module `` Aliases.Foo `` + +###### module A : sig + +######     type t + +######     val id : t -> t + + +###### end + +###### module B : sig + +######     type t + +######     val id : t -> t + + +###### end + +###### module C : sig + +######     type t + +######     val id : t -> t + + +###### end + +###### module D : sig + +######     type t + +######     val id : t -> t + + +###### end + +###### module E : sig + +######     type t + +######     val id : t -> t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Aliases.P1.Y.md b/test/generators/markdown/Ocamlary.Aliases.P1.Y.md new file mode 100644 index 0000000000..8e59a918f5 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.P1.Y.md @@ -0,0 +1,8 @@ +OcamlaryAliasesP1Y + +Module `` P1.Y `` + +###### type t + +###### val id : t -> t + diff --git a/test/generators/markdown/Ocamlary.Aliases.P1.md b/test/generators/markdown/Ocamlary.Aliases.P1.md new file mode 100644 index 0000000000..fc0a3ca8fd --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.P1.md @@ -0,0 +1,13 @@ +OcamlaryAliasesP1 + +Module `` Aliases.P1 `` + +###### module Y : sig + +######     type t + +######     val id : t -> t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Aliases.P2.md b/test/generators/markdown/Ocamlary.Aliases.P2.md new file mode 100644 index 0000000000..1c68ee090a --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.P2.md @@ -0,0 +1,6 @@ +OcamlaryAliasesP2 + +Module `` Aliases.P2 `` + +###### module Z = Z + diff --git a/test/generators/markdown/Ocamlary.Aliases.Std.md b/test/generators/markdown/Ocamlary.Aliases.Std.md new file mode 100644 index 0000000000..b9b1a8613d --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.Std.md @@ -0,0 +1,14 @@ +OcamlaryAliasesStd + +Module `` Aliases.Std `` + +###### module A = Foo.A + +###### module B = Foo.B + +###### module C = Foo.C + +###### module D = Foo.D + +###### module E = Foo.E + diff --git a/test/generators/markdown/Ocamlary.Aliases.md b/test/generators/markdown/Ocamlary.Aliases.md new file mode 100644 index 0000000000..df8c09c054 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Aliases.md @@ -0,0 +1,138 @@ +OcamlaryAliases + +Module `` Ocamlary.Aliases `` + +Let's imitate jst's layout. +###### module Foo : sig + +######     module A : sig + +######         type t + +######         val id : t -> t + + +######     end + +######     module B : sig + +######         type t + +######         val id : t -> t + + +######     end + +######     module C : sig + +######         type t + +######         val id : t -> t + + +######     end + +######     module D : sig + +######         type t + +######         val id : t -> t + + +######     end + +######     module E : sig + +######         type t + +######         val id : t -> t + + +######     end + + +###### end + +###### module A' = Foo.A + +###### type tata = Foo.A.t + +###### type tbtb = Foo.B.t + +###### type tete + +###### type tata' = A'.t + +###### type tete2 = Foo.E.t + +###### module Std : sig + +######     module A = Foo.A + +######     module B = Foo.B + +######     module C = Foo.C + +######     module D = Foo.D + +######     module E = Foo.E + + +###### end + +###### type stde = Std.E.t + + +### include of Foo +--- + +Just for giggle, let's see what happens when we include `` Foo `` . +###### module A = Foo.A + +###### module B = Foo.B + +###### module C = Foo.C + +###### module D = Foo.D + +###### module E : sig + +######     type t + +######     val id : t -> t + + +###### end + +###### type testa = A.t + +And also, let's refer to `` A.t `` and `` Foo.B.id `` +###### module P1 : sig + +######     module Y : sig + +######         type t + +######         val id : t -> t + + +######     end + + +###### end + +###### module P2 : sig + +######     module Z = Z + + +###### end + +###### module X1 = P2.Z + +###### module X2 = P2.Z + +###### type p1 = X1.t + +###### type p2 = X2.t + diff --git a/test/generators/markdown/Ocamlary.Buffer.md b/test/generators/markdown/Ocamlary.Buffer.md new file mode 100644 index 0000000000..49fa16bb2b --- /dev/null +++ b/test/generators/markdown/Ocamlary.Buffer.md @@ -0,0 +1,7 @@ +OcamlaryBuffer + +Module `` Ocamlary.Buffer `` + +References are resolved after everything, so `` {!Buffer.t} `` won't resolve. +###### val f : int -> unit + diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.Base.List.md b/test/generators/markdown/Ocamlary.CanonicalTest.Base.List.md new file mode 100644 index 0000000000..7834b07f9f --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.Base.List.md @@ -0,0 +1,8 @@ +OcamlaryCanonicalTestBaseList + +Module `` Base.List `` + +###### type 'a t + +###### val id : 'a t -> 'a t + diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.Base.md b/test/generators/markdown/Ocamlary.CanonicalTest.Base.md new file mode 100644 index 0000000000..38b4cad006 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.Base.md @@ -0,0 +1,13 @@ +OcamlaryCanonicalTestBase + +Module `` CanonicalTest.Base `` + +###### module List : sig + +######     type 'a t + +######     val id : 'a t -> 'a t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.C.md b/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.C.md new file mode 100644 index 0000000000..5be00f3424 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.C.md @@ -0,0 +1,8 @@ +OcamlaryCanonicalTestBase_TestsC + +Module `` Base_Tests.C `` + +###### type 'a t + +###### val id : 'a t -> 'a t + diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.md b/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.md new file mode 100644 index 0000000000..21e6c7a7e8 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.Base_Tests.md @@ -0,0 +1,23 @@ +OcamlaryCanonicalTestBase_Tests + +Module `` CanonicalTest.Base_Tests `` + +###### module C : sig + +######     type 'a t + +######     val id : 'a t -> 'a t + + +###### end + +###### module L = Base.List + +###### val foo : int L.t -> float L.t + +###### val bar : 'a Base.List.t -> 'a Base.List.t + +This is just `` List `` .id, or rather `` L.id `` +###### val baz : 'a Base.List.t -> unit + +We can't reference `` Base__ `` because it's hidden. `` List `` .t ( `` List.t `` ) should resolve. diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.List_modif.md b/test/generators/markdown/Ocamlary.CanonicalTest.List_modif.md new file mode 100644 index 0000000000..532743d670 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.List_modif.md @@ -0,0 +1,8 @@ +OcamlaryCanonicalTestList_modif + +Module `` CanonicalTest.List_modif `` + +###### type 'c t = 'c Base.List.t + +###### val id : 'a t -> 'a t + diff --git a/test/generators/markdown/Ocamlary.CanonicalTest.md b/test/generators/markdown/Ocamlary.CanonicalTest.md new file mode 100644 index 0000000000..714900a140 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CanonicalTest.md @@ -0,0 +1,51 @@ +OcamlaryCanonicalTest + +Module `` Ocamlary.CanonicalTest `` + +###### module Base : sig + +######     module List : sig + +######         type 'a t + +######         val id : 'a t -> 'a t + + +######     end + + +###### end + +###### module Base_Tests : sig + +######     module C : sig + +######         type 'a t + +######         val id : 'a t -> 'a t + + +######     end + +######     module L = Base.List + +######     val foo : int L.t -> float L.t + +######     val bar : 'a Base.List.t -> 'a Base.List.t + +This is just `` List `` .id, or rather `` L.id `` +######     val baz : 'a Base.List.t -> unit + +We can't reference `` Base__ `` because it's hidden. `` List `` .t ( `` List.t `` ) should resolve. + +###### end + +###### module List_modif : sig + +######     type 'c t = 'c Base.List.t + +######     val id : 'a t -> 'a t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md b/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md new file mode 100644 index 0000000000..b31c7d4334 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md @@ -0,0 +1,8 @@ +OcamlaryCollectionModuleInnerModuleAInnerModuleA' + +Module `` InnerModuleA.InnerModuleA' `` + +This comment is for `` InnerModuleA' `` . +###### type t = (unit, unit) a_function + +This comment is for `` t `` . diff --git a/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.md b/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.md new file mode 100644 index 0000000000..2016ee7141 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CollectionModule.InnerModuleA.md @@ -0,0 +1,26 @@ +OcamlaryCollectionModuleInnerModuleA + +Module `` CollectionModule.InnerModuleA `` + +This comment is for `` InnerModuleA `` . +###### type t = collection + +This comment is for `` t `` . +###### module InnerModuleA' : sig + +######     type t = (unit, unit) a_function + +This comment is for `` t `` . + +###### end + +This comment is for `` InnerModuleA' `` . +###### module type InnerModuleTypeA' = sig + +######     type t = InnerModuleA'.t + +This comment is for `` t `` . + +###### end + +This comment is for `` InnerModuleTypeA' `` . diff --git a/test/generators/markdown/Ocamlary.CollectionModule.md b/test/generators/markdown/Ocamlary.CollectionModule.md new file mode 100644 index 0000000000..b97334f912 --- /dev/null +++ b/test/generators/markdown/Ocamlary.CollectionModule.md @@ -0,0 +1,40 @@ +OcamlaryCollectionModule + +Module `` Ocamlary.CollectionModule `` + +This comment is for `` CollectionModule `` . +###### type collection + +This comment is for `` collection `` . +###### type element + +###### module InnerModuleA : sig + +######     type t = collection + +This comment is for `` t `` . +######     module InnerModuleA' : sig + +######         type t = (unit, unit) a_function + +This comment is for `` t `` . + +######     end + +This comment is for `` InnerModuleA' `` . +######     module type InnerModuleTypeA' = sig + +######         type t = InnerModuleA'.t + +This comment is for `` t `` . + +######     end + +This comment is for `` InnerModuleTypeA' `` . + +###### end + +This comment is for `` InnerModuleA `` . +###### module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . diff --git a/test/generators/markdown/Ocamlary.Dep1.X.Y.c.md b/test/generators/markdown/Ocamlary.Dep1.X.Y.c.md new file mode 100644 index 0000000000..44d72c98eb --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep1.X.Y.c.md @@ -0,0 +1,6 @@ +OcamlaryDep1XYc + +Class `` Y.c `` + +###### method m : int + diff --git a/test/generators/markdown/Ocamlary.Dep1.X.Y.md b/test/generators/markdown/Ocamlary.Dep1.X.Y.md new file mode 100644 index 0000000000..631d56d5de --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep1.X.Y.md @@ -0,0 +1,11 @@ +OcamlaryDep1XY + +Module `` X.Y `` + +###### class c : object + +######     method m : int + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep1.X.md b/test/generators/markdown/Ocamlary.Dep1.X.md new file mode 100644 index 0000000000..a642a85db3 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep1.X.md @@ -0,0 +1,16 @@ +OcamlaryDep1X + +Module `` Dep1.X `` + +###### module Y : sig + +######     class c : object + +######         method m : int + + +######     end + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep1.md b/test/generators/markdown/Ocamlary.Dep1.md new file mode 100644 index 0000000000..dcf9817db3 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep1.md @@ -0,0 +1,33 @@ +OcamlaryDep1 + +Module `` Ocamlary.Dep1 `` + +###### module type S = sig + +######     class c : object + +######         method m : int + + +######     end + + +###### end + +###### module X : sig + +######     module Y : sig + +######         class c : object + +######             method m : int + + +######         end + + +######     end + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep11.md b/test/generators/markdown/Ocamlary.Dep11.md new file mode 100644 index 0000000000..f239fa9eb6 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep11.md @@ -0,0 +1,16 @@ +OcamlaryDep11 + +Module `` Ocamlary.Dep11 `` + +###### module type S = sig + +######     class c : object + +######         method m : int + + +######     end + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep12.md b/test/generators/markdown/Ocamlary.Dep12.md new file mode 100644 index 0000000000..4f13992372 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep12.md @@ -0,0 +1,19 @@ +OcamlaryDep12 + +Module `` Ocamlary.Dep12 `` + + +# Parameters + +###### module Arg : sig + +######     module type S + + +###### end + + +# Signature + +###### module type T = Arg.S + diff --git a/test/generators/markdown/Ocamlary.Dep13.c.md b/test/generators/markdown/Ocamlary.Dep13.c.md new file mode 100644 index 0000000000..0b737fde70 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep13.c.md @@ -0,0 +1,6 @@ +OcamlaryDep13c + +Class `` Dep13.c `` + +###### method m : int + diff --git a/test/generators/markdown/Ocamlary.Dep13.md b/test/generators/markdown/Ocamlary.Dep13.md new file mode 100644 index 0000000000..d3dd6da05c --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep13.md @@ -0,0 +1,11 @@ +OcamlaryDep13 + +Module `` Ocamlary.Dep13 `` + +###### class c : object + +######     method m : int + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep2.A.md b/test/generators/markdown/Ocamlary.Dep2.A.md new file mode 100644 index 0000000000..134cb993fe --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep2.A.md @@ -0,0 +1,6 @@ +OcamlaryDep2A + +Module `` Dep2.A `` + +###### module Y : Arg.S + diff --git a/test/generators/markdown/Ocamlary.Dep2.md b/test/generators/markdown/Ocamlary.Dep2.md new file mode 100644 index 0000000000..51baee6cdd --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep2.md @@ -0,0 +1,33 @@ +OcamlaryDep2 + +Module `` Ocamlary.Dep2 `` + + +# Parameters + +###### module Arg : sig + +######     module type S + +######     module X : sig + +######         module Y : S + + +######     end + + +###### end + + +# Signature + +###### module A : sig + +######     module Y : Arg.S + + +###### end + +###### module B = A.Y + diff --git a/test/generators/markdown/Ocamlary.Dep3.md b/test/generators/markdown/Ocamlary.Dep3.md new file mode 100644 index 0000000000..6670d0ac25 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep3.md @@ -0,0 +1,6 @@ +OcamlaryDep3 + +Module `` Ocamlary.Dep3 `` + +###### type a + diff --git a/test/generators/markdown/Ocamlary.Dep4.X.md b/test/generators/markdown/Ocamlary.Dep4.X.md new file mode 100644 index 0000000000..9724b5f063 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep4.X.md @@ -0,0 +1,6 @@ +OcamlaryDep4X + +Module `` Dep4.X `` + +###### type b + diff --git a/test/generators/markdown/Ocamlary.Dep4.md b/test/generators/markdown/Ocamlary.Dep4.md new file mode 100644 index 0000000000..db3b33333a --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep4.md @@ -0,0 +1,33 @@ +OcamlaryDep4 + +Module `` Ocamlary.Dep4 `` + +###### module type T = sig + +######     type b + + +###### end + +###### module type S = sig + +######     module X : sig + +######         type b + + +######     end + +######     module Y : sig +######     end + + +###### end + +###### module X : sig + +######     type b + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep5.Z.md b/test/generators/markdown/Ocamlary.Dep5.Z.md new file mode 100644 index 0000000000..0910111d2d --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep5.Z.md @@ -0,0 +1,8 @@ +OcamlaryDep5Z + +Module `` Dep5.Z `` + +###### module X : Arg.T + +###### module Y = Dep3 + diff --git a/test/generators/markdown/Ocamlary.Dep5.md b/test/generators/markdown/Ocamlary.Dep5.md new file mode 100644 index 0000000000..12511737dc --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep5.md @@ -0,0 +1,38 @@ +OcamlaryDep5 + +Module `` Ocamlary.Dep5 `` + + +# Parameters + +###### module Arg : sig + +######     module type T + +######     module type S = sig + +######         module X : T + +######         module Y : sig +######         end + + +######     end + +######     module X : T + + +###### end + + +# Signature + +###### module Z : sig + +######     module X : Arg.T + +######     module Y = Dep3 + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep6.X.Y.md b/test/generators/markdown/Ocamlary.Dep6.X.Y.md new file mode 100644 index 0000000000..2fe07862eb --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep6.X.Y.md @@ -0,0 +1,6 @@ +OcamlaryDep6XY + +Module `` X.Y `` + +###### type d + diff --git a/test/generators/markdown/Ocamlary.Dep6.X.md b/test/generators/markdown/Ocamlary.Dep6.X.md new file mode 100644 index 0000000000..d4b40ec3e5 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep6.X.md @@ -0,0 +1,13 @@ +OcamlaryDep6X + +Module `` Dep6.X `` + +###### module type R = S + +###### module Y : sig + +######     type d + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep6.md b/test/generators/markdown/Ocamlary.Dep6.md new file mode 100644 index 0000000000..c70893c279 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep6.md @@ -0,0 +1,39 @@ +OcamlaryDep6 + +Module `` Ocamlary.Dep6 `` + +###### module type S = sig + +######     type d + + +###### end + +###### module type T = sig + +######     module type R = S + +######     module Y : sig + +######         type d + + +######     end + + +###### end + +###### module X : sig + +######     module type R = S + +######     module Y : sig + +######         type d + + +######     end + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep7.M.md b/test/generators/markdown/Ocamlary.Dep7.M.md new file mode 100644 index 0000000000..0ada0f8b11 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep7.M.md @@ -0,0 +1,8 @@ +OcamlaryDep7M + +Module `` Dep7.M `` + +###### module type R = Arg.S + +###### module Y : R + diff --git a/test/generators/markdown/Ocamlary.Dep7.md b/test/generators/markdown/Ocamlary.Dep7.md new file mode 100644 index 0000000000..8aedf93b59 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep7.md @@ -0,0 +1,44 @@ +OcamlaryDep7 + +Module `` Ocamlary.Dep7 `` + + +# Parameters + +###### module Arg : sig + +######     module type S + +######     module type T = sig + +######         module type R = S + +######         module Y : R + + +######     end + +######     module X : sig + +######         module type R = S + +######         module Y : R + + +######     end + + +###### end + + +# Signature + +###### module M : sig + +######     module type R = Arg.S + +######     module Y : R + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep8.md b/test/generators/markdown/Ocamlary.Dep8.md new file mode 100644 index 0000000000..2673a298df --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep8.md @@ -0,0 +1,11 @@ +OcamlaryDep8 + +Module `` Ocamlary.Dep8 `` + +###### module type T = sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Dep9.md b/test/generators/markdown/Ocamlary.Dep9.md new file mode 100644 index 0000000000..42b65cbadb --- /dev/null +++ b/test/generators/markdown/Ocamlary.Dep9.md @@ -0,0 +1,19 @@ +OcamlaryDep9 + +Module `` Ocamlary.Dep9 `` + + +# Parameters + +###### module X : sig + +######     module type T + + +###### end + + +# Signature + +###### module type T = X.T + diff --git a/test/generators/markdown/Ocamlary.DoubleInclude1.DoubleInclude2.md b/test/generators/markdown/Ocamlary.DoubleInclude1.DoubleInclude2.md new file mode 100644 index 0000000000..3779af5bc5 --- /dev/null +++ b/test/generators/markdown/Ocamlary.DoubleInclude1.DoubleInclude2.md @@ -0,0 +1,6 @@ +OcamlaryDoubleInclude1DoubleInclude2 + +Module `` DoubleInclude1.DoubleInclude2 `` + +###### type double_include + diff --git a/test/generators/markdown/Ocamlary.DoubleInclude1.md b/test/generators/markdown/Ocamlary.DoubleInclude1.md new file mode 100644 index 0000000000..c777f97b81 --- /dev/null +++ b/test/generators/markdown/Ocamlary.DoubleInclude1.md @@ -0,0 +1,11 @@ +OcamlaryDoubleInclude1 + +Module `` Ocamlary.DoubleInclude1 `` + +###### module DoubleInclude2 : sig + +######     type double_include + + +###### end + diff --git a/test/generators/markdown/Ocamlary.DoubleInclude3.DoubleInclude2.md b/test/generators/markdown/Ocamlary.DoubleInclude3.DoubleInclude2.md new file mode 100644 index 0000000000..e8370850ef --- /dev/null +++ b/test/generators/markdown/Ocamlary.DoubleInclude3.DoubleInclude2.md @@ -0,0 +1,6 @@ +OcamlaryDoubleInclude3DoubleInclude2 + +Module `` DoubleInclude3.DoubleInclude2 `` + +###### type double_include + diff --git a/test/generators/markdown/Ocamlary.DoubleInclude3.md b/test/generators/markdown/Ocamlary.DoubleInclude3.md new file mode 100644 index 0000000000..357fdf70dc --- /dev/null +++ b/test/generators/markdown/Ocamlary.DoubleInclude3.md @@ -0,0 +1,11 @@ +OcamlaryDoubleInclude3 + +Module `` Ocamlary.DoubleInclude3 `` + +###### module DoubleInclude2 : sig + +######     type double_include + + +###### end + diff --git a/test/generators/markdown/Ocamlary.Empty.md b/test/generators/markdown/Ocamlary.Empty.md new file mode 100644 index 0000000000..92f612d5e4 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Empty.md @@ -0,0 +1,6 @@ +OcamlaryEmpty + +Module `` Ocamlary.Empty `` + +A plain, empty module +This module has a signature without any members. diff --git a/test/generators/markdown/Ocamlary.ExtMod.md b/test/generators/markdown/Ocamlary.ExtMod.md new file mode 100644 index 0000000000..c0e9d34d6d --- /dev/null +++ b/test/generators/markdown/Ocamlary.ExtMod.md @@ -0,0 +1,11 @@ +OcamlaryExtMod + +Module `` Ocamlary.ExtMod `` + +###### type t = .. + +###### type t += +######     | Leisureforce + + + diff --git a/test/generators/markdown/Ocamlary.FunctorTypeOf.md b/test/generators/markdown/Ocamlary.FunctorTypeOf.md new file mode 100644 index 0000000000..53502e7f16 --- /dev/null +++ b/test/generators/markdown/Ocamlary.FunctorTypeOf.md @@ -0,0 +1,55 @@ +OcamlaryFunctorTypeOf + +Module `` Ocamlary.FunctorTypeOf `` + +This comment is for `` FunctorTypeOf `` . + +# Parameters + +###### module Collection : sig + +This comment is for `` CollectionModule `` . +######     type collection + +This comment is for `` collection `` . +######     type element + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + + +# Signature + +###### type t = Collection.collection + +This comment is for `` t `` . diff --git a/test/generators/markdown/Ocamlary.IncludeInclude1.IncludeInclude2_M.md b/test/generators/markdown/Ocamlary.IncludeInclude1.IncludeInclude2_M.md new file mode 100644 index 0000000000..c29a568ee3 --- /dev/null +++ b/test/generators/markdown/Ocamlary.IncludeInclude1.IncludeInclude2_M.md @@ -0,0 +1,4 @@ +OcamlaryIncludeInclude1IncludeInclude2_M + +Module `` IncludeInclude1.IncludeInclude2_M `` + diff --git a/test/generators/markdown/Ocamlary.IncludeInclude1.md b/test/generators/markdown/Ocamlary.IncludeInclude1.md new file mode 100644 index 0000000000..cb50ae32a3 --- /dev/null +++ b/test/generators/markdown/Ocamlary.IncludeInclude1.md @@ -0,0 +1,14 @@ +OcamlaryIncludeInclude1 + +Module `` Ocamlary.IncludeInclude1 `` + +###### module type IncludeInclude2 = sig + +######     type include_include + + +###### end + +###### module IncludeInclude2_M : sig +###### end + diff --git a/test/generators/markdown/Ocamlary.IncludeInclude2_M.md b/test/generators/markdown/Ocamlary.IncludeInclude2_M.md new file mode 100644 index 0000000000..9859a040b4 --- /dev/null +++ b/test/generators/markdown/Ocamlary.IncludeInclude2_M.md @@ -0,0 +1,4 @@ +OcamlaryIncludeInclude2_M + +Module `` Ocamlary.IncludeInclude2_M `` + diff --git a/test/generators/markdown/Ocamlary.IncludedA.md b/test/generators/markdown/Ocamlary.IncludedA.md new file mode 100644 index 0000000000..8b48d9170a --- /dev/null +++ b/test/generators/markdown/Ocamlary.IncludedA.md @@ -0,0 +1,6 @@ +OcamlaryIncludedA + +Module `` Ocamlary.IncludedA `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.M.md b/test/generators/markdown/Ocamlary.M.md new file mode 100644 index 0000000000..5438c3bc9a --- /dev/null +++ b/test/generators/markdown/Ocamlary.M.md @@ -0,0 +1,6 @@ +OcamlaryM + +Module `` Ocamlary.M `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.ModuleWithSignature.md b/test/generators/markdown/Ocamlary.ModuleWithSignature.md new file mode 100644 index 0000000000..7a0febb36f --- /dev/null +++ b/test/generators/markdown/Ocamlary.ModuleWithSignature.md @@ -0,0 +1,5 @@ +OcamlaryModuleWithSignature + +Module `` Ocamlary.ModuleWithSignature `` + +A plain module of a signature of `` EmptySig `` (reference) diff --git a/test/generators/markdown/Ocamlary.ModuleWithSignatureAlias.md b/test/generators/markdown/Ocamlary.ModuleWithSignatureAlias.md new file mode 100644 index 0000000000..681e76f0e7 --- /dev/null +++ b/test/generators/markdown/Ocamlary.ModuleWithSignatureAlias.md @@ -0,0 +1,9 @@ +OcamlaryModuleWithSignatureAlias + +Module `` Ocamlary.ModuleWithSignatureAlias `` + +A plain module with an alias signature + +@deprecated : I don't like this element any more. + + diff --git a/test/generators/markdown/Ocamlary.One.md b/test/generators/markdown/Ocamlary.One.md new file mode 100644 index 0000000000..3c47b770d1 --- /dev/null +++ b/test/generators/markdown/Ocamlary.One.md @@ -0,0 +1,6 @@ +OcamlaryOne + +Module `` Ocamlary.One `` + +###### type one + diff --git a/test/generators/markdown/Ocamlary.Only_a_module.md b/test/generators/markdown/Ocamlary.Only_a_module.md new file mode 100644 index 0000000000..092595701f --- /dev/null +++ b/test/generators/markdown/Ocamlary.Only_a_module.md @@ -0,0 +1,6 @@ +OcamlaryOnly_a_module + +Module `` Ocamlary.Only_a_module `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md b/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md new file mode 100644 index 0000000000..7efb580ee5 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md @@ -0,0 +1,8 @@ +OcamlaryRecollectionInnerModuleAInnerModuleA' + +Module `` InnerModuleA.InnerModuleA' `` + +This comment is for `` InnerModuleA' `` . +###### type t = (unit, unit) a_function + +This comment is for `` t `` . diff --git a/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.md b/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.md new file mode 100644 index 0000000000..e8a34e73c0 --- /dev/null +++ b/test/generators/markdown/Ocamlary.Recollection.InnerModuleA.md @@ -0,0 +1,26 @@ +OcamlaryRecollectionInnerModuleA + +Module `` Recollection.InnerModuleA `` + +This comment is for `` InnerModuleA `` . +###### type t = collection + +This comment is for `` t `` . +###### module InnerModuleA' : sig + +######     type t = (unit, unit) a_function + +This comment is for `` t `` . + +###### end + +This comment is for `` InnerModuleA' `` . +###### module type InnerModuleTypeA' = sig + +######     type t = InnerModuleA'.t + +This comment is for `` t `` . + +###### end + +This comment is for `` InnerModuleTypeA' `` . diff --git a/test/generators/markdown/Ocamlary.Recollection.md b/test/generators/markdown/Ocamlary.Recollection.md new file mode 100644 index 0000000000..d92d09874a --- /dev/null +++ b/test/generators/markdown/Ocamlary.Recollection.md @@ -0,0 +1,87 @@ +OcamlaryRecollection + +Module `` Ocamlary.Recollection `` + + +# Parameters + +###### module C : sig + +This comment is for `` CollectionModule `` . +######     type collection + +This comment is for `` collection `` . +######     type element + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + + +# Signature + +This comment is for `` CollectionModule `` . +###### type collection = C.element list + +This comment is for `` collection `` . +###### type element = C.collection + +###### module InnerModuleA : sig + +######     type t = collection + +This comment is for `` t `` . +######     module InnerModuleA' : sig + +######         type t = (unit, unit) a_function + +This comment is for `` t `` . + +######     end + +This comment is for `` InnerModuleA' `` . +######     module type InnerModuleTypeA' = sig + +######         type t = InnerModuleA'.t + +This comment is for `` t `` . + +######     end + +This comment is for `` InnerModuleTypeA' `` . + +###### end + +This comment is for `` InnerModuleA `` . +###### module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . diff --git a/test/generators/markdown/Ocamlary.With10.md b/test/generators/markdown/Ocamlary.With10.md new file mode 100644 index 0000000000..08b4ebe155 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With10.md @@ -0,0 +1,19 @@ +OcamlaryWith10 + +Module `` Ocamlary.With10 `` + +###### module type T = sig + +######     module M : sig + +######         module type S + + +######     end + +######     module N : M.S + + +###### end + + `` With10.T `` is a submodule type. diff --git a/test/generators/markdown/Ocamlary.With2.md b/test/generators/markdown/Ocamlary.With2.md new file mode 100644 index 0000000000..e2a360ee5e --- /dev/null +++ b/test/generators/markdown/Ocamlary.With2.md @@ -0,0 +1,11 @@ +OcamlaryWith2 + +Module `` Ocamlary.With2 `` + +###### module type S = sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.With3.N.md b/test/generators/markdown/Ocamlary.With3.N.md new file mode 100644 index 0000000000..f160848220 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With3.N.md @@ -0,0 +1,6 @@ +OcamlaryWith3N + +Module `` With3.N `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.With3.md b/test/generators/markdown/Ocamlary.With3.md new file mode 100644 index 0000000000..6700e90caa --- /dev/null +++ b/test/generators/markdown/Ocamlary.With3.md @@ -0,0 +1,13 @@ +OcamlaryWith3 + +Module `` Ocamlary.With3 `` + +###### module M = With2 + +###### module N : sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.With4.N.md b/test/generators/markdown/Ocamlary.With4.N.md new file mode 100644 index 0000000000..0ffd4c7a4a --- /dev/null +++ b/test/generators/markdown/Ocamlary.With4.N.md @@ -0,0 +1,6 @@ +OcamlaryWith4N + +Module `` With4.N `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.With4.md b/test/generators/markdown/Ocamlary.With4.md new file mode 100644 index 0000000000..6c1de86f75 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With4.md @@ -0,0 +1,11 @@ +OcamlaryWith4 + +Module `` Ocamlary.With4 `` + +###### module N : sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.With5.N.md b/test/generators/markdown/Ocamlary.With5.N.md new file mode 100644 index 0000000000..65954ccc82 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With5.N.md @@ -0,0 +1,6 @@ +OcamlaryWith5N + +Module `` With5.N `` + +###### type t + diff --git a/test/generators/markdown/Ocamlary.With5.md b/test/generators/markdown/Ocamlary.With5.md new file mode 100644 index 0000000000..f263a93da7 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With5.md @@ -0,0 +1,18 @@ +OcamlaryWith5 + +Module `` Ocamlary.With5 `` + +###### module type S = sig + +######     type t + + +###### end + +###### module N : sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.With6.md b/test/generators/markdown/Ocamlary.With6.md new file mode 100644 index 0000000000..6615ecbba6 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With6.md @@ -0,0 +1,18 @@ +OcamlaryWith6 + +Module `` Ocamlary.With6 `` + +###### module type T = sig + +######     module M : sig + +######         module type S + +######         module N : S + + +######     end + + +###### end + diff --git a/test/generators/markdown/Ocamlary.With7.md b/test/generators/markdown/Ocamlary.With7.md new file mode 100644 index 0000000000..01b98efaaf --- /dev/null +++ b/test/generators/markdown/Ocamlary.With7.md @@ -0,0 +1,19 @@ +OcamlaryWith7 + +Module `` Ocamlary.With7 `` + + +# Parameters + +###### module X : sig + +######     module type T + + +###### end + + +# Signature + +###### module type T = X.T + diff --git a/test/generators/markdown/Ocamlary.With9.md b/test/generators/markdown/Ocamlary.With9.md new file mode 100644 index 0000000000..98cd376924 --- /dev/null +++ b/test/generators/markdown/Ocamlary.With9.md @@ -0,0 +1,11 @@ +OcamlaryWith9 + +Module `` Ocamlary.With9 `` + +###### module type S = sig + +######     type t + + +###### end + diff --git a/test/generators/markdown/Ocamlary.empty_class.md b/test/generators/markdown/Ocamlary.empty_class.md new file mode 100644 index 0000000000..0966bf7126 --- /dev/null +++ b/test/generators/markdown/Ocamlary.empty_class.md @@ -0,0 +1,4 @@ +Ocamlaryempty_class + +Class `` Ocamlary.empty_class `` + diff --git a/test/generators/markdown/Ocamlary.md b/test/generators/markdown/Ocamlary.md new file mode 100644 index 0000000000..60001428d8 --- /dev/null +++ b/test/generators/markdown/Ocamlary.md @@ -0,0 +1,2069 @@ +Ocamlary + +Module `` Ocamlary `` + +This is an _interface_ with **all** of the _module system_ features. This documentation demonstrates: +- comment formatting + +- unassociated comments + +- documentation sections + +- module system documentation including +1. submodules + +2. module aliases + +3. module types + +4. module type aliases + +5. modules with signatures + +6. modules with aliased signatures + +A numbered list: +1. 3 + +2. 2 + +3. 1 +David Sheets is the author. + +@author : David Sheets + +You may find more information about this HTML documentation renderer at github.com/dsheets/ocamlary. +This is some verbatim text: + verbatimThis is some verbatim text: + [][df[]]}}Here is some raw LaTeX: +Here is an index table of `` Empty `` modules: + +@ `` Empty `` : A plain, empty module + + + +@ `` EmptyAlias `` : A plain module alias of `` Empty `` + +Odoc doesn't support `` {!indexlist} `` . +Here is some superscript: x2 +Here is some subscript: x0 +Here are some escaped brackets: { [ @ ] } +Here is some _emphasis_ `` followed by code `` . +An unassociated comment + +# Level 1 + + +## Level 2 +--- + + +### Level 3 +--- + + +#### Level 4 +--- + + +### Basic module stuff +--- + +###### module Empty : sig +###### end + +A plain, empty module +###### module type Empty = sig + +######     type t + + +###### end + +An ambiguous, misnamed module type +###### module type MissingComment = sig + +######     type t + + +###### end + +An ambiguous, misnamed module type + +# Section 9000 + +###### module EmptyAlias = Empty + +A plain module alias of `` Empty `` + +### EmptySig +--- + +###### module type EmptySig = sig +###### end + +A plain, empty module signature +###### module type EmptySigAlias = EmptySig + +A plain, empty module signature alias of +###### module ModuleWithSignature : sig +###### end + +A plain module of a signature of `` EmptySig `` (reference) +###### module ModuleWithSignatureAlias : sig +###### end + +A plain module with an alias signature +###### module One : sig + +######     type one + + +###### end + +###### module type SigForMod = sig + +######     module Inner : sig + +######         module type Empty = sig +######         end + + +######     end + + +###### end + +There's a signature in a module in this signature. +###### module type SuperSig = sig + +######     module type SubSigA = sig + + + A Labeled Section Header Inside of a Signature +--- + +######         type t + +######         module SubSigAMod : sig + +######             type sub_sig_a_mod + + +######         end + + +######     end + +######     module type SubSigB = sig + + + Another Labeled Section Header Inside of a Signature +--- + +######         type t + + +######     end + +######     module type EmptySig = sig + +######         type not_actually_empty + + +######     end + +######     module type One = sig + +######         type two + + +######     end + +######     module type SuperSig = sig +######     end + + +###### end + +For a good time, see `` SuperSig `` .SubSigA.subSig or `` SuperSig `` .SubSigB.subSig or `` SuperSig.EmptySig `` . Section Section 9000 is also interesting. EmptySig is the section and `` EmptySig `` is the module signature. +###### module Buffer : sig + +######     val f : int -> unit + + +###### end + +References are resolved after everything, so `` {!Buffer.t} `` won't resolve. +Some text before exception title. + +### Basic exception stuff +--- + +After exception title. +###### exception Kaboom of unit + +Unary exception constructor +###### exception Kablam of unit * unit + +Binary exception constructor +###### exception Kapow of unit * unit + +Unary exception constructor over binary tuple +###### exception EmptySig + + `` EmptySig `` is a module and `` EmptySig `` is this exception. +###### exception EmptySigAlias + + `` EmptySigAlias `` is this exception. + +### Basic type and value stuff with advanced doc comments +--- + +###### type ('a, 'b) a_function = 'a -> 'b + + `` a_function `` is this type and `` a_function `` is the value below. +###### val a_function : x:int -> int + +This is `` a_function `` with param and return type. + +@parameter x : the `` x `` coordinate + + + + +@returns : the `` y `` coordinate + + +###### val fun_fun_fun : ((int, int) a_function, (unit, unit) a_function) a_function + +###### val fun_maybe : ?yes:unit -> unit -> int + +###### val not_found : unit -> unit + + +@raises Not_found : That's all it does + + +###### val ocaml_org : string + + +@see http://ocaml.org/ : The OCaml Web site + + +###### val some_file : string + + +@see `` some_file `` : The file called `` some_file `` + + +###### val some_doc : string + + +@see some_doc : The document called `` some_doc `` + + +###### val since_mesozoic : unit + +This value was introduced in the Mesozoic era. + +@since : mesozoic + +###### val changing : unit + +This value has had changes in 1.0.0, 1.1.0, and 1.2.0. + +@before 1.0.0 : before 1.0.0 + + + + +@before 1.1.0 : before 1.1.0 + + + + +@version : 1.2.0 + + +### Some Operators +--- + +###### val (~-) : unit + +###### val (!) : unit + +###### val (@) : unit + +###### val ($) : unit + +###### val (%) : unit + +###### val (&) : unit + +###### val (*) : unit + +###### val (-) : unit + +###### val (+) : unit + +###### val (-?) : unit + +###### val (/) : unit + +###### val (:=) : unit + +###### val (=) : unit + +###### val (land) : unit + + +### Advanced Module Stuff +--- + +###### module CollectionModule : sig + +######     type collection + +This comment is for `` collection `` . +######     type element + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + +This comment is for `` CollectionModule `` . +###### module type COLLECTION = sig + +This comment is for `` CollectionModule `` . +######     type collection + +This comment is for `` collection `` . +######     type element + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + +module type of +###### module Recollection : sig + + +# Parameters + +######     module C : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +# Signature + +This comment is for `` CollectionModule `` . +######     type collection = C.element list + +This comment is for `` collection `` . +######     type element = C.collection + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + +###### module type MMM = sig + +######     module C : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +###### end + +###### module type RECOLLECTION = sig + +######     module C = Recollection(CollectionModule) + + +###### end + +###### module type RecollectionModule = sig + +######     type collection = CollectionModule.element list + +######     type element = CollectionModule.collection + +######     module InnerModuleA : sig + +######         type t = collection + +This comment is for `` t `` . +######         module InnerModuleA' : sig + +######             type t = (unit, unit) a_function + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleA' `` . +######         module type InnerModuleTypeA' = sig + +######             type t = InnerModuleA'.t + +This comment is for `` t `` . + +######         end + +This comment is for `` InnerModuleTypeA' `` . + +######     end + +This comment is for `` InnerModuleA `` . +######     module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +###### end + +###### module type A = sig + +######     type t + +######     module Q : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +###### end + +###### module type B = sig + +######     type t + +######     module Q : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +###### end + +###### module type C = sig + +######     type t + +######     module Q : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +###### end + +This module type includes two signatures. +###### module FunctorTypeOf : sig + + +# Parameters + +######     module Collection : sig + +This comment is for `` CollectionModule `` . +######         type collection + +This comment is for `` collection `` . +######         type element + +######         module InnerModuleA : sig + +######             type t = collection + +This comment is for `` t `` . +######             module InnerModuleA' : sig + +######                 type t = (unit, unit) a_function + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleA' `` . +######             module type InnerModuleTypeA' = sig + +######                 type t = InnerModuleA'.t + +This comment is for `` t `` . + +######             end + +This comment is for `` InnerModuleTypeA' `` . + +######         end + +This comment is for `` InnerModuleA `` . +######         module type InnerModuleTypeA = InnerModuleA.InnerModuleTypeA' + +This comment is for `` InnerModuleTypeA `` . + +######     end + + +# Signature + +######     type t = Collection.collection + +This comment is for `` t `` . + +###### end + +This comment is for `` FunctorTypeOf `` . +###### module type IncludeModuleType = sig + + +###### end + +This comment is for `` IncludeModuleType `` . +###### module type ToInclude = sig + +######     module IncludedA : sig + +######         type t + + +######     end + +######     module type IncludedB = sig + +######         type s + + +######     end + + +###### end + +###### module IncludedA : sig + +######     type t + + +###### end + +###### module type IncludedB = sig + +######     type s + + +###### end + + +### Advanced Type Stuff +--- + +###### type record = { +######      `` field1 : int; `` + +This comment is for `` field1 `` . + +######      `` field2 : int; `` + +This comment is for `` field2 `` . +###### } + +This comment is for `` record `` . +This comment is also for `` record `` . +###### type mutable_record = { +######      `` mutable a : int; `` + + `` a `` is first and mutable + +######      `` b : unit; `` + + `` b `` is second and immutable + +######      `` mutable c : int; `` + + `` c `` is third and mutable +###### } + +###### type universe_record = { +######      `` nihilate : a. 'a -> unit; `` + +###### } + +###### type variant = +######     | TagA + +This comment is for `` TagA `` . + +######     | ConstrB of int + +This comment is for `` ConstrB `` . + +######     | ConstrC of int * int + +This comment is for binary `` ConstrC `` . + +######     | ConstrD of int * int + +This comment is for unary `` ConstrD `` of binary tuple. + + +This comment is for `` variant `` . +This comment is also for `` variant `` . +###### type poly_variant = [ +######      `` | `` `` `TagA `` + + +######      `` | `` `` `ConstrB of int `` + + ] + +This comment is for `` poly_variant `` . +Wow! It was a polymorphic variant! +###### type (_, _) full_gadt = +######     | Tag : (unit, unit) full_gadt + + +######     | First : 'a -> ('a, unit) full_gadt + + +######     | Second : 'a -> (unit, 'a) full_gadt + + +######     | Exist : 'a * 'b -> ('b, unit) full_gadt + + + +This comment is for `` full_gadt `` . +Wow! It was a GADT! +###### type 'a partial_gadt = +######     | AscribeTag : 'a partial_gadt + + +######     | OfTag of 'a partial_gadt + + +######     | ExistGadtTag : ('a -> 'b) -> 'a partial_gadt + + + +This comment is for `` partial_gadt `` . +Wow! It was a mixed GADT! +###### type alias = variant + +This comment is for `` alias `` . +###### type tuple = (alias * alias) * alias * (alias * alias) + +This comment is for `` tuple `` . +###### type variant_alias = variant = +######     | TagA + + +######     | ConstrB of int + + +######     | ConstrC of int * int + + +######     | ConstrD of int * int + + + +This comment is for `` variant_alias `` . +###### type record_alias = record = { +######      `` field1 : int; `` + + +######      `` field2 : int; `` + +###### } + +This comment is for `` record_alias `` . +###### type poly_variant_union = [ +######      `` | `` `` poly_variant `` + + +######      `` | `` `` `TagC `` + + ] + +This comment is for `` poly_variant_union `` . +###### type 'a poly_poly_variant = [ +######      `` | `` `` `TagA of 'a `` + + ] + +###### type ('a, 'b) bin_poly_poly_variant = [ +######      `` | `` `` `TagA of 'a `` + + +######      `` | `` `` `ConstrB of 'b `` + + ] + +###### type 'a open_poly_variant = [> `TagA ] as 'a + +###### type 'a open_poly_variant2 = [> `ConstrB of int ] as 'a + +###### type 'a open_poly_variant_alias = 'a open_poly_variant open_poly_variant2 + +###### type 'a poly_fun = [> `ConstrB of int ] as 'a -> 'a + +###### type 'a poly_fun_constraint = 'a -> 'a constraint 'a = [> `TagA ] + +###### type 'a closed_poly_variant = [< `One | `Two ] as 'a + +###### type 'a clopen_poly_variant = [< `One | `Two of int | `Three Two Three ] as 'a + +###### type nested_poly_variant = [ +######      `` | `` `` `A `` + + +######      `` | `` `` `B of [ `B1 | `B2 ] `` + + +######      `` | `` `` `C `` + + +######      `` | `` `` `D of [ `D1 of [ `D1a ] ] `` + + ] + +###### type ('a, 'b) full_gadt_alias = ('a, 'b) full_gadt = +######     | Tag : (unit, unit) full_gadt_alias + + +######     | First : 'a -> ('a, unit) full_gadt_alias + + +######     | Second : 'a -> (unit, 'a) full_gadt_alias + + +######     | Exist : 'a * 'b -> ('b, unit) full_gadt_alias + + + +This comment is for `` full_gadt_alias `` . +###### type 'a partial_gadt_alias = 'a partial_gadt = +######     | AscribeTag : 'a partial_gadt_alias + + +######     | OfTag of 'a partial_gadt_alias + + +######     | ExistGadtTag : ('a -> 'b) -> 'a partial_gadt_alias + + + +This comment is for `` partial_gadt_alias `` . +###### exception Exn_arrow : unit -> exn + +This comment is for `` Exn_arrow `` . +###### type mutual_constr_a = +######     | A + + +######     | B_ish of mutual_constr_b + +This comment is between `` mutual_constr_a `` and `` mutual_constr_b `` . + + +This comment is for `` mutual_constr_a `` then `` mutual_constr_b `` . +###### and mutual_constr_b = +######     | B + + +######     | A_ish of mutual_constr_a + +This comment must be here for the next to associate correctly. + + +This comment is for `` mutual_constr_b `` then `` mutual_constr_a `` . +###### type rec_obj = < f : int; g : unit -> unit; h : rec_obj; > + +###### type 'a open_obj = < f : int; g : unit -> unit; .. > as 'a + +###### type 'a oof = < a : unit; .. > as 'a -> 'a + +###### type 'a any_obj = < .. > as 'a + +###### type empty_obj = < > + +###### type one_meth = < meth : unit; > + +###### type ext = .. + +A mystery wrapped in an ellipsis +###### type ext += +######     | ExtA + + + +###### type ext += +######     | ExtB + + + +###### type ext += +######     | ExtC of unit + + +######     | ExtD of ext + + + +###### type ext += +######     | ExtE + + + +###### type ext += +######     | ExtF + + + +###### type 'a poly_ext = .. + +'a poly_ext +###### type poly_ext += +######     | Foo of 'b + + +######     | Bar of 'b * 'b + +'b poly_ext + + +###### type poly_ext += +######     | Quux of 'c + +'c poly_ext + + +###### module ExtMod : sig + +######     type t = .. + +######     type t += +######         | Leisureforce + + + + +###### end + +###### type ExtMod.t += +######     | ZzzTop0 + +It's got the rock + + +###### type ExtMod.t += +######     | ZzzTop of unit + +and it packs a unit. + + +###### val launch_missiles : unit -> unit + +Rotate keys on my mark... +###### type my_mod = (module COLLECTION) + +A brown paper package tied up with string +###### class empty_class : object +###### end + +###### class one_method_class : object + +######     method go : unit + + +###### end + +###### class two_method_class : object + +######     method one : one_method_class + +######     method undo : unit + + +###### end + +###### class 'a param_class : object + +######     method v : 'a + + +###### end + +###### type my_unit_object = unit param_class + +###### type 'a my_unit_class = unit param_class as 'a + +###### module Dep1 : sig + +######     module type S = sig + +######         class c : object + +######             method m : int + + +######         end + + +######     end + +######     module X : sig + +######         module Y : sig + +######             class c : object + +######                 method m : int + + +######             end + + +######         end + + +######     end + + +###### end + +###### module Dep2 : sig + + +# Parameters + +######     module Arg : sig + +######         module type S + +######         module X : sig + +######             module Y : S + + +######         end + + +######     end + + +# Signature + +######     module A : sig + +######         module Y : Arg.S + + +######     end + +######     module B = A.Y + + +###### end + +###### type dep1 = Dep2(Dep1).B.c + +###### module Dep3 : sig + +######     type a + + +###### end + +###### module Dep4 : sig + +######     module type T = sig + +######         type b + + +######     end + +######     module type S = sig + +######         module X : sig + +######             type b + + +######         end + +######         module Y : sig +######         end + + +######     end + +######     module X : sig + +######         type b + + +######     end + + +###### end + +###### module Dep5 : sig + + +# Parameters + +######     module Arg : sig + +######         module type T + +######         module type S = sig + +######             module X : T + +######             module Y : sig +######             end + + +######         end + +######         module X : T + + +######     end + + +# Signature + +######     module Z : sig + +######         module X : Arg.T + +######         module Y = Dep3 + + +######     end + + +###### end + +###### type dep2 = Dep5(Dep4).Z.X.b + +###### type dep3 = Dep5(Dep4).Z.Y.a + +###### module Dep6 : sig + +######     module type S = sig + +######         type d + + +######     end + +######     module type T = sig + +######         module type R = S + +######         module Y : sig + +######             type d + + +######         end + + +######     end + +######     module X : sig + +######         module type R = S + +######         module Y : sig + +######             type d + + +######         end + + +######     end + + +###### end + +###### module Dep7 : sig + + +# Parameters + +######     module Arg : sig + +######         module type S + +######         module type T = sig + +######             module type R = S + +######             module Y : R + + +######         end + +######         module X : sig + +######             module type R = S + +######             module Y : R + + +######         end + + +######     end + + +# Signature + +######     module M : sig + +######         module type R = Arg.S + +######         module Y : R + + +######     end + + +###### end + +###### type dep4 = Dep7(Dep6).M.Y.d + +###### module Dep8 : sig + +######     module type T = sig + +######         type t + + +######     end + + +###### end + +###### module Dep9 : sig + + +# Parameters + +######     module X : sig + +######         module type T + + +######     end + + +# Signature + +######     module type T = X.T + + +###### end + +###### module type Dep10 = sig + +######     type t = int + + +###### end + +###### module Dep11 : sig + +######     module type S = sig + +######         class c : object + +######             method m : int + + +######         end + + +######     end + + +###### end + +###### module Dep12 : sig + + +# Parameters + +######     module Arg : sig + +######         module type S + + +######     end + + +# Signature + +######     module type T = Arg.S + + +###### end + +###### module Dep13 : sig + +######     class c : object + +######         method m : int + + +######     end + + +###### end + +###### type dep5 = Dep13.c + +###### module type With1 = sig + +######     module M : sig + +######         module type S + + +######     end + +######     module N : M.S + + +###### end + +###### module With2 : sig + +######     module type S = sig + +######         type t + + +######     end + + +###### end + +###### module With3 : sig + +######     module M = With2 + +######     module N : sig + +######         type t + + +######     end + + +###### end + +###### type with1 = With3.N.t + +###### module With4 : sig + +######     module N : sig + +######         type t + + +######     end + + +###### end + +###### type with2 = With4.N.t + +###### module With5 : sig + +######     module type S = sig + +######         type t + + +######     end + +######     module N : sig + +######         type t + + +######     end + + +###### end + +###### module With6 : sig + +######     module type T = sig + +######         module M : sig + +######             module type S + +######             module N : S + + +######         end + + +######     end + + +###### end + +###### module With7 : sig + + +# Parameters + +######     module X : sig + +######         module type T + + +######     end + + +# Signature + +######     module type T = X.T + + +###### end + +###### module type With8 = sig + +######     module M : sig + +######         module type S = With5.S + +######         module N : sig + +######             type t = With5.N.t + + +######         end + + +######     end + + +###### end + +###### module With9 : sig + +######     module type S = sig + +######         type t + + +######     end + + +###### end + +###### module With10 : sig + +######     module type T = sig + +######         module M : sig + +######             module type S + + +######         end + +######         module N : M.S + + +######     end + + `` With10.T `` is a submodule type. + +###### end + +###### module type With11 = sig + +######     module M = With9 + +######     module N : sig + +######         type t = int + + +######     end + + +###### end + +###### module type NestedInclude1 = sig + +######     module type NestedInclude2 = sig + +######         type nested_include + + +######     end + + +###### end + +###### module type NestedInclude2 = sig + +######     type nested_include + + +###### end + +###### type nested_include = int + +###### module DoubleInclude1 : sig + +######     module DoubleInclude2 : sig + +######         type double_include + + +######     end + + +###### end + +###### module DoubleInclude3 : sig + +######     module DoubleInclude2 : sig + +######         type double_include + + +######     end + + +###### end + +###### type double_include + +###### module IncludeInclude1 : sig + +######     module type IncludeInclude2 = sig + +######         type include_include + + +######     end + +######     module IncludeInclude2_M : sig +######     end + + +###### end + +###### module type IncludeInclude2 = sig + +######     type include_include + + +###### end + +###### module IncludeInclude2_M : sig +###### end + +###### type include_include + + +# Trying the {!modules: ...} command. + +With ocamldoc, toplevel units will be linked and documented, while submodules will behave as simple references. +With odoc, everything should be resolved (and linked) but only toplevel units will be documented. + +@ `` Dep1.X `` : + + + +@ `` Ocamlary.IncludeInclude1 `` : + + + +@ `` Ocamlary `` : This is an _interface_ with **all** of the _module system_ features. This documentation demonstrates: + + +### Weirder usages involving module types +--- + + +@ `` IncludeInclude1.IncludeInclude2_M `` : + + + +@ `` Dep4.X `` : + + +# Playing with @canonical paths + +###### module CanonicalTest : sig + +######     module Base : sig + +######         module List : sig + +######             type 'a t + +######             val id : 'a t -> 'a t + + +######         end + + +######     end + +######     module Base_Tests : sig + +######         module C : sig + +######             type 'a t + +######             val id : 'a t -> 'a t + + +######         end + +######         module L = Base.List + +######         val foo : int L.t -> float L.t + +######         val bar : 'a Base.List.t -> 'a Base.List.t + +This is just `` List `` .id, or rather `` L.id `` +######         val baz : 'a Base.List.t -> unit + +We can't reference `` Base__ `` because it's hidden. `` List `` .t ( `` List.t `` ) should resolve. + +######     end + +######     module List_modif : sig + +######         type 'c t = 'c Base.List.t + +######         val id : 'a t -> 'a t + + +######     end + + +###### end + +###### val test : 'a CanonicalTest.Base__.List.t -> unit + +Some ref to `` CanonicalTest.Base_Tests.C.t `` and `` CanonicalTest.Base_Tests.L.id `` . But also to `` CanonicalTest.Base.List `` and `` CanonicalTest.Base.List.t `` + +# Aliases again + +###### module Aliases : sig + +######     module Foo : sig + +######         module A : sig + +######             type t + +######             val id : t -> t + + +######         end + +######         module B : sig + +######             type t + +######             val id : t -> t + + +######         end + +######         module C : sig + +######             type t + +######             val id : t -> t + + +######         end + +######         module D : sig + +######             type t + +######             val id : t -> t + + +######         end + +######         module E : sig + +######             type t + +######             val id : t -> t + + +######         end + + +######     end + +######     module A' = Foo.A + +######     type tata = Foo.A.t + +######     type tbtb = Foo.B.t + +######     type tete + +######     type tata' = A'.t + +######     type tete2 = Foo.E.t + +######     module Std : sig + +######         module A = Foo.A + +######         module B = Foo.B + +######         module C = Foo.C + +######         module D = Foo.D + +######         module E = Foo.E + + +######     end + +######     type stde = Std.E.t + + +### include of Foo +--- + +Just for giggle, let's see what happens when we include `` Foo `` . +######     module A = Foo.A + +######     module B = Foo.B + +######     module C = Foo.C + +######     module D = Foo.D + +######     module E : sig + +######         type t + +######         val id : t -> t + + +######     end + +######     type testa = A.t + +And also, let's refer to `` A.t `` and `` Foo.B.id `` +######     module P1 : sig + +######         module Y : sig + +######             type t + +######             val id : t -> t + + +######         end + + +######     end + +######     module P2 : sig + +######         module Z = Z + + +######     end + +######     module X1 = P2.Z + +######     module X2 = P2.Z + +######     type p1 = X1.t + +######     type p2 = X2.t + + +###### end + +Let's imitate jst's layout. + +# Section title splicing + +I can refer to +- `` {!section:indexmodules} `` : Trying the {!modules: ...} command. + +- `` {!aliases} `` : Aliases again +But also to things in submodules: +- `` {!section:SuperSig.SubSigA.subSig} `` : `` SuperSig `` .SubSigA.subSig + +- `` {!Aliases.incl} `` : `` incl `` +And just to make sure we do not mess up: +- `` {{!section:indexmodules}A} `` : A + +- `` {{!aliases}B} `` : B + +- `` {{!section:SuperSig.SubSigA.subSig}C} `` : C + +- `` {{!Aliases.incl}D} `` : D + +# New reference syntax + +###### module type M = sig + +######     type t + + +###### end + +###### module M : sig + +######     type t + + +###### end + +Here goes: +- `` {!module-M.t} `` : `` M.t `` + +- `` {!module-type-M.t} `` : `` M.t `` +###### module Only_a_module : sig + +######     type t + + +###### end + +- `` {!Only_a_module.t} `` : `` Only_a_module.t `` + +- `` {!module-Only_a_module.t} `` : `` Only_a_module.t `` + +- `` {!module-Only_a_module.type-t} `` : `` Only_a_module.t `` + +- `` {!type:Only_a_module.t} `` : `` Only_a_module.t `` +###### module type TypeExt = sig + +######     type t = .. + +######     type t += +######         | C + + + +######     val f : t -> unit + + +###### end + +###### type new_t = .. + +###### type new_t += +######     | C + + + +###### module type TypeExtPruned = sig + +######     type new_t += +######         | C + + + +######     val f : new_t -> unit + + +###### end + diff --git a/test/generators/markdown/Ocamlary.one_method_class.md b/test/generators/markdown/Ocamlary.one_method_class.md new file mode 100644 index 0000000000..e10dcbd2e0 --- /dev/null +++ b/test/generators/markdown/Ocamlary.one_method_class.md @@ -0,0 +1,6 @@ +Ocamlaryone_method_class + +Class `` Ocamlary.one_method_class `` + +###### method go : unit + diff --git a/test/generators/markdown/Ocamlary.param_class.md b/test/generators/markdown/Ocamlary.param_class.md new file mode 100644 index 0000000000..e4006ce625 --- /dev/null +++ b/test/generators/markdown/Ocamlary.param_class.md @@ -0,0 +1,6 @@ +Ocamlaryparam_class + +Class `` Ocamlary.param_class `` + +###### method v : 'a + diff --git a/test/generators/markdown/Ocamlary.two_method_class.md b/test/generators/markdown/Ocamlary.two_method_class.md new file mode 100644 index 0000000000..f1849b58a9 --- /dev/null +++ b/test/generators/markdown/Ocamlary.two_method_class.md @@ -0,0 +1,8 @@ +Ocamlarytwo_method_class + +Class `` Ocamlary.two_method_class `` + +###### method one : one_method_class + +###### method undo : unit + diff --git a/test/generators/markdown/Recent.X.md b/test/generators/markdown/Recent.X.md new file mode 100644 index 0000000000..bc561b583f --- /dev/null +++ b/test/generators/markdown/Recent.X.md @@ -0,0 +1,12 @@ +RecentX + +Module `` Recent.X `` + +###### module L := Z.Y + +###### type t = int Z.Y.X.t + +###### type u := int + +###### type v = u Z.Y.X.t + diff --git a/test/generators/markdown/Recent.Z.Y.X.md b/test/generators/markdown/Recent.Z.Y.X.md new file mode 100644 index 0000000000..2adf0d289b --- /dev/null +++ b/test/generators/markdown/Recent.Z.Y.X.md @@ -0,0 +1,6 @@ +RecentZYX + +Module `` Y.X `` + +###### type 'a t + diff --git a/test/generators/markdown/Recent.Z.Y.md b/test/generators/markdown/Recent.Z.Y.md new file mode 100644 index 0000000000..db601a21e9 --- /dev/null +++ b/test/generators/markdown/Recent.Z.Y.md @@ -0,0 +1,11 @@ +RecentZY + +Module `` Z.Y `` + +###### module X : sig + +######     type 'a t + + +###### end + diff --git a/test/generators/markdown/Recent.Z.md b/test/generators/markdown/Recent.Z.md new file mode 100644 index 0000000000..43f7344e69 --- /dev/null +++ b/test/generators/markdown/Recent.Z.md @@ -0,0 +1,16 @@ +RecentZ + +Module `` Recent.Z `` + +###### module Y : sig + +######     module X : sig + +######         type 'a t + + +######     end + + +###### end + diff --git a/test/generators/markdown/Recent.md b/test/generators/markdown/Recent.md new file mode 100644 index 0000000000..91f1ac11ea --- /dev/null +++ b/test/generators/markdown/Recent.md @@ -0,0 +1,137 @@ +Recent + +Module `` Recent `` + +###### module type S = sig +###### end + +###### module type S1 = sig + + +## Parameters +--- + +######     module _ : sig +######     end + + +## Signature +--- + + +###### end + +###### type variant = +######     | A + + +######     | B of int + + +######     | C + +foo + +######     | D + +_bar_ + +######     | E of { +######      `` a : int; `` + +###### } + + + +###### type _ gadt = +######     | A : int gadt + + +######     | B : int -> string gadt + +foo + +######     | C : { +######      `` a : int; `` + +###### } -> unit gadt + + + +###### type polymorphic_variant = [ +######      `` | `` `` `A `` + + +######      `` | `` `` `B of int `` + + +######      `` | `` `` `C `` + +foo + +######      `` | `` `` `D `` + +bar + ] + +###### type empty_variant = | + +###### type nonrec nonrec_ = int + +###### type empty_conj = +######     | X : [< `X of & 'a & int * float ] -> empty_conj + + + +###### type conj = +######     | X : [< `X of int & [< `B of int & float ] ] -> conj + + + +###### val empty_conj : [< `X of & 'a & int * float ] + +###### val conj : [< `X of int & [< `B of int & float ] ] + +###### module Z : sig + +######     module Y : sig + +######         module X : sig + +######             type 'a t + + +######         end + + +######     end + + +###### end + +###### module X : sig + +######     module L := Z.Y + +######     type t = int Z.Y.X.t + +######     type u := int + +######     type v = u Z.Y.X.t + + +###### end + +###### module type PolyS = sig + +######     type t = [ +######          `` | `` `` `A `` + + +######          `` | `` `` `B `` + + ] + + +###### end + diff --git a/test/generators/markdown/Recent_impl.B.md b/test/generators/markdown/Recent_impl.B.md new file mode 100644 index 0000000000..0383f84f2c --- /dev/null +++ b/test/generators/markdown/Recent_impl.B.md @@ -0,0 +1,9 @@ +Recent_implB + +Module `` Recent_impl.B `` + +###### type t = +######     | B + + + diff --git a/test/generators/markdown/Recent_impl.Foo.A.md b/test/generators/markdown/Recent_impl.Foo.A.md new file mode 100644 index 0000000000..ed47b21913 --- /dev/null +++ b/test/generators/markdown/Recent_impl.Foo.A.md @@ -0,0 +1,9 @@ +Recent_implFooA + +Module `` Foo.A `` + +###### type t = +######     | A + + + diff --git a/test/generators/markdown/Recent_impl.Foo.B.md b/test/generators/markdown/Recent_impl.Foo.B.md new file mode 100644 index 0000000000..7cef05c1ba --- /dev/null +++ b/test/generators/markdown/Recent_impl.Foo.B.md @@ -0,0 +1,9 @@ +Recent_implFooB + +Module `` Foo.B `` + +###### type t = +######     | B + + + diff --git a/test/generators/markdown/Recent_impl.Foo.md b/test/generators/markdown/Recent_impl.Foo.md new file mode 100644 index 0000000000..090a0d59b5 --- /dev/null +++ b/test/generators/markdown/Recent_impl.Foo.md @@ -0,0 +1,24 @@ +Recent_implFoo + +Module `` Recent_impl.Foo `` + +###### module A : sig + +######     type t = +######         | A + + + + +###### end + +###### module B : sig + +######     type t = +######         | B + + + + +###### end + diff --git a/test/generators/markdown/Recent_impl.md b/test/generators/markdown/Recent_impl.md new file mode 100644 index 0000000000..97f519c3f2 --- /dev/null +++ b/test/generators/markdown/Recent_impl.md @@ -0,0 +1,71 @@ +Recent_impl + +Module `` Recent_impl `` + +###### module Foo : sig + +######     module A : sig + +######         type t = +######             | A + + + + +######     end + +######     module B : sig + +######         type t = +######             | B + + + + +######     end + + +###### end + +###### module B : sig + +######     type t = +######         | B + + + + +###### end + +###### type u + +###### module type S = sig + +######     module F : sig + + +## Parameters +--- + +######         module _ : sig +######         end + + +## Signature +--- + +######         type t + + +######     end + +######     module X : sig +######     end + +######     val f : F(X).t + + +###### end + +###### module B' = Foo.B + diff --git a/test/generators/markdown/Section.md b/test/generators/markdown/Section.md new file mode 100644 index 0000000000..edda3a4d12 --- /dev/null +++ b/test/generators/markdown/Section.md @@ -0,0 +1,35 @@ +Section + +Module `` Section `` + +This is the module comment. Eventually, sections won't be allowed in it. + +# Empty section + + +# Text only + +Foo bar. + +# Aside only + +Foo bar. + +# Value only + +###### val foo : unit + + +# Empty section + + +# within a comment + + +## and one with a nested section +--- + + +# _This_ `` section `` **title** has markup + +But links are impossible thanks to the parser, so we never have trouble rendering a section title in a table of contents – no link will be nested inside another link. diff --git a/test/generators/markdown/Stop.N.md b/test/generators/markdown/Stop.N.md new file mode 100644 index 0000000000..cd4a023df1 --- /dev/null +++ b/test/generators/markdown/Stop.N.md @@ -0,0 +1,6 @@ +StopN + +Module `` Stop.N `` + +###### val quux : int + diff --git a/test/generators/markdown/Stop.md b/test/generators/markdown/Stop.md new file mode 100644 index 0000000000..beffd0128e --- /dev/null +++ b/test/generators/markdown/Stop.md @@ -0,0 +1,20 @@ +Stop + +Module `` Stop `` + +This test cases exercises stop comments. +###### val foo : int + +This is normal commented text. +The next value is `` bar `` , and it should be missing from the documentation. There is also an entire module, `` M `` , which should also be hidden. It contains a nested stop comment, but that stop comment should not turn documentation back on in this outer module, because stop comments respect scope. +Documentation is on again. +Now, we have a nested module, and it has a stop comment between its two items. We want to see that the first item is displayed, but the second is missing, and the stop comment disables documenation only in that module, and not in this outer module. +###### module N : sig + +######     val quux : int + + +###### end + +###### val lol : int + diff --git a/test/generators/markdown/Stop_dead_link_doc.Foo.md b/test/generators/markdown/Stop_dead_link_doc.Foo.md new file mode 100644 index 0000000000..9a256d351c --- /dev/null +++ b/test/generators/markdown/Stop_dead_link_doc.Foo.md @@ -0,0 +1,6 @@ +Stop_dead_link_docFoo + +Module `` Stop_dead_link_doc.Foo `` + +###### type t + diff --git a/test/generators/markdown/Stop_dead_link_doc.md b/test/generators/markdown/Stop_dead_link_doc.md new file mode 100644 index 0000000000..01f72dc31d --- /dev/null +++ b/test/generators/markdown/Stop_dead_link_doc.md @@ -0,0 +1,42 @@ +Stop_dead_link_doc + +Module `` Stop_dead_link_doc `` + +###### module Foo : sig + +######     type t + + +###### end + +###### type foo = +######     | Bar of Foo.t + + + +###### type bar = +######     | Bar of { +######      `` field : Foo.t; `` + +###### } + + + +###### type foo_ = +######     | Bar_ of int * Foo.t * int + + + +###### type bar_ = +######     | Bar__ of Foo.t option + + + +###### type another_foo + +###### type another_bar + +###### type another_foo_ + +###### type another_bar_ + diff --git a/test/generators/markdown/Toplevel_comments.Alias.md b/test/generators/markdown/Toplevel_comments.Alias.md new file mode 100644 index 0000000000..131250deaf --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.Alias.md @@ -0,0 +1,8 @@ +Toplevel_commentsAlias + +Module `` Toplevel_comments.Alias `` + +Doc of `` Alias `` . +Doc of `` T `` , part 2. +###### type t + diff --git a/test/generators/markdown/Toplevel_comments.Include_inline'.md b/test/generators/markdown/Toplevel_comments.Include_inline'.md new file mode 100644 index 0000000000..25c817ff6e --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.Include_inline'.md @@ -0,0 +1,8 @@ +Toplevel_commentsInclude_inline' + +Module `` Toplevel_comments.Include_inline' `` + +Doc of `` Include_inline `` , part 1. +Doc of `` Include_inline `` , part 2. +###### type t + diff --git a/test/generators/markdown/Toplevel_comments.Include_inline.md b/test/generators/markdown/Toplevel_comments.Include_inline.md new file mode 100644 index 0000000000..60b719cd7e --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.Include_inline.md @@ -0,0 +1,7 @@ +Toplevel_commentsInclude_inline + +Module `` Toplevel_comments.Include_inline `` + +Doc of `` T `` , part 2. +###### type t + diff --git a/test/generators/markdown/Toplevel_comments.M''.md b/test/generators/markdown/Toplevel_comments.M''.md new file mode 100644 index 0000000000..2e59deb196 --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.M''.md @@ -0,0 +1,6 @@ +Toplevel_commentsM'' + +Module `` Toplevel_comments.M'' `` + +Doc of `` M'' `` , part 1. +Doc of `` M'' `` , part 2. diff --git a/test/generators/markdown/Toplevel_comments.M'.md b/test/generators/markdown/Toplevel_comments.M'.md new file mode 100644 index 0000000000..52ca6722a7 --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.M'.md @@ -0,0 +1,5 @@ +Toplevel_commentsM' + +Module `` Toplevel_comments.M' `` + +Doc of `` M' `` from outside diff --git a/test/generators/markdown/Toplevel_comments.M.md b/test/generators/markdown/Toplevel_comments.M.md new file mode 100644 index 0000000000..59a195939a --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.M.md @@ -0,0 +1,5 @@ +Toplevel_commentsM + +Module `` Toplevel_comments.M `` + +Doc of `` M `` diff --git a/test/generators/markdown/Toplevel_comments.Ref_in_synopsis.md b/test/generators/markdown/Toplevel_comments.Ref_in_synopsis.md new file mode 100644 index 0000000000..1e9f6a5eac --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.Ref_in_synopsis.md @@ -0,0 +1,8 @@ +Toplevel_commentsRef_in_synopsis + +Module `` Toplevel_comments.Ref_in_synopsis `` + + `` t `` . +This reference should resolve in the context of this module, even when used as a synopsis. +###### type t + diff --git a/test/generators/markdown/Toplevel_comments.c1.md b/test/generators/markdown/Toplevel_comments.c1.md new file mode 100644 index 0000000000..f96924ff75 --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.c1.md @@ -0,0 +1,6 @@ +Toplevel_commentsc1 + +Class `` Toplevel_comments.c1 `` + +Doc of `` c1 `` , part 1. +Doc of `` c1 `` , part 2. diff --git a/test/generators/markdown/Toplevel_comments.c2.md b/test/generators/markdown/Toplevel_comments.c2.md new file mode 100644 index 0000000000..9defa6e61f --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.c2.md @@ -0,0 +1,6 @@ +Toplevel_commentsc2 + +Class `` Toplevel_comments.c2 `` + +Doc of `` c2 `` . +Doc of `` ct `` , part 2. diff --git a/test/generators/markdown/Toplevel_comments.md b/test/generators/markdown/Toplevel_comments.md new file mode 100644 index 0000000000..5f4a660006 --- /dev/null +++ b/test/generators/markdown/Toplevel_comments.md @@ -0,0 +1,85 @@ +Toplevel_comments + +Module `` Toplevel_comments `` + +A doc comment at the beginning of a module is considered to be that module's doc. +###### module type T = sig + +######     type t + + +###### end + +Doc of `` T `` , part 1. +###### module Include_inline : sig + +######     type t + + +###### end + +Doc of `` T `` , part 2. +###### module Include_inline' : sig + +######     type t + + +###### end + +Doc of `` Include_inline `` , part 1. +###### module type Include_inline_T = sig + +######     type t + + +###### end + +Doc of `` T `` , part 2. +###### module type Include_inline_T' = sig + +######     type t + + +###### end + +Doc of `` Include_inline_T' `` , part 1. +###### module M : sig +###### end + +Doc of `` M `` +###### module M' : sig +###### end + +Doc of `` M' `` from outside +###### module M'' : sig +###### end + +Doc of `` M'' `` , part 1. +###### module Alias : sig + +######     type t + + +###### end + +Doc of `` Alias `` . +###### class c1 : object +###### end + +Doc of `` c1 `` , part 1. +###### class type ct = object +###### end + +Doc of `` ct `` , part 1. +###### class c2 : object +###### end + +Doc of `` c2 `` . +###### module Ref_in_synopsis : sig + +######     type t + + +###### end + + `` t `` . diff --git a/test/generators/markdown/Type.md b/test/generators/markdown/Type.md new file mode 100644 index 0000000000..2f4a027de3 --- /dev/null +++ b/test/generators/markdown/Type.md @@ -0,0 +1,211 @@ +Type + +Module `` Type `` + +###### type abstract + +Some _documentation_. +###### type alias = int + +###### type private_ = private int + +###### type 'a constructor = 'a + +###### type arrow = int -> int + +###### type higher_order = (int -> int) -> int + +###### type labeled = l:int -> int + +###### type optional = ?l:int -> int + +###### type labeled_higher_order = (l:int -> int) -> (?l:int -> int) -> int + +###### type pair = int * int + +###### type parens_dropped = int * int + +###### type triple = int * int * int + +###### type nested_pair = (int * int) * int + +###### type instance = int constructor + +###### type long = labeled_higher_order -> [ `Bar | `Baz of triple ] -> pair -> labeled -> higher_order -> (string -> int) -> (int * float * char * string * char * unit) option -> nested_pair -> arrow -> string -> nested_pair array + +###### type variant_e = { +######      `` a : int; `` + +###### } + +###### type variant = +######     | A + + +######     | B of int + + +######     | C + +foo + +######     | D + +_bar_ + +######     | E of variant_e + + + +###### type variant_c = { +######      `` a : int; `` + +###### } + +###### type _ gadt = +######     | A : int gadt + + +######     | B : int -> string gadt + + +######     | C : variant_c -> unit gadt + + + +###### type degenerate_gadt = +######     | A : degenerate_gadt + + + +###### type private_variant = private +######     | A + + + +###### type record = { +######      `` a : int; `` + + +######      `` mutable b : int; `` + + +######      `` c : int; `` + +foo + +######      `` d : int; `` + +_bar_ + +######      `` e : a. 'a; `` + +###### } + +###### type polymorphic_variant = [ +######      `` | `` `` `A `` + + +######      `` | `` `` `B of int `` + + +######      `` | `` `` `C of int * unit `` + + +######      `` | `` `` `D `` + + ] + +###### type polymorphic_variant_extension = [ +######      `` | `` `` polymorphic_variant `` + + +######      `` | `` `` `E `` + + ] + +###### type nested_polymorphic_variant = [ +######      `` | `` `` `A of [ `B | `C ] `` + + ] + +###### type private_extenion#row + +###### and private_extenion = private [> +######      `` | `` `` polymorphic_variant `` + + ] + +###### type object_ = < a : int; b : int; c : int; > + +###### module type X = sig + +######     type t + +######     type u + + +###### end + +###### type module_ = (module X) + +###### type module_substitution = (module X with type t = int and type u = unit) + +###### type +'a covariant + +###### type -'a contravariant + +###### type _ bivariant = int + +###### type ('a, 'b) binary + +###### type using_binary = (int, int) binary + +###### type 'custom name + +###### type 'a constrained = 'a constraint 'a = int + +###### type 'a exact_variant = 'a constraint 'a = [ `A | `B of int ] + +###### type 'a lower_variant = 'a constraint 'a = [> `A | `B of int ] + +###### type 'a any_variant = 'a constraint 'a = [> ] + +###### type 'a upper_variant = 'a constraint 'a = [< `A | `B of int ] + +###### type 'a named_variant = 'a constraint 'a = [< polymorphic_variant ] + +###### type 'a exact_object = 'a constraint 'a = < a : int; b : int; > + +###### type 'a lower_object = 'a constraint 'a = < a : int; b : int; .. > + +###### type 'a poly_object = 'a constraint 'a = < a : a. 'a; > + +###### type ('a, 'b) double_constrained = 'a * 'b constraint 'a = int constraint 'b = unit + +###### type as_ = int as 'a * 'a + +###### type extensible = .. + +###### type extensible += +######     | Extension + +Documentation for `` Extension `` . + +######     | Another_extension + +Documentation for `` Another_extension `` . + + +###### type mutually = +######     | A of recursive + + + +###### and recursive = +######     | B of mutually + + + +###### exception Foo of int * int + diff --git a/test/generators/markdown/Val.md b/test/generators/markdown/Val.md new file mode 100644 index 0000000000..d25ea1d88a --- /dev/null +++ b/test/generators/markdown/Val.md @@ -0,0 +1,12 @@ +Val + +Module `` Val `` + +###### val documented : unit + +Foo. +###### val undocumented : unit + +###### val documented_above : unit + +Bar. diff --git a/test/generators/markdown/alias.targets b/test/generators/markdown/alias.targets new file mode 100644 index 0000000000..53bf0edee2 --- /dev/null +++ b/test/generators/markdown/alias.targets @@ -0,0 +1,2 @@ +Alias.md +Alias.X.md diff --git a/test/generators/markdown/bugs.targets b/test/generators/markdown/bugs.targets new file mode 100644 index 0000000000..f4ac3a475d --- /dev/null +++ b/test/generators/markdown/bugs.targets @@ -0,0 +1 @@ +Bugs.md diff --git a/test/generators/markdown/bugs_post_406.targets b/test/generators/markdown/bugs_post_406.targets new file mode 100644 index 0000000000..f0fc12106a --- /dev/null +++ b/test/generators/markdown/bugs_post_406.targets @@ -0,0 +1,2 @@ +Bugs_post_406.md +Bugs_post_406.let_open'.md diff --git a/test/generators/markdown/class.targets b/test/generators/markdown/class.targets new file mode 100644 index 0000000000..329acef839 --- /dev/null +++ b/test/generators/markdown/class.targets @@ -0,0 +1,5 @@ +Class.md +Class.mutually'.md +Class.recursive'.md +Class.empty_virtual'.md +Class.polymorphic'.md diff --git a/test/generators/markdown/external.targets b/test/generators/markdown/external.targets new file mode 100644 index 0000000000..6151f8c64f --- /dev/null +++ b/test/generators/markdown/external.targets @@ -0,0 +1 @@ +External.md diff --git a/test/generators/markdown/functor.targets b/test/generators/markdown/functor.targets new file mode 100644 index 0000000000..567a94e9b3 --- /dev/null +++ b/test/generators/markdown/functor.targets @@ -0,0 +1,6 @@ +Functor.md +Functor.F1.md +Functor.F2.md +Functor.F3.md +Functor.F4.md +Functor.F5.md diff --git a/test/generators/markdown/functor2.targets b/test/generators/markdown/functor2.targets new file mode 100644 index 0000000000..b7a30bb96f --- /dev/null +++ b/test/generators/markdown/functor2.targets @@ -0,0 +1,2 @@ +Functor2.md +Functor2.X.md diff --git a/test/generators/markdown/include.targets b/test/generators/markdown/include.targets new file mode 100644 index 0000000000..131b81976f --- /dev/null +++ b/test/generators/markdown/include.targets @@ -0,0 +1 @@ +Include.md diff --git a/test/generators/markdown/include2.targets b/test/generators/markdown/include2.targets new file mode 100644 index 0000000000..b048561857 --- /dev/null +++ b/test/generators/markdown/include2.targets @@ -0,0 +1,5 @@ +Include2.md +Include2.X.md +Include2.Y.md +Include2.Y_include_synopsis.md +Include2.Y_include_doc.md diff --git a/test/generators/markdown/include_sections.targets b/test/generators/markdown/include_sections.targets new file mode 100644 index 0000000000..1460c11c0d --- /dev/null +++ b/test/generators/markdown/include_sections.targets @@ -0,0 +1 @@ +Include_sections.md diff --git a/test/generators/markdown/interlude.targets b/test/generators/markdown/interlude.targets new file mode 100644 index 0000000000..71d1c93d24 --- /dev/null +++ b/test/generators/markdown/interlude.targets @@ -0,0 +1 @@ +Interlude.md diff --git a/test/generators/markdown/labels.targets b/test/generators/markdown/labels.targets new file mode 100644 index 0000000000..0509c727a9 --- /dev/null +++ b/test/generators/markdown/labels.targets @@ -0,0 +1,3 @@ +Labels.md +Labels.A.md +Labels.c.md diff --git a/test/generators/markdown/markup.targets b/test/generators/markdown/markup.targets new file mode 100644 index 0000000000..50ee6d91a1 --- /dev/null +++ b/test/generators/markdown/markup.targets @@ -0,0 +1,3 @@ +Markup.md +Markup.X.md +Markup.Y.md diff --git a/test/generators/markdown/mld.md b/test/generators/markdown/mld.md new file mode 100644 index 0000000000..611b9446c9 --- /dev/null +++ b/test/generators/markdown/mld.md @@ -0,0 +1,31 @@ +mld + + Mld Page +--- + +This is an `` .mld `` file. It doesn't have an auto-generated title, like modules and other pages generated fully by odoc do. +It will have a TOC generated from section headings. + +# Section + +This is a section. +Another paragraph in section. + +# Another section + +This is another section. +Another paragraph in section 2. + +## Subsection +--- + +This is a subsection. +Another paragraph in subsection. +Yet another paragraph in subsection. + +## Another Subsection +--- + +This is another subsection. +Another paragraph in subsection 2. +Yet another paragraph in subsection 2. diff --git a/test/generators/markdown/module.targets b/test/generators/markdown/module.targets new file mode 100644 index 0000000000..b653c5d3d6 --- /dev/null +++ b/test/generators/markdown/module.targets @@ -0,0 +1,4 @@ +Module.md +Module.M'.md +Module.Mutually.md +Module.Recursive.md diff --git a/test/generators/markdown/module_type_alias.targets b/test/generators/markdown/module_type_alias.targets new file mode 100644 index 0000000000..712debbd3b --- /dev/null +++ b/test/generators/markdown/module_type_alias.targets @@ -0,0 +1 @@ +Module_type_alias.md diff --git a/test/generators/markdown/nested.targets b/test/generators/markdown/nested.targets new file mode 100644 index 0000000000..534c100fc4 --- /dev/null +++ b/test/generators/markdown/nested.targets @@ -0,0 +1,5 @@ +Nested.md +Nested.X.md +Nested.F.md +Nested.z.md +Nested.inherits.md diff --git a/test/generators/markdown/ocamlary.targets b/test/generators/markdown/ocamlary.targets new file mode 100644 index 0000000000..661ece1dca --- /dev/null +++ b/test/generators/markdown/ocamlary.targets @@ -0,0 +1,79 @@ +Ocamlary.md +Ocamlary.Empty.md +Ocamlary.ModuleWithSignature.md +Ocamlary.ModuleWithSignatureAlias.md +Ocamlary.One.md +Ocamlary.Buffer.md +Ocamlary.CollectionModule.md +Ocamlary.CollectionModule.InnerModuleA.md +Ocamlary.CollectionModule.InnerModuleA.InnerModuleA'.md +Ocamlary.Recollection.md +Ocamlary.Recollection.InnerModuleA.md +Ocamlary.Recollection.InnerModuleA.InnerModuleA'.md +Ocamlary.FunctorTypeOf.md +Ocamlary.IncludedA.md +Ocamlary.ExtMod.md +Ocamlary.empty_class.md +Ocamlary.one_method_class.md +Ocamlary.two_method_class.md +Ocamlary.param_class.md +Ocamlary.Dep1.md +Ocamlary.Dep1.X.md +Ocamlary.Dep1.X.Y.md +Ocamlary.Dep1.X.Y.c.md +Ocamlary.Dep2.md +Ocamlary.Dep2.A.md +Ocamlary.Dep3.md +Ocamlary.Dep4.md +Ocamlary.Dep4.X.md +Ocamlary.Dep5.md +Ocamlary.Dep5.Z.md +Ocamlary.Dep6.md +Ocamlary.Dep6.X.md +Ocamlary.Dep6.X.Y.md +Ocamlary.Dep7.md +Ocamlary.Dep7.M.md +Ocamlary.Dep8.md +Ocamlary.Dep9.md +Ocamlary.Dep11.md +Ocamlary.Dep12.md +Ocamlary.Dep13.md +Ocamlary.Dep13.c.md +Ocamlary.With2.md +Ocamlary.With3.md +Ocamlary.With3.N.md +Ocamlary.With4.md +Ocamlary.With4.N.md +Ocamlary.With5.md +Ocamlary.With5.N.md +Ocamlary.With6.md +Ocamlary.With7.md +Ocamlary.With9.md +Ocamlary.With10.md +Ocamlary.DoubleInclude1.md +Ocamlary.DoubleInclude1.DoubleInclude2.md +Ocamlary.DoubleInclude3.md +Ocamlary.DoubleInclude3.DoubleInclude2.md +Ocamlary.IncludeInclude1.md +Ocamlary.IncludeInclude1.IncludeInclude2_M.md +Ocamlary.IncludeInclude2_M.md +Ocamlary.CanonicalTest.md +Ocamlary.CanonicalTest.Base.md +Ocamlary.CanonicalTest.Base.List.md +Ocamlary.CanonicalTest.Base_Tests.md +Ocamlary.CanonicalTest.Base_Tests.C.md +Ocamlary.CanonicalTest.List_modif.md +Ocamlary.Aliases.md +Ocamlary.Aliases.Foo.md +Ocamlary.Aliases.Foo.A.md +Ocamlary.Aliases.Foo.B.md +Ocamlary.Aliases.Foo.C.md +Ocamlary.Aliases.Foo.D.md +Ocamlary.Aliases.Foo.E.md +Ocamlary.Aliases.Std.md +Ocamlary.Aliases.E.md +Ocamlary.Aliases.P1.md +Ocamlary.Aliases.P1.Y.md +Ocamlary.Aliases.P2.md +Ocamlary.M.md +Ocamlary.Only_a_module.md diff --git a/test/generators/markdown/page-mld.targets b/test/generators/markdown/page-mld.targets new file mode 100644 index 0000000000..24638fb1c8 --- /dev/null +++ b/test/generators/markdown/page-mld.targets @@ -0,0 +1 @@ +mld.md diff --git a/test/generators/markdown/recent.targets b/test/generators/markdown/recent.targets new file mode 100644 index 0000000000..bbeef54566 --- /dev/null +++ b/test/generators/markdown/recent.targets @@ -0,0 +1,5 @@ +Recent.md +Recent.Z.md +Recent.Z.Y.md +Recent.Z.Y.X.md +Recent.X.md diff --git a/test/generators/markdown/recent_impl.targets b/test/generators/markdown/recent_impl.targets new file mode 100644 index 0000000000..59e487a5f6 --- /dev/null +++ b/test/generators/markdown/recent_impl.targets @@ -0,0 +1,5 @@ +Recent_impl.md +Recent_impl.Foo.md +Recent_impl.Foo.A.md +Recent_impl.Foo.B.md +Recent_impl.B.md diff --git a/test/generators/markdown/section.targets b/test/generators/markdown/section.targets new file mode 100644 index 0000000000..fd90179afb --- /dev/null +++ b/test/generators/markdown/section.targets @@ -0,0 +1 @@ +Section.md diff --git a/test/generators/markdown/stop.targets b/test/generators/markdown/stop.targets new file mode 100644 index 0000000000..8e7281daf7 --- /dev/null +++ b/test/generators/markdown/stop.targets @@ -0,0 +1,2 @@ +Stop.md +Stop.N.md diff --git a/test/generators/markdown/stop_dead_link_doc.targets b/test/generators/markdown/stop_dead_link_doc.targets new file mode 100644 index 0000000000..c49fe54c7a --- /dev/null +++ b/test/generators/markdown/stop_dead_link_doc.targets @@ -0,0 +1,2 @@ +Stop_dead_link_doc.md +Stop_dead_link_doc.Foo.md diff --git a/test/generators/markdown/toplevel_comments.targets b/test/generators/markdown/toplevel_comments.targets new file mode 100644 index 0000000000..e6d01f18c0 --- /dev/null +++ b/test/generators/markdown/toplevel_comments.targets @@ -0,0 +1,10 @@ +Toplevel_comments.md +Toplevel_comments.Include_inline.md +Toplevel_comments.Include_inline'.md +Toplevel_comments.M.md +Toplevel_comments.M'.md +Toplevel_comments.M''.md +Toplevel_comments.Alias.md +Toplevel_comments.c1.md +Toplevel_comments.c2.md +Toplevel_comments.Ref_in_synopsis.md diff --git a/test/generators/markdown/type.targets b/test/generators/markdown/type.targets new file mode 100644 index 0000000000..d31977ea30 --- /dev/null +++ b/test/generators/markdown/type.targets @@ -0,0 +1 @@ +Type.md diff --git a/test/generators/markdown/val.targets b/test/generators/markdown/val.targets new file mode 100644 index 0000000000..48c8111582 --- /dev/null +++ b/test/generators/markdown/val.targets @@ -0,0 +1 @@ +Val.md