Skip to content

Commit

Permalink
Fix reference formatting
Browse files Browse the repository at this point in the history
  • Loading branch information
@Julow
Julow committed Apr 18, 2019
1 parent c9b589f commit 6c2dd6d
Show file tree
Hide file tree
Showing 3 changed files with 103 additions and 55 deletions.
117 changes: 62 additions & 55 deletions src/Fmt_odoc.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,73 +106,79 @@ let fmt_styled style fmt_elem elems =
(wrap "{" "}"
(str s $ fmt_if_not_empty elems "@ " $ list elems "" fmt_elem))

(* Format references From odoc's `html/comment.ml` *)
let rec fmt_reference_resolved : Reference.Resolved.t -> Fmt.t =
let rec fmt_reference_resolved =
let open Names in
let open Reference.Resolved in
let dot r s = fmt_reference_resolved r $ str "." $ str s in
let dot r s =
let _, k = fmt_reference_resolved r in
k $ str "." $ str s
in
function
| `Identifier id -> str (Identifier.name id)
| `Identifier id -> "", str (Identifier.name id)
| `SubstAlias (_, r) -> fmt_reference_resolved (r :> t)
| `Module (r, s) -> dot (r :> t) (ModuleName.to_string s)
| `Module (r, s) -> "module:", dot (r :> t) (ModuleName.to_string s)
| `Canonical (_, `Resolved r) -> fmt_reference_resolved (r :> t)
| `Canonical (p, _) -> fmt_reference_resolved (p :> t)
| `ModuleType (r, s) -> dot (r :> t) (ModuleTypeName.to_string s)
| `Type (r, s) -> dot (r :> t) (TypeName.to_string s)
| `Constructor (r, s) -> dot (r :> t) (ConstructorName.to_string s)
| `Field (r, s) -> dot (r :> t) (FieldName.to_string s)
| `Extension (r, s) -> dot (r :> t) (ExtensionName.to_string s)
| `Exception (r, s) -> dot (r :> t) (ExceptionName.to_string s)
| `Value (r, s) -> dot (r :> t) (ValueName.to_string s)
| `Class (r, s) -> dot (r :> t) (ClassName.to_string s)
| `ClassType (r, s) -> dot (r :> t) (ClassTypeName.to_string s)
| `Method (r, s) -> dot (r :> t) (MethodName.to_string s)
| `ModuleType (r, s) -> "module-type:", dot (r :> t) (ModuleTypeName.to_string s)
| `Type (r, s) -> "type:", dot (r :> t) (TypeName.to_string s)
| `Constructor (r, s) -> "constructor:", dot (r :> t) (ConstructorName.to_string s)
| `Field (r, s) -> "field:", dot (r :> t) (FieldName.to_string s)
| `Extension (r, s) -> "extension:", dot (r :> t) (ExtensionName.to_string s)
| `Exception (r, s) -> "exception:", dot (r :> t) (ExceptionName.to_string s)
| `Value (r, s) -> "val:", dot (r :> t) (ValueName.to_string s)
| `Class (r, s) -> "class:", dot (r :> t) (ClassName.to_string s)
| `ClassType (r, s) -> "class-type:", dot (r :> t) (ClassTypeName.to_string s)
| `Method (r, s) -> "method:", dot (r :> t) (MethodName.to_string s)
| `InstanceVariable (r, s) ->
dot (r :> t) (InstanceVariableName.to_string s)
"instance-variable:", dot (r :> t) (InstanceVariableName.to_string s)
| `Label (r, s) ->
fmt_reference_resolved (r :> t)
$ str ":"
$ str (LabelName.to_string s)
let kind, k = fmt_reference_resolved (r :> t) in
kind, k $ str ":" $ str (LabelName.to_string s)

let fmt_reference_kind =
function
| `TModule -> "module:"
| `TModuleType -> "module-type:"
| `TType -> "type:"
| `TConstructor -> "constructor:"
| `TField -> "field:"
| `TExtension -> "extension:"
| `TException -> "exception:"
| `TValue -> "value:"
| `TClass -> "class:"
| `TClassType -> "class-type:"
| `TMethod -> "method:"
| `TInstanceVariable -> "instance-variable:"
| `TLabel -> "label:"
| `TPage -> "page:"
| `TUnknown -> ""

let rec fmt_reference : Reference.t -> Fmt.t =
let rec fmt_reference : Reference.t -> _ =
let open Names in
let open Reference in
let dot p rhs = fmt_reference p $ str "." $ str rhs in
let dot p rhs =
let _, k = fmt_reference p in
k $ str "." $ str rhs
in
function
| `Root (s, _) -> str (UnitName.to_string s)
| `Dot (p, s) -> dot (p :> t) s
| `Module (p, s) -> dot (p :> t) (ModuleName.to_string s)
| `ModuleType (p, s) -> dot (p :> t) (ModuleTypeName.to_string s)
| `Type (p, s) -> dot (p :> t) (TypeName.to_string s)
| `Constructor (p, s) -> dot (p :> t) (ConstructorName.to_string s)
| `Field (p, s) -> dot (p :> t) (FieldName.to_string s)
| `Extension (p, s) -> dot (p :> t) (ExtensionName.to_string s)
| `Exception (p, s) -> dot (p :> t) (ExceptionName.to_string s)
| `Value (p, s) -> dot (p :> t) (ValueName.to_string s)
| `Class (p, s) -> dot (p :> t) (ClassName.to_string s)
| `ClassType (p, s) -> dot (p :> t) (ClassTypeName.to_string s)
| `Method (p, s) -> dot (p :> t) (MethodName.to_string s)
| `Root (s, kind) -> fmt_reference_kind kind, str (UnitName.to_string s)
| `Dot (p, s) -> "", dot (p :> t) s
| `Module (p, s) -> "module:", dot (p :> t) (ModuleName.to_string s)
| `ModuleType (p, s) -> "module-type:", dot (p :> t) (ModuleTypeName.to_string s)
| `Type (p, s) -> "type:", dot (p :> t) (TypeName.to_string s)
| `Constructor (p, s) -> "constructor:", dot (p :> t) (ConstructorName.to_string s)
| `Field (p, s) -> "field:", dot (p :> t) (FieldName.to_string s)
| `Extension (p, s) -> "extension:", dot (p :> t) (ExtensionName.to_string s)
| `Exception (p, s) -> "exception:", dot (p :> t) (ExceptionName.to_string s)
| `Value (p, s) -> "val:", dot (p :> t) (ValueName.to_string s)
| `Class (p, s) -> "class:", dot (p :> t) (ClassName.to_string s)
| `ClassType (p, s) -> "class-type:", dot (p :> t) (ClassTypeName.to_string s)
| `Method (p, s) -> "method:", dot (p :> t) (MethodName.to_string s)
| `InstanceVariable (p, s) ->
dot (p :> t) (InstanceVariableName.to_string s)
| `Label (p, s) -> dot (p :> t) (LabelName.to_string s)
"instance-variable:", dot (p :> t) (InstanceVariableName.to_string s)
| `Label (p, s) -> "label:", dot (p :> t) (LabelName.to_string s)
| `Resolved r -> fmt_reference_resolved r

let fmt_reference_kind : Reference.t -> Fmt.t = function
| `Module _ -> str "!module:"
| `ModuleType _ -> str "!modtype:"
| `Class _ -> str "!class:"
| `ClassType _ -> str "!classtype:"
| `Value _ -> str "!val:"
| `Type _ -> str "!type:"
| `Exception _ -> str "!exception:"
| `Method _ -> str "!method:"
| `Field _ -> str "!field:"
| `Label _ -> str "!label:"
| `Constructor _ -> str "!constructor:"
| `Extension _ -> str "!extension:"
| `InstanceVariable _ -> str "!instance-variable:"
| `Resolved _ | `Root _ | `Dot _ -> str "!"

let rec fmt_inline_element : inline_element -> Fmt.t = function
| `Space -> fmt "@ "
| `Word w ->
Expand All @@ -190,7 +196,8 @@ let rec fmt_inline_element : inline_element -> Fmt.t = function
| `Styled (style, elems) ->
fmt_styled style (ign_loc fmt_inline_element) elems
| `Reference (_kind, ref, txt) ->
let ref = wrap "{" "}" (fmt_reference_kind ref $ fmt_reference ref) in
let ref_kind, ref = fmt_reference (ref :> Reference.t) in
let ref = fmt "{!" $ str ref_kind $ ref $ fmt "}" in
if List.is_empty txt then ref
else hovbox 0 (wrap "{" "}" (ref $ fmt "@ " $ fmt_inline_elements txt))
| `Link (url, txt) -> (
Expand Down Expand Up @@ -243,7 +250,7 @@ and fmt_nestable_block_element : nestable_block_element -> t = function
| `Verbatim s -> vbox 0 (fmt "{v@;<1 -999>" $ str_verbatim s $ fmt "@ v}")
| `Modules mods ->
let mods = (mods :> Reference.t list) in
hovbox 0 (wrap "{!modules:@," "@,}" (list mods "@ " fmt_reference))
hovbox 0 (wrap "{!modules:@," "@,}" (list mods "@ " (fun ref -> snd (fmt_reference ref))))
| `List (k, items) when list_should_use_heavy_syntax items ->
fmt_list_heavy k items
| `List (k, items) -> fmt_list_light k items
Expand Down Expand Up @@ -299,7 +306,7 @@ let fmt_tag : tag -> Fmt.t = function
| `Closed -> at $ str "closed"
| `Canonical (_, ref) ->
(* TODO: print the path ? *)
let ref = fmt_reference (ref :> Reference.t) in
let _, ref = fmt_reference (ref :> Reference.t) in
at $ fmt "canonical@ " $ ref

let fmt_block_element = function
Expand Down
21 changes: 21 additions & 0 deletions test/passing/doc_comments.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -280,3 +280,24 @@ b
A
B
]} *)

(** {!module:A} {!module:A.B}
{!module-type:A} {!module-type:A.b}
{!class:c} {!class:M.c}
{!class-type:c} {!class-type:M.c}
{!val:x} {!val:M.x}
{!type:t} {!type:M.t}
{!exception:E} {!exception:M.E}
{!method:m} {!method:c.m}
{!constructor:C} {!constructor:M.C}
{!field:f} {!field:t.f} {!field:M.t.f}
*)
20 changes: 20 additions & 0 deletions test/passing/doc_comments.mli.ref
View file
Original file line number Diff line number Diff line change
Expand Up @@ -271,3 +271,23 @@ b
A
B
]} *)

(** {!module:A} {!module:A.B}

{!module-type:A} {!module-type:A.b}

{!class:c} {!class:M.c}

{!class-type:c} {!class-type:M.c}

{!value:x} {!val:M.x}

{!type:t} {!type:M.t}

{!exception:E} {!exception:M.E}

{!method:m} {!method:c.m}

{!constructor:C} {!constructor:M.C}

{!field:f} {!field:t.f} {!field:M.t.f} *)

0 comments on commit 6c2dd6d

Please sign in to comment.