jon.recoil.org
this repo has no description
1(*
2 * Copyright (c) 2014 Leo White <leo@lpw25.net>
3 *
4 * Permission to use, copy, modify, and distribute this software for any
5 * purpose with or without fee is hereby granted, provided that the above
6 * copyright notice and this permission notice appear in all copies.
7 *
8 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15 *)
16
17module Package = struct
18 type t = string
19
20 module Table = Hashtbl.Make (struct
21 type nonrec t = t
22
23 let equal : t -> t -> bool = ( = )
24
25 let hash : t -> int = Hashtbl.hash
26 end)
27end
28
29module Odoc_file = struct
30 type compilation_unit = { name : string; hidden : bool }
31
32 type page = {
33 name : string;
34 title : Comment.link_content option;
35 frontmatter : Frontmatter.t;
36 }
37
38 type t =
39 | Page of page
40 | Compilation_unit of compilation_unit
41 | Impl of string
42 | Asset of string
43
44 let create_unit ~force_hidden name =
45 let hidden = force_hidden || Names.contains_double_underscore name in
46 Compilation_unit { name; hidden }
47
48 let create_page name title frontmatter = Page { name; title; frontmatter }
49
50 let create_impl name = Impl name
51
52 let name = function
53 | Page { name; _ } | Compilation_unit { name; _ } | Impl name | Asset name
54 ->
55 name
56
57 let hidden = function
58 | Page _ | Impl _ | Asset _ -> false
59 | Compilation_unit m -> m.hidden
60
61 let asset name = Asset name
62end
63
64type t = {
65 id : Paths.Identifier.OdocId.t;
66 file : Odoc_file.t;
67 digest : Digest.t;
68}
69
70let equal : t -> t -> bool = ( = )
71
72let hash : t -> int = Hashtbl.hash
73
74let to_string t =
75 let rec pp fmt (id : Paths.Identifier.OdocId.t) =
76 match id.iv with
77 | `SourcePage (parent, name) ->
78 let rec loop_pp fmt parent =
79 match parent.Paths.Identifier.iv with
80 | `SourceDir (p, name) -> Format.fprintf fmt "%a::%s" loop_pp p name
81 | `Page _ as iv -> Format.fprintf fmt "%a" pp { parent with iv }
82 in
83 Format.fprintf fmt "%a::%s" loop_pp parent name
84 | `LeafPage (parent, name) | `Page (parent, name) -> (
85 match parent with
86 | Some p ->
87 Format.fprintf fmt "%a::%a" pp
88 (p :> Paths.Identifier.OdocId.t)
89 Names.PageName.fmt name
90 | None -> Format.fprintf fmt "%a" Names.PageName.fmt name)
91 | `Root (Some parent, name) ->
92 Format.fprintf fmt "%a::%a" pp
93 (parent :> Paths.Identifier.OdocId.t)
94 Names.ModuleName.fmt name
95 | `Root (None, name) -> Format.fprintf fmt "%a" Names.ModuleName.fmt name
96 | `Implementation name ->
97 Format.fprintf fmt "impl(%a)" Names.ModuleName.fmt name
98 | `AssetFile (parent, name) ->
99 Format.fprintf fmt "%a::%s" pp
100 (parent :> Paths.Identifier.OdocId.t)
101 (Names.AssetName.to_string name)
102 in
103
104 Format.asprintf "%a" pp t.id
105
106let compare x y = String.compare x.digest y.digest
107
108module Hash_table = Hashtbl.Make (struct
109 type nonrec t = t
110
111 let equal = equal
112
113 let hash = hash
114end)