diff --git a/src/document/url.ml b/src/document/url.ml index 6e03b3867d..3522df03bb 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -3,15 +3,6 @@ open Odoc_model.Paths open Odoc_model.Names module Root = Odoc_model.Root -let functor_arg_pos : Odoc_model.Paths.Identifier.FunctorParameter.t -> int = - let open Odoc_model.Paths.Identifier in - fun { iv = `Parameter (p, _); _ } -> - let rec inner_sig = function - | `Result { iv = p; _ } -> 1 + inner_sig p - | `Module _ | `ModuleType _ | `Root _ | `Parameter _ -> 1 - in - inner_sig p.iv - let render_path : Odoc_model.Paths.Path.t -> string = let open Odoc_model.Paths.Path in let rec render_resolved : Odoc_model.Paths.Path.Resolved.t -> string = @@ -160,7 +151,7 @@ module Path = struct mk ~parent kind name | { iv = `Parameter (functor_id, arg_name); _ } as p -> let parent = from_identifier (functor_id :> any) in - let arg_num = functor_arg_pos p in + let arg_num = Identifier.FunctorParameter.functor_arg_pos p in let kind = `Parameter arg_num in let name = ModuleName.to_string arg_name in mk ~parent kind name diff --git a/src/loader/dune b/src/loader/dune index ebb633480c..dff6b373f3 100644 --- a/src/loader/dune +++ b/src/loader/dune @@ -22,4 +22,4 @@ (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) - (libraries odoc_model odoc-parser syntax_highlighter)) + (libraries odoc_model odoc-parser syntax_highlighter odoc_document)) diff --git a/src/loader/implementation.ml b/src/loader/implementation.ml index 287ab9d45e..3b9e3f406f 100644 --- a/src/loader/implementation.ml +++ b/src/loader/implementation.ml @@ -381,37 +381,79 @@ let postprocess_poses source_id poses uid_to_id uid_to_loc = in defs @ poses -let string_of_full_name_ty : Odoc_model.Paths.Identifier.full_name_ty -> string - = function - | `Page -> "page" - | `Module -> "module" - | `Constructor -> "constructor" - | `Field -> "field" - | `Extension -> "extension" - | `Exception -> "exception" - | `Value -> "value" - | `Class -> "class" - | `ClassType -> "class_type" - | `Method -> "method" - | `InstanceVariable -> "instance_variable" - | `Label -> "label" - | `ModuleType -> "module_type" - | `Type -> "type" - | `Parameter -> "parameter" - | `Src -> "src" - | `Asset -> "asset" - let anchor_of_identifier id = - let full_name = Odoc_model.Paths.Identifier.full_name id in - List.filter_map - (fun (x, y) -> - match x with - | `Page -> None - | `Src -> None - | `Asset -> None - | _ -> Some (Printf.sprintf "%s-%s" (string_of_full_name_ty x) y)) - full_name - |> List.tl |> String.concat "." + let open Odoc_document.Url in + let open Odoc_model.Paths in + let open Odoc_model.Names in + let rec anchor_of_identifier acc (id : Identifier.t) = + let continue anchor parent = + anchor_of_identifier (anchor :: acc) (parent :> Identifier.t) + in + let anchor kind name = + Printf.sprintf "%s-%s" (Anchor.string_of_kind kind) name + in + match id.iv with + | `InstanceVariable (parent, name) -> + let anchor = anchor `Val (InstanceVariableName.to_string name) in + continue anchor parent + | `Parameter (parent, name) as iv -> + let arg_num = + Identifier.FunctorParameter.functor_arg_pos { id with iv } + in + let kind = `Parameter arg_num in + let anchor = anchor kind (ModuleName.to_string name) in + continue anchor parent + | `Module (parent, name) -> + let anchor = anchor `Module (ModuleName.to_string name) in + continue anchor parent + | `SourceDir _ -> assert false + | `ModuleType (parent, name) -> + let anchor = anchor `ModuleType (ModuleTypeName.to_string name) in + continue anchor parent + | `Method (parent, name) -> + let anchor = anchor `Method (MethodName.to_string name) in + continue anchor parent + | `AssetFile _ -> assert false + | `Field (parent, name) -> + let anchor = anchor `Field (FieldName.to_string name) in + continue anchor parent + | `SourceLocationMod _ -> assert false + | `Result parent -> anchor_of_identifier acc (parent :> Identifier.t) + | `SourceLocationInt _ -> assert false + | `Type (parent, name) -> + let anchor = anchor `Type (TypeName.to_string name) in + continue anchor parent + | `Label _ -> assert false + | `Exception (parent, name) -> + let anchor = anchor `Exception (ExceptionName.to_string name) in + continue anchor parent + | `Class (parent, name) -> + let anchor = anchor `Class (ClassName.to_string name) in + continue anchor parent + | `Page _ -> assert false + | `LeafPage _ -> assert false + | `CoreType _ -> assert false + | `SourceLocation _ -> assert false + | `ClassType (parent, name) -> + let anchor = anchor `ClassType (ClassTypeName.to_string name) in + continue anchor parent + | `SourcePage _ -> assert false + | `Value (parent, name) -> + let anchor = anchor `Val (ValueName.to_string name) in + continue anchor parent + | `CoreException _ -> assert false + | `Constructor (parent, name) -> + let anchor = anchor `Constructor (ConstructorName.to_string name) in + continue anchor parent + | `Root _ -> + (* We do not need to include the "container" root module in the anchor + to have unique anchors. *) + acc + | `Extension (parent, name) -> + let anchor = anchor `Extension (ExtensionName.to_string name) in + continue anchor parent + in + anchor_of_identifier [] id |> String.concat "." let of_cmt (source_id_opt : Odoc_model.Paths.Identifier.SourcePage.t option) (id : Odoc_model.Paths.Identifier.RootModule.t) (cmt : Cmt_format.cmt_infos) diff --git a/src/model/paths.ml b/src/model/paths.ml index 956469075c..ab2ac1748f 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -64,79 +64,6 @@ module Identifier = struct let name : [< t_pv ] id -> string = fun n -> name_aux (n :> t) - type full_name_ty = - [ `Page - | `Module - | `Parameter - | `ModuleType - | `Type - | `Constructor - | `Field - | `Extension - | `Exception - | `Value - | `Class - | `ClassType - | `Method - | `InstanceVariable - | `Label - | `Src - | `Asset ] - let rec full_name_aux : t -> (full_name_ty * string) list = - fun x -> - match x.iv with - | `Root (_, name) -> [ (`Module, ModuleName.to_string name) ] - | `Page (_, name) -> [ (`Page, PageName.to_string name) ] - | `LeafPage (_, name) -> [ (`Page, PageName.to_string name) ] - | `Module (parent, name) -> - (`Module, ModuleName.to_string name) :: full_name_aux (parent :> t) - | `Parameter (parent, name) -> - (`Parameter, ModuleName.to_string name) :: full_name_aux (parent :> t) - | `Result x -> full_name_aux (x :> t) - | `ModuleType (parent, name) -> - (`ModuleType, ModuleTypeName.to_string name) - :: full_name_aux (parent :> t) - | `Type (parent, name) -> - (`Type, TypeName.to_string name) :: full_name_aux (parent :> t) - | `CoreType name -> [ (`Type, TypeName.to_string name) ] - | `Constructor (parent, name) -> - (`Constructor, ConstructorName.to_string name) - :: full_name_aux (parent :> t) - | `Field (parent, name) -> - (`Field, FieldName.to_string name) :: full_name_aux (parent :> t) - | `Extension (parent, name) -> - (`Extension, ExtensionName.to_string name) - :: full_name_aux (parent :> t) - | `Exception (parent, name) -> - (`Exception, ExceptionName.to_string name) - :: full_name_aux (parent :> t) - | `CoreException name -> [ (`Exception, ExceptionName.to_string name) ] - | `Value (parent, name) -> - (`Value, ValueName.to_string name) :: full_name_aux (parent :> t) - | `Class (parent, name) -> - (`Class, ClassName.to_string name) :: full_name_aux (parent :> t) - | `ClassType (parent, name) -> - (`ClassType, ClassTypeName.to_string name) - :: full_name_aux (parent :> t) - | `Method (parent, name) -> - (`Method, MethodName.to_string name) :: full_name_aux (parent :> t) - | `InstanceVariable (parent, name) -> - (`InstanceVariable, InstanceVariableName.to_string name) - :: full_name_aux (parent :> t) - | `Label (parent, name) -> - (`Label, LabelName.to_string name) :: full_name_aux (parent :> t) - | `SourceDir (parent, name) -> (`Page, name) :: full_name_aux (parent :> t) - | `SourceLocation (parent, name) -> - (`Src, DefName.to_string name) :: full_name_aux (parent :> t) - | `SourceLocationInt (parent, name) -> - (`Src, LocalName.to_string name) :: full_name_aux (parent :> t) - | `SourceLocationMod name -> full_name_aux (name :> t) - | `SourcePage (parent, name) -> (`Page, name) :: full_name_aux (parent :> t) - | `AssetFile (parent, name) -> (`Asset, name) :: full_name_aux (parent :> t) - - let full_name : [< t_pv ] id -> (full_name_ty * string) list = - fun n -> List.rev @@ full_name_aux (n :> t) - let rec label_parent_aux = let open Id in fun (n : non_src) -> @@ -246,6 +173,13 @@ module Identifier = struct let equal = equal let hash = hash let compare = compare + + let functor_arg_pos { iv = `Parameter (p, _); _ } = + let rec inner_sig = function + | `Result { iv = p; _ } -> 1 + inner_sig p + | `Module _ | `ModuleType _ | `Root _ | `Parameter _ -> 1 + in + inner_sig p.iv end module FunctorResult = struct diff --git a/src/model/paths.mli b/src/model/paths.mli index 203b3e7d4e..20b5b6e2e6 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -50,10 +50,17 @@ module Identifier : sig module Module : IdSig with type t = Id.module_ and type t_pv = Id.module_pv - module FunctorParameter : - IdSig - with type t = Id.functor_parameter - and type t_pv = Id.functor_parameter_pv + module FunctorParameter : sig + include + IdSig + with type t = Id.functor_parameter + and type t_pv = Id.functor_parameter_pv + + val functor_arg_pos : t -> int + (** Gets the index in which the functor argument is, in the argument list. + Useful to turn identifiers into unique anchors, since multiple arguments + can have the same name. *) + end module ModuleType : IdSig with type t = Id.module_type and type t_pv = Id.module_type_pv @@ -179,27 +186,6 @@ module Identifier : sig val name : [< t_pv ] id -> string - type full_name_ty = - [ `Page - | `Module - | `Parameter - | `ModuleType - | `Type - | `Constructor - | `Field - | `Extension - | `Exception - | `Value - | `Class - | `ClassType - | `Method - | `InstanceVariable - | `Label - | `Src - | `Asset ] - - val full_name : [< t_pv ] id -> (full_name_ty * string) list - (* val root : [< t_pv ] id -> RootModule.t_pv id option *) val compare : t -> t -> int diff --git a/test/sources/double_wrapped.t/run.t b/test/sources/double_wrapped.t/run.t index 143c1a055e..62fb99472a 100644 --- a/test/sources/double_wrapped.t/run.t +++ b/test/sources/double_wrapped.t/run.t @@ -58,7 +58,7 @@ Look if all the source files are generated:
- Source + Source val x : int
diff --git a/test/sources/functor.t/run.t b/test/sources/functor.t/run.t index 43f0c03796..4bca693672 100644 --- a/test/sources/functor.t/run.t +++ b/test/sources/functor.t/run.t @@ -53,9 +53,9 @@ In this test, the functor expansion contains the right link. class="source_link">Source -- - Source - + + + Source $ cat html/root/source/a.ml.html | grep L3 3 @@ -75,11 +75,11 @@ However, on functor results, there is a link to source in the file: type t -- +
- Source + + Source - Source links in functor parameters might not make sense. Currently we generate none: diff --git a/test/sources/include_in_expansion.t/run.t b/test/sources/include_in_expansion.t/run.t index b6ce9d76d4..42917b218f 100644 --- a/test/sources/include_in_expansion.t/run.t +++ b/test/sources/include_in_expansion.t/run.t @@ -28,9 +28,9 @@ source parent of value y should be left to B. -- - - Source + Source + val y : int -- - Source + Source val x : int diff --git a/test/sources/lookup_def.t/run.t b/test/sources/lookup_def.t/run.t index 18b96340a9..d612133e2b 100644 --- a/test/sources/lookup_def.t/run.t +++ b/test/sources/lookup_def.t/run.t @@ -14,14 +14,14 @@ Show the locations: $ odoc_print a.odocl | jq -c '.. | select(.locs?) | [ .id, .locs ]' [{"`Module":[{"`Root":["None","A"]},"M"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-M"]}}] [{"`Module":[{"`Root":["None","A"]},"N"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N"]}}] - [{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module_type-S"]}}] - [{"`Value":[{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module_type-S"]}}] + [{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-type-S"]}}] + [{"`Value":[{"`ModuleType":[{"`Module":[{"`Root":["None","A"]},"N"]},"S"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-type-S"]}}] [{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-T"]}}] - [{"`Value":[{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-T.value-x"]}}] + [{"`Value":[{"`Module":[{"`Module":[{"`Root":["None","A"]},"N"]},"T"]},"x"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"module-N.module-T.val-x"]}}] [{"`Type":[{"`Root":["None","A"]},"t"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"type-t"]}}] - [{"`Value":[{"`Root":["None","A"]},"a"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"value-a"]}}] + [{"`Value":[{"`Root":["None","A"]},"a"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"val-a"]}}] [{"`Exception":[{"`Root":["None","A"]},"Exn"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"exception-Exn"]}}] [{"`Type":[{"`Root":["None","A"]},"ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"type-ext"]}}] [{"`Extension":[{"`Root":["None","A"]},"Ext"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"extension-Ext"]}}] [{"`Class":[{"`Root":["None","A"]},"cls"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"class-cls"]}}] - [{"`ClassType":[{"`Root":["None","A"]},"clst"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"class_type-clst"]}}] + [{"`ClassType":[{"`Root":["None","A"]},"clst"]},{"Some":{"`SourceLocation":[{"`SourcePage":[{"`Page":[{"Some":{"`Page":["None","root"]}},"source"]},"a.ml"]},"class-type-clst"]}}] diff --git a/test/sources/lookup_def_wrapped.t/run.t b/test/sources/lookup_def_wrapped.t/run.t index 98535b004a..aad3311e97 100644 --- a/test/sources/lookup_def_wrapped.t/run.t +++ b/test/sources/lookup_def_wrapped.t/run.t @@ -62,7 +62,7 @@ Look if all the source files are generated:
- Source + Source val x : int
diff --git a/test/sources/source.t/a.ml b/test/sources/source.t/a.ml index 46f4cf0118..0229992bce 100644 --- a/test/sources/source.t/a.ml +++ b/test/sources/source.t/a.ml @@ -2,6 +2,14 @@ type t = string type truc = A | B +let xazaz = A + +module Yoyo = struct + type bli = Aa | Bb +end + +let segr = Yoyo.Aa + let x = 2 let y = x + 1 let z a = if x = 1 || true then x + y else 0 @@ -42,3 +50,11 @@ end module FM = F (struct module A = struct end end) + +module FF (A : sig end) (B : sig end) = struct end +module FF2 (A : sig + module E : sig end +end) (A : sig + module F : sig end +end) = +struct end diff --git a/test/sources/source.t/run.t b/test/sources/source.t/run.t index 1e619361a9..3449567b8d 100644 --- a/test/sources/source.t/run.t +++ b/test/sources/source.t/run.t @@ -5,6 +5,14 @@ Files containing some values: type truc = A | B + let xazaz = A + + module Yoyo = struct + type bli = Aa | Bb + end + + let segr = Yoyo.Aa + let x = 2 let y = x + 1 let z a = if x = 1 || true then x + y else 0 @@ -45,6 +53,14 @@ Files containing some values: module FM = F (struct module A = struct end end) + + module FF (A : sig end) (B : sig end) = struct end + module FF2 (A : sig + module E : sig end + end) (A : sig + module F : sig end + end) = + struct end Source pages require a parent: @@ -92,14 +108,26 @@ Source links generated in the documentation:
Source + -- +
+ + Source + -- +
+ + + -- +
+ + Source --
- Source + Source --