diff --git a/dune b/dune index 3a7000ca50..e80a0fbd32 100644 --- a/dune +++ b/dune @@ -23,3 +23,5 @@ (progn (bash "diff doc/driver.mld doc/driver.mld.corrected >&2 || true") (cat doc/driver-benchmarks.json)))) + +(vendored_dirs vendor) diff --git a/dune-project b/dune-project index 12643f8d30..ea608d6a68 100644 --- a/dune-project +++ b/dune-project @@ -29,3 +29,7 @@ (cram enable) (using mdx 0.3) + +; Sherlodoc +(using menhir 2.1) +(using directory-targets 0.1) diff --git a/odoc-parser.opam b/odoc-parser.opam index b167c9a85d..6abb74886d 100644 --- a/odoc-parser.opam +++ b/odoc-parser.opam @@ -16,10 +16,22 @@ depends: [ "dune" {>= "3.7"} "ocaml" {>= "4.02.0" & < "5.4"} "astring" - "result" + "result" {>= "1.5"} "camlp-streams" "ppx_expect" {with-test} ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) + # Dependencies for sherlodoc: + "base64" {>= "3.5.1"} + "bigstringaf" {>= "0.9.1"} + "js_of_ocaml" {>= "5.6.0"} + "brr" {>= "0.0.6"} + "cmdliner" {>= "1.2.0"} + "decompress" {>= "1.5.3"} + "fpath" {>= "0.7.3"} + "lwt" {>= "5.7.0"} + "menhir" {>= "20230608"} + "ppx_blob" {>= "0.7.2"} + "tyxml" {>= "4.6.0"} ] build: [ ["dune" "subst"] {dev} diff --git a/src/driver/dune b/src/driver/dune index 774a169808..90a28022dd 100644 --- a/src/driver/dune +++ b/src/driver/dune @@ -3,7 +3,8 @@ (package odoc-driver) (link_deps (package odoc) - (package odoc-md)) + (package odoc-md) + %{bin:sherlodoc}) (preprocess (pps ppx_sexp_conv)) (libraries diff --git a/vendor/sherlodoc/.gitignore b/vendor/sherlodoc/.gitignore new file mode 100644 index 0000000000..e63a38c5e0 --- /dev/null +++ b/vendor/sherlodoc/.gitignore @@ -0,0 +1,21 @@ +*.annot +*.cmo +*.cma +*.cmi +*.a +*.o +*.cmx +*.cmxs +*.cmxa + +.merlin +*.install +*.coverage +*.sw[lmnop] + +_build/ +_doc/ +_coverage/ +_opam/ +**/perf.data +**/perf.data.old diff --git a/vendor/sherlodoc/.ocamlformat b/vendor/sherlodoc/.ocamlformat new file mode 100644 index 0000000000..1db190a13b --- /dev/null +++ b/vendor/sherlodoc/.ocamlformat @@ -0,0 +1,9 @@ +version = 0.26.1 +profile = janestreet +let-binding-spacing = compact +sequence-style = separator +doc-comments = after-when-possible +exp-grouping = preserve +break-cases = toplevel +cases-exp-indent = 4 +cases-matching-exp-indent = normal diff --git a/vendor/sherlodoc/.vscode/settings.json b/vendor/sherlodoc/.vscode/settings.json new file mode 100644 index 0000000000..f042043f47 --- /dev/null +++ b/vendor/sherlodoc/.vscode/settings.json @@ -0,0 +1,6 @@ +{ + "ocaml.sandbox": { + "kind": "opam", + "switch": "sherlodoc" + } +} \ No newline at end of file diff --git a/vendor/sherlodoc/LICENSE b/vendor/sherlodoc/LICENSE new file mode 100644 index 0000000000..674ecf6330 --- /dev/null +++ b/vendor/sherlodoc/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2022 Arthur Wendling, Tarides + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/vendor/sherlodoc/README.md b/vendor/sherlodoc/README.md new file mode 100644 index 0000000000..542e4e4ef2 --- /dev/null +++ b/vendor/sherlodoc/README.md @@ -0,0 +1,91 @@ +**Try it online at [doc.sherlocode.com](https://doc.sherlocode.com) !** + +Sherlodoc is a search engine for OCaml documentation (inspired by [Hoogle](https://hoogle.haskell.org/)), which allows you to search through OCaml libraries by names and approximate type signatures: + +- Search by name: [`list map`](https://doc.sherlocode.com/?q=list%20map) +- Search inside documentation comments: [`raise Not_found`](https://doc.sherlocode.com/?q=raise%20Not_found) +- Fuzzy type search is introduced with a colon, e.g. [`: map -> list`](https://doc.sherlocode.com/?q=%3A%20map%20-%3E%20list) +- Search by name and type with a colon separator [`Bogue : Button.t`](https://doc.sherlocode.com/?q=Bogue%20%3A%20Button.t) +- An underscore `_` can be used as a wildcard in type queries: [`(int -> _) -> list -> _`](https://doc.sherlocode.com/?q=(int%20-%3E%20_)%20-%3E%20list%20-%3E%20_) +- Type search supports products and reordering of function arguments: [`array -> ('a * int -> bool) -> array`](https://doc.sherlocode.com/?q=%3A%20array%20-%3E%20(%27a%20*%20int%20-%3E%20bool)%20-%3E%20array) + +## Local usage + +First, install sherlodoc and odig: + +```bash +$ opam pin add 'https://github.com/art-w/sherlodoc.git' # optional + +$ opam install sherlodoc odig +``` + +[Odig](https://erratique.ch/software/odig) can generate the odoc documentation of your current switch with: + +```bash +$ odig odoc # followed by `odig doc` to browse your switch documentation +``` + +Which sherlodoc can then index to create a search database: + +```bash +# name your sherlodoc database +$ export SHERLODOC_DB=/tmp/sherlodoc.marshal + +# if you are using OCaml 4, we recommend the `ancient` database format: +$ opam install ancient +$ export SHERLODOC_DB=/tmp/sherlodoc.ancient + +# index all odoc files generated by odig for your current switch: +$ sherlodoc index $(find $OPAM_SWITCH_PREFIX/var/cache/odig/odoc -name '*.odocl' | grep -v __) +``` + +Enjoy searching from the command-line or run the webserver: + +```bash +$ sherlodoc search "map : list" +$ sherlodoc search # interactice cli + +$ opam install dream +$ sherlodoc serve # webserver at http://localhost:1234 +``` + +The different commands support a `--help` argument for more details/options. + +In particular, sherlodoc supports three different file formats for its database, which can be specified either in the filename extension or through the `--db-format=` flag: +- `ancient` for fast database loading using mmap, but is only compatible with OCaml 4. +- `marshal` for when ancient is unavailable, with slower database opening. +- `js` for integration with odoc static html documentation for client-side search without a server. + +## Integration with Odoc + +Odoc 2.4.0 adds a search bar inside the statically generated html documentation. [Integration with dune is in progress](https://github.com/ocaml/dune/pull/9772), you can try it inside a fresh opam switch with: (warning! this will recompile any installed package that depends on dune!) + +```bash +$ opam pin https://github.com/emileTrotignon/dune.git#search-odoc-new + +$ dune build @doc # in your favorite project +``` + +Otherwise, manual integration with odoc requires to add to every call of `odoc html-generate` the flags `--search-uri sherlodoc.js --search-uri db.js` to activate the search bar. You'll also need to generate a search database `db.js` and provide the `sherlodoc.js` dependency (a version of the sherlodoc search engine with odoc support, compiled to javascript): + +```bash +$ sherlodoc index --db=_build/default/_doc/_html/YOUR_LIB/db.js \ + $(find _build/default/_doc/_odocls/YOUR_LIB -name '*.odocl' | grep -v __) + +$ sherlodoc js > _build/default/_doc/_html/sherlodoc.js +``` + +## How it works + +The sherlodoc database uses [Suffix Trees](https://en.wikipedia.org/wiki/Suffix_tree) to search for substrings in value names, documentation and types. During indexation, the suffix trees are compressed to state machine automatas. The children of every node are also sorted, such that a sub-tree can be used as a priority queue during search enumeration. + +To rank the search results, sherlodoc computes a static evaluation of each candidate during indexation. This static scoring biases the search to favor short names, short types, the presence of documentation, etc. When searching, a dynamic evaluation dependent on the user query is used to adjust the static ordering of the results: + +- How similar is the result name to the search query? (to e.g. prefer results which respect the case: [`map`](https://doc.sherlocode.com/?q=map) vs [`Map`](https://doc.sherlocode.com/?q=Map)) +- How similar are the types? (using a tree diff algorithm, as for example [`('a -> 'b -> 'a) -> 'a -> 'b list -> 'a`](https://doc.sherlocode.com/?q=(%27a%20-%3E%20%27b%20-%3E%20%27a)%20-%3E%20%27a%20-%3E%20%27b%20list%20-%3E%20%27a) and [`('a -> 'b -> 'b) -> 'a list -> 'b -> 'b`](https://doc.sherlocode.com/?q=(%27a%20-%3E%20%27b%20-%3E%20%27b)%20-%3E%20%27a%20list%20-%3E%20%27b%20-%3E%20%27b) are isomorphic yet point to `fold_left` and `fold_right` respectively) + +For fuzzy type search, sherlodoc aims to provide good results without requiring a precise search query, on the basis that the user doesn't know the exact type of the things they are looking for (e.g. [`string -> file_descr`](https://doc.sherlocode.com/?q=string%20-%3E%20file_descr) is incomplete but should still point in the right direction). In particular when exploring a package documentation, the common question "how do I produce a value of type `foo`" can be answered with the query `: foo` (and "which functions consume a value of type `bar`" with `: bar -> _`). This should also work when the type can only be produced indirectly through a callback (for example [`: Eio.Switch.t`](https://doc.sherlocode.com/?q=%3A%20Eio.Switch.t) has no direct constructor). To achieve this, sherlodoc performs a type decomposition based on the polarity of each term: A value produced by a function is said to be positive, while an argument consumed by a function is negative. This simplifies away the tree shape of types, allowing their indexation in the suffix trees. The cardinality of each value type is also indexed, to e.g. differentiate between [`list -> list`](https://doc.sherlocode.com/?q=list%20-%3E%20list) and [`list -> list -> list`](https://doc.sherlocode.com/?q=list%20-%3E%20list%20-%3E%20list). + +While the polarity search results are satisfying, sherlodoc offers very limited support for polymorphic variables, type aliases and true type isomorphisms. You should check out the extraordinary [Dowsing](https://github.com/Drup/dowsing) project for this! + +And if you speak French, a more detailed [presentation of Sherlodoc](https://www.irill.org/videos/OUPS/2023-03/wendling.html) (and [Sherlocode](https://sherlocode.com)) was given at the [OCaml Users in PariS (OUPS)](https://oups.frama.io/) in March 2023. diff --git a/vendor/sherlodoc/cli/dune b/vendor/sherlodoc/cli/dune new file mode 100644 index 0000000000..2ed6a7b570 --- /dev/null +++ b/vendor/sherlodoc/cli/dune @@ -0,0 +1,20 @@ +(ocamllex unescape) + +(executable + (name main) + (public_name sherlodoc) + (package odoc-driver) + (libraries + cmdliner + index + query + db_store + unix + (select + serve.ml + from + (www -> serve.available.ml) + (!www -> serve.unavailable.ml))) + (preprocess + (pps ppx_blob)) + (preprocessor_deps ../jsoo/sherlodoc.js)) diff --git a/vendor/sherlodoc/cli/main.ml b/vendor/sherlodoc/cli/main.ml new file mode 100644 index 0000000000..445af97f3c --- /dev/null +++ b/vendor/sherlodoc/cli/main.ml @@ -0,0 +1,83 @@ +let guess_db_format db_format db_filename = + match db_format with + | Some db_format -> db_format + | None -> begin + let ext = Filename.extension db_filename in + let ext_len = String.length ext in + let ext = if ext_len = 0 then ext else String.sub ext 1 (ext_len - 1) in + try List.assoc ext Db_store.available_backends with + | Not_found -> + Format.fprintf + Format.err_formatter + "Unknown db format extension %S (expected: %s)@." + ext + (String.concat ", " @@ List.map fst Db_store.available_backends) ; + exit 1 + end + +open Cmdliner + +let db_format = + let env = + let doc = "Database format" in + Cmd.Env.info "SHERLODOC_FORMAT" ~doc + in + let kind = Arg.enum Db_store.available_backends in + Arg.(value & opt (some kind) None & info [ "format" ] ~docv:"DB_FORMAT" ~env) + +let db_filename = + let env = + let doc = "The database to query" in + Cmd.Env.info "SHERLODOC_DB" ~doc + in + Arg.(required & opt (some string) None & info [ "db"; "o" ] ~docv:"DB" ~env) + +let db_path = + let env = + let doc = "The database to query" in + Cmd.Env.info "SHERLODOC_DB" ~doc + in + Arg.(required & opt (some file) None & info [ "db" ] ~docv:"DB" ~env) + +let with_db fn db_path = + let apply fn db_format db_filename = + let db_format = guess_db_format db_format db_filename in + fn db_format db_filename + in + Term.(const apply $ fn $ db_format $ db_path) + +let cmd_search = + let info = Cmd.info "search" ~doc:"Command-line search" in + Cmd.v info (with_db Search.term db_path) + +let cmd_index = + let doc = "Index odocl files to create a Sherlodoc database" in + let info = Cmd.info "index" ~doc in + Cmd.v info (with_db Index.term db_filename) + +let cmd_serve = + let doc = "Webserver interface" in + let info = Cmd.info "serve" ~doc in + Cmd.v info (with_db Serve.term db_path) + +let cmd_jsoo = + let doc = "For dune/odoc integration, sherlodoc compiled as javascript" in + let info = Cmd.info "js" ~doc in + let target = + let doc = "Name of the file to create" in + Arg.(value & pos 0 string "" & info [] ~docv:"QUERY" ~doc) + in + let emit_js_dep filename = + let close, h = if filename = "" then false, stdout else true, open_out filename in + output_string h [%blob "../jsoo/sherlodoc.js"] ; + if close then close_out h + in + Cmd.v info Term.(const emit_js_dep $ target) + +let cmd = + let doc = "Sherlodoc" in + let version = "0.2" in + let info = Cmd.info "sherlodoc" ~version ~doc in + Cmd.group info [ cmd_search; cmd_index; cmd_serve; cmd_jsoo ] + +let () = exit (Cmd.eval cmd) diff --git a/vendor/sherlodoc/cli/search.ml b/vendor/sherlodoc/cli/search.ml new file mode 100644 index 0000000000..f306d0691a --- /dev/null +++ b/vendor/sherlodoc/cli/search.ml @@ -0,0 +1,185 @@ +let header = + {|Sherlodoc v0.2 -- search OCaml documentation by name and type (use CTRL-D to exit)|} + +let string_of_kind = + let open Db.Entry.Kind in + function + | Doc -> "doc" + | Type_decl _ -> "type" + | Module -> "mod" + | Exception _ -> "exn" + | Class_type -> "class" + | Method -> "meth" + | Class -> "class" + | Type_extension -> "type" + | Extension_constructor _ -> "cons" + | Module_type -> "sig" + | Constructor _ -> "cons" + | Field _ -> "field" + | Val _ -> "val" + | Page -> "page" + | Impl -> "source" + +let print_result ~print_cost ~print_docstring ~no_rhs (elt : Db.Entry.t) = + let cost = if print_cost then string_of_int elt.cost ^ " " else "" in + let typedecl_params = + (match elt.kind with + | Type_decl args -> args + | _ -> None) + |> Option.map (fun str -> str ^ " ") + |> Option.value ~default:"" + in + let kind = elt.kind |> string_of_kind |> Unescape.string in + let name = Unescape.string elt.name in + let pp_rhs h = function + | None -> () + | Some _ when no_rhs -> () + | Some rhs -> Format.fprintf h "%s" (Unescape.string rhs) + in + let docstring = if print_docstring then "\n" ^ elt.doc_html else "" in + Format.printf "%s%s %s%s%a%s@." cost kind typedecl_params name pp_rhs elt.rhs docstring + +let search + ~print_cost + ~static_sort + ~limit + ~db + ~no_rhs + ~pretty_query + ~time + ~print_docstring + query + = + let query = Query.{ query; packages = []; limit } in + if pretty_query then print_endline (Query.pretty query) ; + let t0 = Unix.gettimeofday () in + let r = Query.Blocking.search ~shards:db ~dynamic_sort:(not static_sort) query in + let t1 = Unix.gettimeofday () in + match r with + | [] -> print_endline "[No results]" + | _ :: _ as results -> + List.iter (print_result ~print_cost ~print_docstring ~no_rhs) results ; + flush stdout ; + if time then Format.printf "Search in %f@." (t1 -. t0) + +let rec search_loop + ~print_cost + ~no_rhs + ~pretty_query + ~static_sort + ~limit + ~time + ~print_docstring + ~db + = + Printf.printf "%ssearch>%s %!" "\027[0;36m" "\027[0;0m" ; + match Stdlib.input_line stdin with + | query -> + search + ~print_cost + ~static_sort + ~limit + ~db + ~no_rhs + ~pretty_query + ~time + ~print_docstring + query ; + search_loop + ~print_cost + ~no_rhs + ~pretty_query + ~static_sort + ~limit + ~time + ~print_docstring + ~db + | exception End_of_file -> Printf.printf "\n%!" + +let search + query + print_cost + no_rhs + static_sort + limit + pretty_query + time + print_docstring + db_format + db_filename + = + let module Storage = (val Db_store.storage_module db_format) in + let db = Storage.load db_filename in + match query with + | None -> + print_endline header ; + search_loop + ~print_cost + ~no_rhs + ~pretty_query + ~static_sort + ~limit + ~time + ~print_docstring + ~db + | Some query -> + search + ~print_cost + ~no_rhs + ~pretty_query + ~static_sort + ~limit + ~time + ~print_docstring + ~db + query + +open Cmdliner + +let limit = + let doc = "The maximum number of results per query" in + Arg.(value & opt int 25 & info [ "limit"; "n" ] ~docv:"N" ~doc) + +let query = + let doc = "The query. If absent, queries will be read interactively." in + Arg.(value & pos 0 (some string) None & info [] ~docv:"QUERY" ~doc) + +let print_cost = + let doc = "For debugging purposes: prints the cost of each result" in + Arg.(value & flag & info [ "print-cost" ] ~doc) + +let print_time = + let doc = "For debugging purposes: prints the search time" in + Arg.(value & flag & info [ "print-time" ] ~doc) + +let static_sort = + let doc = + "Sort the results without looking at the query.\n\ + Enabling it allows to look at the static costs of elements.\n\ + Mainly for testing purposes." + in + Arg.(value & flag & info [ "static-sort" ] ~doc) + +let no_rhs = + let doc = "Do not print the right-hand side of results." in + Arg.(value & flag & info [ "no-rhs"; "no-right-hand-side" ] ~doc) + +let pretty_query = + let doc = "Prints the query itself as it was parsed" in + Arg.(value & flag & info [ "pretty-query" ] ~doc) + +let print_docstring = + let doc = "Print the HTML of the docstring of the results" in + Arg.(value & flag & info [ "print-docstring-html" ] ~doc) + +let term = + Term.( + const search + $ query + $ print_cost + $ no_rhs + $ static_sort + $ limit + $ pretty_query + $ print_time + $ print_docstring) diff --git a/vendor/sherlodoc/cli/search.mli b/vendor/sherlodoc/cli/search.mli new file mode 100644 index 0000000000..fae8900e05 --- /dev/null +++ b/vendor/sherlodoc/cli/search.mli @@ -0,0 +1 @@ +val term : (Db_store.db_format -> string -> unit) Cmdliner.Term.t diff --git a/vendor/sherlodoc/cli/serve.available.ml b/vendor/sherlodoc/cli/serve.available.ml new file mode 100644 index 0000000000..87d0864b6b --- /dev/null +++ b/vendor/sherlodoc/cli/serve.available.ml @@ -0,0 +1 @@ +let term = Www.term diff --git a/vendor/sherlodoc/cli/serve.mli b/vendor/sherlodoc/cli/serve.mli new file mode 100644 index 0000000000..fae8900e05 --- /dev/null +++ b/vendor/sherlodoc/cli/serve.mli @@ -0,0 +1 @@ +val term : (Db_store.db_format -> string -> unit) Cmdliner.Term.t diff --git a/vendor/sherlodoc/cli/serve.unavailable.ml b/vendor/sherlodoc/cli/serve.unavailable.ml new file mode 100644 index 0000000000..fa2c0ffbab --- /dev/null +++ b/vendor/sherlodoc/cli/serve.unavailable.ml @@ -0,0 +1,6 @@ +let main _ _ = + Format.fprintf + Format.err_formatter + "Webserver unavailable: please install dream and retry.@." + +let term = Cmdliner.Term.const main diff --git a/vendor/sherlodoc/cli/unescape.mll b/vendor/sherlodoc/cli/unescape.mll new file mode 100644 index 0000000000..7f90d97119 --- /dev/null +++ b/vendor/sherlodoc/cli/unescape.mll @@ -0,0 +1,24 @@ +(* The goal of this lexer is to remove html encoding from strings, so that + they display nicely on the command-line. The only encodings included are the + one actually used. Because this executable is mainly used for testing, this + is fine. *) +rule buffer b = parse +| "&" { Buffer.add_char b '&'; buffer b lexbuf } +| "<" { Buffer.add_char b '<'; buffer b lexbuf } +| ">" { Buffer.add_char b '>'; buffer b lexbuf } +| ">" { Buffer.add_char b '>'; buffer b lexbuf } +| ">" { Buffer.add_char b '>'; buffer b lexbuf } +| """ { Buffer.add_char b '>'; buffer b lexbuf } +| "'" { Buffer.add_char b '\''; buffer b lexbuf } +| "-" { Buffer.add_char b '-'; buffer b lexbuf } + +| eof { () } +| _ { Buffer.add_string b (Lexing.lexeme lexbuf) ; buffer b lexbuf } + +{ +let string str = + let lexbuf = Lexing.from_string str in + let b = Buffer.create (String.length str) in + buffer b lexbuf ; + Buffer.contents b +} diff --git a/vendor/sherlodoc/db/db.ml b/vendor/sherlodoc/db/db.ml new file mode 100644 index 0000000000..94679d5471 --- /dev/null +++ b/vendor/sherlodoc/db/db.ml @@ -0,0 +1,12 @@ +module Entry = Entry +module Storage = Storage +module Type_polarity = Type_polarity +module Typexpr = Typexpr +module Occurences = Storage.Occurences +module String_automata = String_automata + +type t = Storage.db = + { db_names : String_automata.t + ; db_pos_types : String_automata.t Occurences.t + ; db_neg_types : String_automata.t Occurences.t + } diff --git a/vendor/sherlodoc/db/db.mli b/vendor/sherlodoc/db/db.mli new file mode 100644 index 0000000000..50035ab2ac --- /dev/null +++ b/vendor/sherlodoc/db/db.mli @@ -0,0 +1,23 @@ +module Entry = Entry +module Storage = Storage +module Type_polarity = Type_polarity +module Typexpr = Typexpr +module Occurences = Storage.Occurences +module String_automata = String_automata + +type t = Storage.db = + { db_names : String_automata.t + ; db_pos_types : String_automata.t Occurences.t + ; db_neg_types : String_automata.t Occurences.t + } +(** The type of a search database. + + [db_names] is for text-based part of the query and [db_types] for the + type-based part. + + [db_types] has [Entry.t array Int_map.t] ([Occ.t]) as a payload because we want + the query [blabla : int -> int -> _] to return only entries that take at + least two ints as arguments, an entry of type [int -> string] is invalid. + The [Int_map.t] maps a number of occurences to a set of entries. See {!Occ}. + [db_types] still is a suffix tree, so you can search in it only for text. The + way we transform types into searchable text is in {!Type_polarity}. *) diff --git a/vendor/sherlodoc/db/dune b/vendor/sherlodoc/db/dune new file mode 100644 index 0000000000..e3cb6f4260 --- /dev/null +++ b/vendor/sherlodoc/db/dune @@ -0,0 +1,3 @@ +(library + (name db) + (libraries fmt)) diff --git a/vendor/sherlodoc/db/entry.ml b/vendor/sherlodoc/db/entry.ml new file mode 100644 index 0000000000..1e9e7e0d83 --- /dev/null +++ b/vendor/sherlodoc/db/entry.ml @@ -0,0 +1,161 @@ +let empty_string = String.make 0 '_' + +let non_empty_string s = + (* to protect against `ancient` segfaulting on statically allocated values *) + if s = "" then empty_string else s + +module Kind = struct + type t = + | Doc (** Standalone doc comment *) + | Page (** Mld page *) + | Impl (** Source page *) + | Module + | Module_type + | Class + | Class_type + | Method + | Val of Typexpr.t + | Type_decl of string option + | Type_extension + | Extension_constructor of Typexpr.t + | Exception of Typexpr.t + | Constructor of Typexpr.t + | Field of Typexpr.t + + let equal = ( = ) + + let get_type t = + match t with + | Val typ | Extension_constructor typ | Exception typ | Constructor typ | Field typ -> + Some typ + | Doc | Page | Impl | Module | Module_type | Class | Class_type | Method | Type_decl _ + | Type_extension -> + None +end + +module Package = struct + type t = + { name : string + ; version : string + } + + let v ~name ~version = + { name = non_empty_string name; version = non_empty_string version } + + let compare a b = String.compare a.name b.name + let link { name; version } = "https://ocaml.org/p/" ^ name ^ "/" ^ version +end + +type t = + { name : string + ; rhs : string option + ; url : string + ; kind : Kind.t + ; cost : int + ; doc_html : string + ; pkg : Package.t + } + +let pp fmt { name; rhs; url; kind; cost; doc_html; pkg } = + Format.fprintf + fmt + "{ name = %s ; rhs = %a ; url = %s ; kind = . ; cost = %d ; doc_html = %s ; pkg = . }\n" + name + (Fmt.option Fmt.string) + rhs + url + cost + doc_html + +let string_compare_shorter a b = + match Int.compare (String.length a) (String.length b) with + | 0 -> String.compare a b + | c -> c + +let structural_compare a b = + match string_compare_shorter a.name b.name with + | 0 -> begin + match Package.compare a.pkg b.pkg with + | 0 -> begin + match Stdlib.compare a.kind b.kind with + | 0 -> begin + match string_compare_shorter a.doc_html b.doc_html with + | 0 -> String.compare a.url b.url + | c -> c + end + | c -> c + end + | c -> c + end + | c -> c + +let compare a b = + if a == b + then 0 + else begin + match Int.compare a.cost b.cost with + | 0 -> structural_compare a b + | cmp -> cmp + end + +let equal a b = compare a b = 0 + +let stdlib_link ~name t = + let path, hashref = + match List.rev name, String.index_opt t.url '#' with + | _ :: path, Some idx -> + let idx = idx + 1 in + let tgt = + match String.index_from_opt t.url idx '-' with + | None -> String.sub t.url idx (String.length t.url - idx) + | Some jdx -> + let kind = String.sub t.url idx (jdx - idx) in + let jdx = jdx + 1 in + let target = String.sub t.url jdx (String.length t.url - jdx) in + String.uppercase_ascii kind ^ target + in + path, "#" ^ tgt + | path, _ -> path, "" + in + let path = String.concat "." (List.rev path) in + "https://v2.ocaml.org/releases/5.1/api/" ^ path ^ ".html" ^ hashref + +let link t = + let fullname = String.split_on_char '.' t.name in + match fullname with + | "Stdlib" :: name -> stdlib_link ~name t + | _ -> + let pkg_link = Package.link t.pkg in + let rec align n ys = + match ys with + | _ when n = 0 -> [] + | [] -> [] + | y :: ys -> y :: align (n - 1) ys + in + let length = List.length fullname in + let length = + match String.index_opt t.url '#' with + | None -> length + 1 + | Some idx -> + let tgt = String.sub t.url idx (String.length t.url - idx) in + let count = ref 0 in + String.iter + (function + | '.' -> incr count + | _ -> ()) + tgt ; + length - !count + in + let path = align length (List.rev (String.split_on_char '/' t.url)) in + let path = String.concat "/" (List.rev path) in + pkg_link ^ "/doc/" ^ path + +let v ~name ~kind ~cost ~rhs ~doc_html ~url ~pkg () = + { name = non_empty_string name + ; kind + ; url = non_empty_string url + ; cost + ; doc_html = non_empty_string doc_html + ; pkg + ; rhs = Option.map non_empty_string rhs + } diff --git a/vendor/sherlodoc/db/entry.mli b/vendor/sherlodoc/db/entry.mli new file mode 100644 index 0000000000..a88319b0f8 --- /dev/null +++ b/vendor/sherlodoc/db/entry.mli @@ -0,0 +1,58 @@ +module Kind : sig + type t = + | Doc (** Standalone doc comment *) + | Page (** Mld page *) + | Impl (** Source page *) + | Module + | Module_type + | Class + | Class_type + | Method + | Val of Typexpr.t + | Type_decl of string option + | Type_extension + | Extension_constructor of Typexpr.t + | Exception of Typexpr.t + | Constructor of Typexpr.t + | Field of Typexpr.t + + val equal : t -> t -> bool + val get_type : t -> Typexpr.t option +end + +module Package : sig + type t = private + { name : string + ; version : string + } + + val v : name:string -> version:string -> t + val link : t -> string +end + +type t = + { name : string + ; rhs : string option + ; url : string + ; kind : Kind.t + ; cost : int + ; doc_html : string + ; pkg : Package.t + } + +val pp : t Fmt.t + +val v + : name:string + -> kind:Kind.t + -> cost:int + -> rhs:string option + -> doc_html:string + -> url:string + -> pkg:Package.t + -> unit + -> t + +val link : t -> string +val compare : t -> t -> int +val equal : t -> t -> bool diff --git a/vendor/sherlodoc/db/storage.ml b/vendor/sherlodoc/db/storage.ml new file mode 100644 index 0000000000..24a91f6b8f --- /dev/null +++ b/vendor/sherlodoc/db/storage.ml @@ -0,0 +1,16 @@ +module Occurences = Map.Make (Int) + +type db = + { db_names : String_automata.t + ; db_pos_types : String_automata.t Occurences.t + ; db_neg_types : String_automata.t Occurences.t + } + +module type S = sig + type writer + + val open_out : string -> writer + val save : db:writer -> db -> unit + val close_out : writer -> unit + val load : string -> db list +end diff --git a/vendor/sherlodoc/db/string_automata.ml b/vendor/sherlodoc/db/string_automata.ml new file mode 100644 index 0000000000..9714acf78a --- /dev/null +++ b/vendor/sherlodoc/db/string_automata.ml @@ -0,0 +1,140 @@ +type terminals = + | Empty + | Terminals of Entry.t array + | Summary of Entry.t array + +type node = + { start : int + ; len : int + ; size : int + ; terminals : terminals + ; children : node array option + } + +type t = + { str : string + ; t : node + } + +let empty = { start = 0; len = 0; size = 0; children = None; terminals = Empty } + +let empty () = + (* avoid ancient segfaulting on statically allocated values *) + Obj.obj @@ Obj.dup @@ Obj.repr empty + +let size t = t.t.size + +let minimum { t; _ } = + match t.terminals with + | Empty -> assert false + | Terminals arr | Summary arr -> arr.(0) + +let array_find ~str chr arr = + let rec go i = + if i >= Array.length arr + then None + else begin + let node = arr.(i) in + if chr = str.[node.start - 1] then Some node else go (i + 1) + end + in + go 0 + +let array_find ~str chr = function + | None -> None + | Some arr -> array_find ~str chr arr + +let lcp i_str i j_str j j_len = + let j_stop = j + j_len in + let rec go_lcp i j = + if i >= String.length i_str || j >= j_stop + then i + else begin + let i_chr, j_chr = i_str.[i], j_str.[j] in + if i_chr <> j_chr then i else go_lcp (i + 1) (j + 1) + end + in + let i' = go_lcp i j in + i' - i + +let rec find ~str node pattern i = + if i >= String.length pattern + then Some node + else begin + match array_find ~str pattern.[i] node.children with + | None -> None + | Some child -> find_lcp ~str child pattern (i + 1) + end + +and find_lcp ~str child pattern i = + let n = lcp pattern i str child.start child.len in + if i + n = String.length pattern + then Some { child with start = child.start + n; len = child.len - n } + else if n = child.len + then find ~str child pattern (i + n) + else None + +let find t pattern = + match find_lcp ~str:t.str t.t pattern 0 with + | None -> None + | Some child -> Some { str = t.str; t = child } + +let advance node = + assert (node.len >= 1) ; + { node with start = node.start + 1; len = node.len - 1 } + +let stepback node = + assert (node.len >= 0) ; + { node with start = node.start - 1; len = node.len + 1 } + +let rec find_skip ~spaces t pattern yield = + let skip () = + let node = t.t in + if node.len >= 1 + then begin + let spaces = spaces + if t.str.[node.start] = ' ' then 1 else 0 in + if spaces > 1 + then () + else find_skip ~spaces { t with t = advance t.t } pattern yield + end + else begin + match node.children with + | None -> () + | Some children -> + Array.iter + (fun child -> find_skip ~spaces { t with t = stepback child } pattern yield) + children + end + in + if spaces = 0 + then skip () + else if spaces = 1 && pattern = Type_polarity.poly + then begin + match find t pattern with + | None -> () + | Some here -> yield here + end + else begin + skip () ; + match find t pattern with + | None -> () + | Some here -> yield here + end + +let find_star t pattern yield = + let rec go t = function + | [] -> yield t + | p :: ps -> find_skip ~spaces:0 t p @@ fun t -> go t ps + in + match String.split_on_char ' ' pattern with + | [] -> () + | p :: ps -> begin + match find t p with + | None -> () + | Some t -> go t ps + end + +let find_star t pattern = + let found = ref [] in + find_star t pattern (fun t -> found := t :: !found) ; + !found diff --git a/vendor/sherlodoc/db/string_automata.mli b/vendor/sherlodoc/db/string_automata.mli new file mode 100644 index 0000000000..9d02e06ebc --- /dev/null +++ b/vendor/sherlodoc/db/string_automata.mli @@ -0,0 +1,26 @@ +(* A string automata, constructed from a suffix tree and optimized + for fast queries and small serialization. *) + +type terminals = + | Empty + | Terminals of Entry.t array + | Summary of Entry.t array + +type node = + { start : int + ; len : int + ; size : int + ; terminals : terminals + ; children : node array option + } + +type t = + { str : string + ; t : node + } + +val empty : unit -> node +val find : t -> string -> t option +val find_star : t -> string -> t list +val minimum : t -> Entry.t +val size : t -> int diff --git a/vendor/sherlodoc/db/type_polarity.ml b/vendor/sherlodoc/db/type_polarity.ml new file mode 100644 index 0000000000..47bcec1cbd --- /dev/null +++ b/vendor/sherlodoc/db/type_polarity.ml @@ -0,0 +1,62 @@ +open Typexpr + +module Sign = struct + type t = + | Pos + | Neg + + let to_string = function + | Pos -> "+" + | Neg -> "-" + + let not = function + | Pos -> Neg + | Neg -> Pos +end + +let rev_concat lst = List.fold_left (fun acc xs -> List.rev_append xs acc) [] lst + +type t = string * int * Sign.t + +let poly = "@" + +let rec of_typ ~any_is_poly ~prefix ~sgn = function + | Poly _ -> [ sgn, poly :: prefix ] + | Any -> if any_is_poly then [ sgn, poly :: prefix ] else [ sgn, prefix ] + | Arrow (a, b) -> + List.rev_append + (of_typ ~any_is_poly ~prefix ~sgn:(Sign.not sgn) a) + (of_typ ~any_is_poly ~prefix ~sgn b) + | Constr (name, args) -> begin + let prefix = String.lowercase_ascii name :: prefix in + match args with + | [] -> [ sgn, prefix ] + | _ -> + rev_concat + @@ List.mapi + (fun i arg -> + let prefix = string_of_int i :: prefix in + of_typ ~any_is_poly ~prefix ~sgn arg) + args + end + | Tuple args -> rev_concat @@ List.map (of_typ ~any_is_poly ~prefix ~sgn) @@ args + | Unhandled -> [] + +let regroup lst = + let h = Hashtbl.create 16 in + List.iter + (fun v -> + let count = + try Hashtbl.find h v with + | Not_found -> 0 + in + Hashtbl.replace h v (count + 1)) + lst ; + Hashtbl.to_seq h + +let of_typ ~any_is_poly t = + t + |> of_typ ~any_is_poly ~prefix:[] ~sgn:Pos + |> List.map (fun (polarity, path) -> polarity, String.concat " " (List.rev path)) + |> regroup + |> Seq.map (fun ((polarity, path), count) -> path, count, polarity) diff --git a/vendor/sherlodoc/db/type_polarity.mli b/vendor/sherlodoc/db/type_polarity.mli new file mode 100644 index 0000000000..e3cb13229a --- /dev/null +++ b/vendor/sherlodoc/db/type_polarity.mli @@ -0,0 +1,82 @@ +(** This module provide a way to transform a type into strings, in such a way + that the strings can be used for type search. + + The chosen representation is polarity : we do not represent the [->] or the [*] + constructors, but instead compute the "polarity" of every type name/constructor + like [int] or ['a] that is part of the whole type expression. + + The polarity of a component of a type indicates if it is produced or consumed by + the type. In the type [int -> string], [int] has negative polarity because it is + being consumed, and [string] has positive polarity because it is being produced. + We say that the polarities of [int -> string] are [-int] and [+string]. + + Once you have computed the polarities of the type of an entry [e], you can + register each polarity as corresponding to [e] in the search database. + + Then, when the user queries for a type, we compute the polarities of the query + type, and search for the entries. + + We then return the result corresponding to intersection of each polarity: if the + user queries for [int -> string], we want to have every entry which consumes an + [int] and produces a [string], that is the intersection of the entries + associated to [-int] with the entries associated to [+string]. + + How is polarity computed exactly ? When you have [t -> u], the polarity of [t] + is inversed, and the polarity of [u] stays the same. A good example of this is + the type of {!Stdlib.Out_channel.with_open_gen} : + + {[ + val with_open_gen : open_flag list -> int -> string -> (t -> 'a) -> 'a + ]} + + Here the polarities are [-open_flag list], [-int], [-string], [+Out_channel.t], + [-'a] and [+'a]. The fact that we have [+Out_channel.t] might be puzzling at + first, because an [Out_channel.t] is not returned by the function, but + {!Stdlib.Out_channel.with_open_gen} is indeed one of the possible ways to create + an [Out_channel.t]. + + There is however a complication. If the user queries for [int -> int -> string], + then the polarities will be [-int], [-int] and [+string]. An entry of type [int +tring] would be included in the intersection of these polarities. But the + user explicitely asked for two integers to be consumed. To fix this issue, we + track the number of occurences of each polarity. + + The polarities for [int -> int -> string], become [(-int, 2)] and [(+string, 1)] + and allows us to filter entries according to this information. + + There is a mechanism for types with parameters like ['a list]. I might explain + it in the future. + TODO : Give an example even if not the full explanation. *) + +module Sign : sig + type t = + | Pos + | Neg + + val to_string : t -> string + val not : t -> t +end + +type t = string * int * Sign.t +(** The search database is a suffix tree structure, implemented in + {!Suffix_tree}. It is a solely text-based datastructure. Therefore, we need + a text represention for the polarities. + + The polarity [+t] is represented by ["+t"], and the polarity [-t] is + represented by ["-t"]. + + The fact that the sign is in the front is important : ["+flo"] is a prefix of + ["+float"], but ["flo+"] is not a prefix nor a suffix of ["float+"]. This + allows to answer incomplete queries. + + The integer represents the occurences of the polarity, as explained in the + toplevel documentation of the module. *) + +val of_typ : any_is_poly:bool -> Typexpr.t -> t Seq.t +(** [of_typ ~ignore_any ~all_names typ] is the list of polarised types + corresponding to [typ]. + + - If [any_is_poly] is true, the type [_] will be treated like a type variable + ['a], otherwise it will be represented solely by its sign ("+" or "-"). *) + +val poly : string diff --git a/vendor/sherlodoc/db/typexpr.ml b/vendor/sherlodoc/db/typexpr.ml new file mode 100644 index 0000000000..eb93c17ab5 --- /dev/null +++ b/vendor/sherlodoc/db/typexpr.ml @@ -0,0 +1,42 @@ +type t = + | Arrow of t * t + | Constr of string * t list + | Tuple of t list + | Poly of string + | Any + | Unhandled + +let tuple = function + | [] -> Any + | [ x ] -> x + | xs -> Tuple xs + +let rec show = function + | Arrow (a, b) -> show_parens a ^ " -> " ^ show b + | Constr (t, []) -> t + | Constr (t, [ x ]) -> show_parens x ^ " " ^ t + | Constr (t, xs) -> "(" ^ show_list xs ^ ") " ^ t + | Tuple xs -> show_tuple xs + | Poly "" -> "'_" + | Poly name -> "'" ^ name + | Any -> "_" + | Unhandled -> "???" + +and show_parens t = + match t with + | Arrow _ | Tuple _ -> "(" ^ show t ^ ")" + | _ -> show t + +and show_list = function + | [] -> failwith "show_list: empty" + | [ x ] -> show x + | x :: xs -> show x ^ ", " ^ show_list xs + +and show_tuple = function + | [] -> failwith "show_tuple: empty" + | [ x ] -> show_parens x + | x :: xs -> show_parens x ^ " * " ^ show_tuple xs + +let size typ = typ |> show |> String.length +let equal = Stdlib.( = ) +let hash = Hashtbl.hash diff --git a/vendor/sherlodoc/db/typexpr.mli b/vendor/sherlodoc/db/typexpr.mli new file mode 100644 index 0000000000..4c665aadcf --- /dev/null +++ b/vendor/sherlodoc/db/typexpr.mli @@ -0,0 +1,13 @@ +type t = + | Arrow of t * t + | Constr of string * t list + | Tuple of t list + | Poly of string + | Any + | Unhandled + +val tuple : t list -> t +val size : t -> int +val show : t -> string +val equal : t -> t -> bool +val hash : t -> int diff --git a/vendor/sherlodoc/dune-workspace b/vendor/sherlodoc/dune-workspace new file mode 100644 index 0000000000..7d2408dada --- /dev/null +++ b/vendor/sherlodoc/dune-workspace @@ -0,0 +1,3 @@ +(lang dune 3.5) + +(profile release) diff --git a/vendor/sherlodoc/index/db_writer.ml b/vendor/sherlodoc/index/db_writer.ml new file mode 100644 index 0000000000..e847421e35 --- /dev/null +++ b/vendor/sherlodoc/index/db_writer.ml @@ -0,0 +1,76 @@ +open Db + +type s = + { mutable load : int + ; writer_names : Suffix_tree.t + ; buffer_types : Suffix_tree.Buf.t + ; mutable writer_pos_types : Suffix_tree.t Occurences.t + ; mutable writer_neg_types : Suffix_tree.t Occurences.t + ; type_cache : Type_cache.t + } + +type t = s ref + +let load t = !t.load + +let make_empty () = + let buffer_names = Suffix_tree.Buf.make () in + let buffer_types = Suffix_tree.Buf.make () in + { load = 0 + ; writer_names = Suffix_tree.make buffer_names + ; buffer_types + ; writer_pos_types = Occurences.empty + ; writer_neg_types = Occurences.empty + ; type_cache = Type_cache.make () + } + +let make () = ref (make_empty ()) + +let export ~summarize db = + let shard = + let db = !db in + let db_names = Suffix_tree.export ~summarize db.writer_names in + let db_pos_types = + Occurences.map (Suffix_tree.export ~summarize) db.writer_pos_types + in + let db_neg_types = + Occurences.map (Suffix_tree.export ~summarize) db.writer_neg_types + in + { Storage.db_names; db_pos_types; db_neg_types } + in + db := make_empty () ; + shard + +let store db name elt ~count ~polarity = + db.load <- db.load + 1 ; + let st = + match polarity with + | Type_polarity.Sign.Pos -> begin + try Occurences.find count db.writer_pos_types with + | Not_found -> + let st = Suffix_tree.make db.buffer_types in + db.writer_pos_types <- Occurences.add count st db.writer_pos_types ; + st + end + | Type_polarity.Sign.Neg -> begin + try Occurences.find count db.writer_neg_types with + | Not_found -> + let st = Suffix_tree.make db.buffer_types in + db.writer_neg_types <- Occurences.add count st db.writer_neg_types ; + st + end + in + Suffix_tree.add_suffixes st name elt + +let store_type_polarities db elt polarities = + let db = !db in + Seq.iter (fun (path, count, polarity) -> store db ~count ~polarity path elt) polarities + +let store_word db word elt = + let db = !db in + db.load <- db.load + 1 ; + Suffix_tree.add_suffixes db.writer_names word elt + +let type_of_odoc ~db ty = + let db = !db in + Type_cache.of_odoc ~cache:db.type_cache ty diff --git a/vendor/sherlodoc/index/db_writer.mli b/vendor/sherlodoc/index/db_writer.mli new file mode 100644 index 0000000000..746626a5aa --- /dev/null +++ b/vendor/sherlodoc/index/db_writer.mli @@ -0,0 +1,13 @@ +type t +(** The type that builds a database. You can use it to add things to it, but + you cannot make queries on it. *) + +val export : summarize:bool -> t -> Db.t + +val make : unit -> t +(** [make ()] returns an empty search database. *) + +val load : t -> int +val type_of_odoc : db:t -> Odoc_model.Lang.TypeExpr.t -> Db.Typexpr.t +val store_type_polarities : t -> Db.Entry.t -> Db.Type_polarity.t Seq.t -> unit +val store_word : t -> string -> Db.Entry.t -> unit diff --git a/vendor/sherlodoc/index/dune b/vendor/sherlodoc/index/dune new file mode 100644 index 0000000000..da8f2264db --- /dev/null +++ b/vendor/sherlodoc/index/dune @@ -0,0 +1,11 @@ +(library + (name index) + (libraries + db + db_store + fpath + tyxml + odoc.search + odoc.model + odoc.odoc + cmdliner)) diff --git a/vendor/sherlodoc/index/index.ml b/vendor/sherlodoc/index/index.ml new file mode 100644 index 0000000000..28f1a327f8 --- /dev/null +++ b/vendor/sherlodoc/index/index.ml @@ -0,0 +1,138 @@ +let handle_file register file = + let ( >>= ) = Result.bind in + let open Odoc_odoc in + let open Odoc_index in + match Fpath.get_ext file with + | ".odoc-index" -> Odoc_file.load_index file >>= fun index -> Ok (register index) + | ".odocl" -> + Odoc_file.load file + >>= fun unit' -> + (match unit' with + | { Odoc_file.content = Unit_content unit'; _ } when unit'.hidden -> + Error (`Msg "Hidden units are ignored when generating an index") + | { content = Unit_content u; _ } -> Ok (register [ Skeleton.from_unit u ]) + | { content = Page_content p; _ } -> Ok (register [ Skeleton.from_page p ]) + | _ -> + Error (`Msg "Only pages and unit are allowed as input when generating an index")) + | _ -> + Error + (`Msg "Only .odocl and .odoc-index are allowed as input when generating an index") + +let index_file register filename = + match Fpath.of_string filename with + | Error (`Msg msg) -> Format.printf "FILE ERROR %s: %s@." filename msg + | Ok file -> + let open Odoc_model in + (match handle_file register file with + | Ok result -> result + | Error (`Msg msg) -> + Format.printf "Odoc warning or error %a: %s@." Fpath.pp file msg) + +let main + files + favourite_files + file_list + index_docstring + index_name + type_search + favoured_prefixes + db_format + db_filename + = + let module Storage = (val Db_store.storage_module db_format) in + let db = Db_writer.make () in + let no_pkg = Db.Entry.Package.v ~name:"" ~version:"" in + let register ~pkg ~favourite = + List.iter + @@ Odoc_utils.Tree.iter + ~f: + (Load_doc.register_entry + ~db + ~index_docstring + ~index_name + ~type_search + ~favourite + ~favoured_prefixes + ~pkg) + in + let files = + match file_list with + | None -> files + | Some file_list -> + let h = open_in file_list in + let rec read_all acc = + match Stdlib.input_line h with + | exception End_of_file -> List.rev acc + | line -> read_all (line :: acc) + in + let other_files = read_all [] in + close_in h ; + files @ other_files + in + let h = Storage.open_out db_filename in + let flush () = + let t = Db_writer.export ~summarize:(db_format = `ancient) db in + Storage.save ~db:h t + in + let loop ~favourite odoc = + let pkg, odoc = + match String.split_on_char '\t' odoc with + | [ filename ] -> no_pkg, filename + | [ name; filename ] -> Db.Entry.Package.v ~name ~version:"", filename + | [ name; version; filename ] -> Db.Entry.Package.v ~name ~version, filename + | _ -> failwith ("invalid line: " ^ odoc) + in + index_file (register ~pkg ~favourite) odoc ; + if db_format = `ancient && Db_writer.load db > 1_000_000 then flush () + in + List.iter (loop ~favourite:false) files ; + List.iter (loop ~favourite:true) favourite_files ; + flush () ; + Storage.close_out h + +open Cmdliner + +let index_docstring = + let doc = "Use the docstring to index the results." in + Arg.(value & opt bool true & info ~doc [ "index-docstring" ]) + +let index_name = + let doc = "Use the name to index the results." in + Arg.(value & opt bool true & info ~doc [ "index-name" ]) + +let type_search = + let doc = "Enable type based search." in + Arg.(value & opt bool true & info ~doc [ "type-search" ]) + +let favoured_prefixes = + let doc = + "The list of favoured prefixes. Entries that start with a favoured prefix are ranked \ + higher." + in + Arg.(value & opt (list string) [ "Stdlib." ] & info ~doc [ "favoured-prefixes" ]) + +let file_list = + let doc = + "File containing a list of .odocl files.\n\ + Useful for system where there is a limit on the number of arguments to a command." + in + Arg.(value & opt (some file) None & info [ "file-list" ] ~doc) + +let odoc_favourite_file = + let doc = "Path to a .odocl file whose entries will be ranked higher." in + Arg.(value & opt_all file [] & info [ "favoured" ] ~doc) + +let odoc_files = + let doc = "Path to a .odocl file or a .odoc-index file" in + Arg.(value & (pos_all file [] @@ info ~doc ~docv:"ODOCL_FILE" [])) + +let term = + Term.( + const main + $ odoc_files + $ odoc_favourite_file + $ file_list + $ index_docstring + $ index_name + $ type_search + $ favoured_prefixes) diff --git a/vendor/sherlodoc/index/index.mli b/vendor/sherlodoc/index/index.mli new file mode 100644 index 0000000000..fae8900e05 --- /dev/null +++ b/vendor/sherlodoc/index/index.mli @@ -0,0 +1 @@ +val term : (Db_store.db_format -> string -> unit) Cmdliner.Term.t diff --git a/vendor/sherlodoc/index/load_doc.ml b/vendor/sherlodoc/index/load_doc.ml new file mode 100644 index 0000000000..1a0b9705e0 --- /dev/null +++ b/vendor/sherlodoc/index/load_doc.ml @@ -0,0 +1,225 @@ +module Entry = Db.Entry +module Db_common = Db +module ModuleName = Odoc_model.Names.ModuleName + +let string_starts_with ~prefix str = + let rec go i = + if i >= String.length prefix then true else prefix.[i] = str.[i] && go (i + 1) + in + String.length prefix <= String.length str && go 0 + +let path_length str = + let rec go i acc = + if i >= String.length str + then acc + else go (i + 1) (if str.[i] = '.' then acc + 1 else acc) + in + go 0 0 + +let kind_cost = function + | Entry.Kind.Constructor _ | Entry.Kind.Exception _ | Entry.Kind.Extension_constructor _ + | Entry.Kind.Field _ | Entry.Kind.Module | Entry.Kind.Type_decl _ + | Entry.Kind.Type_extension | Entry.Kind.Val _ -> + 0 + | _ -> 50 + +let rhs_cost = function + | Some str -> String.length str + | None -> 20 + +let cost_doc = function + | Entry.Kind.Constructor _ | Entry.Kind.Exception _ | Entry.Kind.Extension_constructor _ + | Entry.Kind.Field _ | Entry.Kind.Module | Entry.Kind.Module_type + | Entry.Kind.Type_decl _ | Entry.Kind.Type_extension -> + 0 + | _ -> 100 + +let cost ~name ~kind ~doc_html ~rhs ~cat ~favourite ~favoured_prefixes = + String.length name + + (5 * path_length name) + + (if List.exists (fun prefix -> string_starts_with ~prefix name) favoured_prefixes + then 0 + else 50) + + (if favourite then 0 else 50) + + rhs_cost rhs + + kind_cost kind + + (if cat = `definition then 0 else 100) + + if doc_html <> "" then 0 else cost_doc kind + +let string_of_html = Format.asprintf "%a" (Tyxml.Html.pp_elt ()) + +let with_tokenizer str fn = + let str = String.lowercase_ascii str in + let buf = Buffer.create 16 in + let flush () = + let word = Buffer.contents buf in + if word <> "" then fn word ; + Buffer.clear buf + in + let rec go i = + if i >= String.length str + then flush () + else ( + let chr = str.[i] in + if (chr >= 'a' && chr <= 'z') + || (chr >= '0' && chr <= '9') + || chr = '_' + || chr = '@' + then Buffer.add_char buf chr + else flush () ; + go (i + 1)) + in + go 0 + +let register_doc ~db elt doc_txt = + with_tokenizer doc_txt @@ fun word -> Db_writer.store_word db word elt + +let register_full_name ~db (elt : Db.Entry.t) = + let name = String.lowercase_ascii elt.name in + Db_writer.store_word db name elt + +let searchable_type_of_constructor args res = + let open Odoc_model.Lang in + match args with + | TypeDecl.Constructor.Tuple args -> begin + match args with + | _ :: _ :: _ -> TypeExpr.(Arrow (None, Tuple args, res)) + | [ arg ] -> TypeExpr.(Arrow (None, arg, res)) + | _ -> res + end + | TypeDecl.Constructor.Record fields -> + List.fold_left + (fun res field -> + let open TypeDecl.Field in + let field_name = Odoc_model.Paths.Identifier.name field.id in + TypeExpr.Arrow (Some (Label field_name), field.type_, res)) + res + fields + +let searchable_type_of_record parent_type type_ = + Odoc_model.Lang.TypeExpr.Arrow (None, parent_type, type_) + +let convert_kind ~db (Odoc_index.Entry.{ kind; _ } as entry) = + match kind with + | TypeDecl _ -> Entry.Kind.Type_decl (Odoc_search.Html.typedecl_params_of_entry entry) + | Value { value = _; type_ } -> + let typ = Db_writer.type_of_odoc ~db type_ in + Entry.Kind.Val typ + | Constructor { args; res } -> + let typ = searchable_type_of_constructor args res in + let typ = Db_writer.type_of_odoc ~db typ in + Entry.Kind.Constructor typ + | ExtensionConstructor { args; res } -> + let typ = searchable_type_of_constructor args res in + let typ = Db_writer.type_of_odoc ~db typ in + Entry.Kind.Extension_constructor typ + | Exception { args; res } -> + let typ = searchable_type_of_constructor args res in + let typ = Db_writer.type_of_odoc ~db typ in + Entry.Kind.Exception typ + | Field { mutable_ = _; parent_type; type_ } -> + let typ = searchable_type_of_record parent_type type_ in + let typ = Db_writer.type_of_odoc ~db typ in + Entry.Kind.Field typ + | Doc -> Doc + | Dir -> Doc + | Page _ -> Doc + | Class_type _ -> Class_type + | Method _ -> Method + | Class _ -> Class + | TypeExtension _ -> Type_extension + | Module _ -> Entry.Kind.Module + | ModuleType _ -> Module_type + | Impl -> Doc + +let register_type_expr ~db elt typ = + let type_polarities = Db.Type_polarity.of_typ ~any_is_poly:true typ in + Db_writer.store_type_polarities db elt type_polarities + +let register_kind ~db elt = + let open Db.Entry in + match Kind.get_type elt.kind with + | None -> () + | Some typ -> register_type_expr ~db elt typ + +let rec categorize id = + let open Odoc_model.Paths in + match id.Identifier.iv with + | `Root _ | `Page _ | `LeafPage _ -> `definition + | `ModuleType _ -> `declaration + | `Parameter _ -> `ignore (* redundant with indexed signature *) + | ( `InstanceVariable _ | `Method _ | `Field _ | `Result _ | `Label _ | `Type _ + | `Exception _ | `Class _ | `ClassType _ | `Value _ | `Constructor _ | `Extension _ + | `ExtensionDecl _ | `Module _ ) as x -> + let parent = Identifier.label_parent { id with iv = x } in + categorize (parent :> Identifier.Any.t) + | `AssetFile _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _ + | `SourceLocationInternal _ -> + `ignore (* unclear what to do with those *) + +let categorize Odoc_index.Entry.{ id; _ } = + match id.iv with + | `ModuleType (parent, _) -> + (* A module type itself is not *from* a module type, but it might be if one + of its parents is a module type. *) + categorize (parent :> Odoc_model.Paths.Identifier.Any.t) + | _ -> categorize id + +let register_entry + ~db + ~index_name + ~type_search + ~index_docstring + ~favourite + ~favoured_prefixes + ~pkg + ~cat + (Odoc_index.Entry.{ id; doc; kind } as entry) + = + let module Sherlodoc_entry = Entry in + let open Odoc_search in + let name = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in + let doc_txt = Text.of_doc doc in + let doc_html = + match doc_txt with + | "" -> "" + | _ -> string_of_html (Html.of_doc doc) + in + let rhs = Html.rhs_of_kind kind in + let kind = convert_kind ~db entry in + let cost = cost ~name ~kind ~doc_html ~rhs ~cat ~favourite ~favoured_prefixes in + let url = Html.url entry in + let elt = Sherlodoc_entry.v ~name ~kind ~rhs ~doc_html ~cost ~url ~pkg () in + if index_docstring then register_doc ~db elt doc_txt ; + if index_name && kind <> Doc then register_full_name ~db elt ; + if type_search then register_kind ~db elt + +let register_entry + ~db + ~index_name + ~type_search + ~index_docstring + ~favourite + ~favoured_prefixes + ~pkg + (Odoc_index.Entry.{ id; kind; _ } as entry) + = + let cat = categorize entry in + let is_pure_documentation = + match kind with + | Doc | Page _ | Dir | Impl -> true + | _ -> false + in + if is_pure_documentation || cat = `ignore || Odoc_model.Paths.Identifier.is_hidden id + then () + else + register_entry + ~db + ~index_name + ~type_search + ~index_docstring + ~favourite + ~favoured_prefixes + ~pkg + ~cat + entry diff --git a/vendor/sherlodoc/index/load_doc.mli b/vendor/sherlodoc/index/load_doc.mli new file mode 100644 index 0000000000..a2a11126ad --- /dev/null +++ b/vendor/sherlodoc/index/load_doc.mli @@ -0,0 +1,12 @@ +val register_entry + : db:Db_writer.t + -> index_name:bool + -> type_search:bool + -> index_docstring:bool + -> favourite:bool + -> favoured_prefixes:string list + -> pkg:Db.Entry.Package.t + -> Odoc_index.Entry.t + -> unit +(** [register_entry ~db ~index_name ~type_search ~index_docstring e] register + the entry [e] in [db]. *) diff --git a/vendor/sherlodoc/index/suffix_tree.ml b/vendor/sherlodoc/index/suffix_tree.ml new file mode 100644 index 0000000000..7e96c8d671 --- /dev/null +++ b/vendor/sherlodoc/index/suffix_tree.ml @@ -0,0 +1,429 @@ +module Doc = struct + type 'a t = + { uid : 'a + ; text : string + } + + let length t = String.length t.text + 1 + + type 'a v = + | Terminal of 'a + | Char of char + + let get t i = if i >= String.length t.text then Terminal t.uid else Char t.text.[i] + let sub { text; _ } i = String.sub text i (String.length text - i) +end + +module Buf = struct + (* Cache small strings as slices in one bigstring. *) + + module String_hashtbl = Hashtbl.Make (struct + type t = string + + let equal = String.equal + let hash = Hashtbl.hash + end) + + type t = + { buffer : Buffer.t + ; cache : int String_hashtbl.t + ; mutable contents : string option + } + + let make () = + { buffer = Buffer.create 16; cache = String_hashtbl.create 16; contents = None } + + let contents t = + match t.contents with + | Some contents -> contents + | None -> + let contents = Buffer.contents t.buffer in + t.contents <- Some contents ; + contents + + let get t i = Buffer.nth t.buffer i + + let add { buffer; cache; contents } substr = + assert (contents = None) ; + match String_hashtbl.find_opt cache substr with + | Some start -> start + | None -> + let start = Buffer.length buffer in + Buffer.add_string buffer substr ; + let stop = Buffer.length buffer in + assert (stop - start = String.length substr) ; + for idx = 1 to String.length substr - 1 do + String_hashtbl.add + cache + (String.sub substr idx (String.length substr - idx)) + (start + idx) + done ; + start +end + +module Entry = Db.Entry + +module Uid = struct + type t = int + + let gen = ref 0 + + let make () = + let u = !gen in + gen := u + 1 ; + u +end + +module Terminals = struct + type t = Entry.t list + + let empty = [] + let singleton x = [ x ] + + let add ~hint x xs = + match hint with + | Some (prev_xs, xxs) when prev_xs == xs -> xxs + | _ -> x :: xs + + let hash = Hashtbl.hash + + let rec equal xs ys = + match xs, ys with + | [], [] -> true + | x :: xs, y :: ys when x == y -> equal xs ys + | _ -> false + + let equal xs ys = xs == ys || equal xs ys + + let mem x = function + | y :: _ -> Entry.equal x y + | _ -> false +end + +module Char_map = Map.Make (Char) + +type node = + { mutable start : int + ; mutable len : int + ; mutable suffix_link : node option + ; mutable terminals : Terminals.t + ; mutable children : node Char_map.t + } + +type t = + { buffer : Buf.t + ; root : node + } + +let make_root () = + { start = 0 + ; len = 0 + ; suffix_link = None + ; terminals = Terminals.empty + ; children = Char_map.empty + } + +let make buffer = { root = make_root (); buffer } + +let split_at ~str node len = + let split_chr = Buf.get str (node.start + len) in + let new_node = + { start = node.start + ; len + ; suffix_link = None + ; terminals = Terminals.empty + ; children = Char_map.singleton split_chr node + } + in + node.start <- node.start + len + 1 ; + node.len <- node.len - 1 - len ; + new_node + +let lcp i_str i j_str j j_len = + let j_stop = j + j_len in + let rec go_lcp i j = + if i >= String.length i_str || j >= j_stop + then i + else ( + let i_chr, j_chr = i_str.[i], Buf.get j_str j in + if i_chr <> j_chr then i else go_lcp (i + 1) (j + 1)) + in + let i' = go_lcp i j in + i' - i + +let make_leaf ~prev_leaf ~buffer ~doc str_start = + let start = + match prev_leaf with + | None -> + let substr = Doc.sub doc (str_start - 1) in + let start = Buf.add buffer substr in + start + 1 + | Some (prev_leaf, _depth, _) -> + let doc_len = Doc.length doc in + prev_leaf.start + prev_leaf.len - (doc_len - str_start) + 1 + in + let len = Doc.length doc - str_start - 1 in + assert (start > 0) ; + { start + ; len + ; suffix_link = None + ; terminals = Terminals.singleton doc.Doc.uid + ; children = Char_map.empty + } + +let set_suffix_link ~prev ~depth node = + match prev with + | Some (prev, prev_depth) when depth = prev_depth -> + begin + match prev.suffix_link with + | None -> prev.suffix_link <- Some node + | Some node' -> assert (node == node') + end ; + None + | _ -> prev + +let add_document trie doc = + let root = trie.root in + let set_leaf ?debug:_ ~prev_leaf ~depth node = + if node == root + then None + else begin + begin + match prev_leaf with + | None -> () + | Some (prev_leaf, prev_depth, _) -> + assert (prev_depth = depth) ; + begin + match prev_leaf.suffix_link with + | None -> prev_leaf.suffix_link <- Some node + | Some node' -> assert (node' == node) + end + end ; + Some (node, depth - 1) + end + in + let rec go ~prev ~prev_leaf ~depth node i = + let prev = set_suffix_link ~prev ~depth node in + if i >= Doc.length doc + then assert (depth = 0) + else ( + let chr = Doc.get doc i in + let i, depth = i + 1, depth + 1 in + match chr with + | Terminal doc_uid -> + if not (Terminals.mem doc_uid node.terminals) + then begin + let hint = + Option.map + (fun (t, _, prev_terminals) -> prev_terminals, t.terminals) + prev_leaf + in + let prev_terminals = node.terminals in + node.terminals <- Terminals.add ~hint doc_uid node.terminals ; + let prev_leaf = + match set_leaf ~debug:"0" ~prev_leaf ~depth node with + | None -> None + | Some (t, depth) -> Some (t, depth, prev_terminals) + in + follow_suffix ~prev ~prev_leaf ~parent:node ~depth ~i + end + | Char chr -> begin + match Char_map.find chr node.children with + | child -> + assert (depth >= 0) ; + assert (i - depth >= 0) ; + assert (i < Doc.length doc) ; + let len = lcp doc.Doc.text i trie.buffer child.start child.len in + let i, depth = i + len, depth + len in + assert (i < Doc.length doc) ; + if len = child.len + then + if not (Char_map.is_empty child.children) + then go ~prev ~prev_leaf ~depth child i + else add_leaf ~prev_leaf ~node ~child ~depth ~i ~len + else begin + let new_child = split_at ~str:trie.buffer child len in + node.children <- Char_map.add chr new_child node.children ; + let prev = set_suffix_link ~prev ~depth new_child in + assert (prev = None) ; + add_leaf ~prev_leaf ~node ~child:new_child ~depth ~i ~len + end + | exception Not_found -> + let new_leaf = make_leaf ~prev_leaf ~buffer:trie.buffer ~doc i in + node.children <- Char_map.add chr new_leaf node.children ; + let prev_leaf = + set_leaf ~debug:"1" ~prev_leaf ~depth:(depth + Doc.length doc - i) new_leaf + in + let prev_leaf = + match prev_leaf with + | None -> None + | Some (t, depth) -> Some (t, depth, Terminals.empty) + in + follow_suffix ~prev ~prev_leaf ~parent:node ~depth ~i + end) + and add_leaf ~prev_leaf ~node ~child ~depth ~i ~len = + match Doc.get doc i with + | Terminal doc_uid -> + if not (Terminals.mem doc_uid child.terminals) + then begin + let hint = + Option.map (fun (t, _, prev_terminals) -> prev_terminals, t.terminals) prev_leaf + in + let prev_terminals = child.terminals in + child.terminals <- Terminals.add ~hint doc_uid child.terminals ; + let prev_leaf = + match set_leaf ~debug:"2" ~prev_leaf ~depth:(depth + 1) child with + | None -> None + | Some (t, depth) -> Some (t, depth, prev_terminals) + in + assert (Doc.length doc - i = 1) ; + begin + match child.suffix_link with + | None -> + let i, depth = i - len, depth - len in + follow_suffix ~prev:None ~prev_leaf ~parent:node ~depth ~i + | Some next_child -> + let depth = depth - 1 in + go ~prev:None ~prev_leaf:None ~depth next_child i + end + end + | Char new_chr -> + let new_leaf = make_leaf ~prev_leaf ~buffer:trie.buffer ~doc (i + 1) in + let prev_leaf = + set_leaf ~debug:"3" ~prev_leaf ~depth:(depth + Doc.length doc - i) new_leaf + in + let prev_leaf = + match prev_leaf with + | None -> None + | Some (t, depth) -> Some (t, depth, Terminals.empty) + in + child.children <- Char_map.add new_chr new_leaf child.children ; + let prev = Some (child, depth - 1) in + let i, depth = i - len, depth - len in + follow_suffix ~prev ~prev_leaf ~parent:node ~depth ~i + and follow_suffix ~prev ~prev_leaf ~parent ~depth ~i = + match parent.suffix_link with + | None -> begin + let i = i - depth + 1 in + go ~prev:None ~prev_leaf ~depth:0 root i + end + | Some next -> + assert (depth >= 2) ; + assert (next != root) ; + go ~prev ~prev_leaf ~depth:(depth - 2) next (i - 1) + in + go ~prev:None ~prev_leaf:None ~depth:0 root 0 + +let add_suffixes t text elt = add_document t { Doc.text; uid = elt } + +module Terminals_cache = Hashtbl.Make (Terminals) +module Seen = Set.Make (Db.Entry) + +let export_terminals ~cache_term ~is_summary ts = + try Terminals_cache.find cache_term ts with + | Not_found -> + let terminals = + if ts = [] + then Db.String_automata.Empty + else if is_summary + then Db.String_automata.Summary (Array.of_list ts) + else Db.String_automata.Terminals (Array.of_list ts) + in + let result = Uid.make (), terminals in + Terminals_cache.add cache_term ts result ; + result + +type result = + { uid : Uid.t + ; t : Db.String_automata.node + ; min : Entry.t + ; seen : Seen.t + } + +let size_of_terminals = function + | Db.String_automata.Empty -> 1 + | Summary arr | Terminals arr -> Array.length arr + +let rec export ~cache ~cache_term ~summarize ~is_root node = + let is_summary = summarize && not is_root in + let children = + Char_map.bindings + @@ Char_map.map (export ~cache ~cache_term ~summarize ~is_root:false) node.children + in + let children = + List.sort + (fun (a_chr, { min = a; _ }) (b_chr, { min = b; _ }) -> + match Entry.compare a b with + | 0 -> Char.compare a_chr b_chr + | c -> c) + children + in + let children_seen = + List.fold_left (fun acc (_, child) -> Seen.union acc child.seen) Seen.empty children + in + let seen = List.fold_left (fun acc e -> Seen.add e acc) children_seen node.terminals in + let terminals = + if is_summary + then List.of_seq (Seen.to_seq seen) + else + List.sort Entry.compare + @@ List.filter (fun e -> not (Seen.mem e children_seen)) node.terminals + in + let min_child = + match children with + | [] -> None + | (_, { min = elt; _ }) :: _ -> Some elt + in + let min_terminal = + match terminals with + | [] -> None + | hd :: _ -> Some hd + in + let min_child, terminals = + match min_child, min_terminal with + | None, None -> failwith "suffix_tree: empty node" + | None, Some min_terminal -> min_terminal, terminals + | Some min_child, None -> min_child, min_child :: terminals + | Some min_child, Some min_terminal -> + if Db.Entry.compare min_child min_terminal < 0 + then min_child, min_child :: terminals + else min_terminal, terminals + in + assert (min_child == Seen.min_elt seen) ; + assert (terminals <> []) ; + let terminals_uid, terminals = export_terminals ~cache_term ~is_summary terminals in + let children_uids = List.map (fun (chr, { uid; _ }) -> chr, uid) children in + let key = node.start, node.len, terminals_uid, children_uids in + try Hashtbl.find cache key with + | Not_found -> + let children = + Array.of_list @@ List.map (fun (_, { t = child; _ }) -> child) children + in + let size = size_of_terminals terminals in + let size = + if is_summary + then size + else + Array.fold_left + (fun acc child -> acc + child.Db.String_automata.size) + size + children + in + let children = if Array.length children = 0 then None else Some children in + let node = + { Db.String_automata.start = node.start; len = node.len; size; terminals; children } + in + let result = { uid = Uid.make (); t = node; min = min_child; seen } in + Hashtbl.add cache key result ; + result + +let export ~summarize { buffer; root = t } = + let str = Buf.contents buffer in + if String.length str = 0 + then { Db.String_automata.str; t = Db.String_automata.empty () } + else begin + let cache = Hashtbl.create 16 in + let cache_term = Terminals_cache.create 16 in + let { t; _ } = export ~cache ~cache_term ~summarize ~is_root:true t in + { Db.String_automata.str; t } + end diff --git a/vendor/sherlodoc/index/suffix_tree.mli b/vendor/sherlodoc/index/suffix_tree.mli new file mode 100644 index 0000000000..0ff6a5a266 --- /dev/null +++ b/vendor/sherlodoc/index/suffix_tree.mli @@ -0,0 +1,11 @@ +module Buf : sig + type t + + val make : unit -> t +end + +type t + +val make : Buf.t -> t +val add_suffixes : t -> string -> Db.Entry.t -> unit +val export : summarize:bool -> t -> Db.String_automata.t diff --git a/vendor/sherlodoc/index/type_cache.ml b/vendor/sherlodoc/index/type_cache.ml new file mode 100644 index 0000000000..6d092ee30c --- /dev/null +++ b/vendor/sherlodoc/index/type_cache.ml @@ -0,0 +1,23 @@ +open Db.Typexpr +module H = Hashtbl.Make (Db.Typexpr) + +type t = Db.Typexpr.t -> Db.Typexpr.t + +let make () = + let table = H.create 256 in + fun t -> + match H.find_opt table t with + | Some t -> t + | None -> + H.add table t t ; + t + +let rec of_odoc ~cache otyp = + match otyp with + | Odoc_model.Lang.TypeExpr.Var _str -> Any + | Any -> Any + | Arrow (_lbl, left, right) -> cache (Arrow (of_odoc ~cache left, of_odoc ~cache right)) + | Constr (name, args) -> + cache (Constr (Typename.to_string name, List.map (of_odoc ~cache) args)) + | Tuple li -> cache (Tuple (List.map (of_odoc ~cache) li)) + | _ -> Unhandled diff --git a/vendor/sherlodoc/index/type_cache.mli b/vendor/sherlodoc/index/type_cache.mli new file mode 100644 index 0000000000..2d7d6efaea --- /dev/null +++ b/vendor/sherlodoc/index/type_cache.mli @@ -0,0 +1,4 @@ +type t + +val make : unit -> t +val of_odoc : cache:t -> Odoc_model.Lang.TypeExpr.t -> Db.Typexpr.t diff --git a/vendor/sherlodoc/index/typename.ml b/vendor/sherlodoc/index/typename.ml new file mode 100644 index 0000000000..5d3af2b3a7 --- /dev/null +++ b/vendor/sherlodoc/index/typename.ml @@ -0,0 +1,40 @@ +module Path = Odoc_model.Paths.Path +module Identifier = Odoc_model.Paths.Identifier +module TypeName = Odoc_model.Names.TypeName +module ModuleName = Odoc_model.Names.ModuleName + +let rec show_ident_long h (r : Identifier.t_pv Identifier.id) = + match r.iv with + | `Type (md, n) -> Format.fprintf h "%a.%s" show_signature md (TypeName.to_string n) + | _ -> Format.fprintf h "%S" (r |> Identifier.fullname |> String.concat ".") + +and show_signature h sig_ = + match sig_.iv with + | `Root (_, name) -> Format.fprintf h "%s" (ModuleName.to_string name) + | `Module (pt, mdl) -> + Format.fprintf h "%a.%s" show_signature pt (ModuleName.to_string mdl) + | `Parameter (_, p) -> Format.fprintf h "%s" (ModuleName.to_string p) + | `Result t -> Format.fprintf h "%a" show_signature t + | `ModuleType (_, p) -> + Format.fprintf h "%s" (Odoc_model.Names.ModuleTypeName.to_string p) + +let rec show_type_name_verbose h : Path.Type.t -> _ = function + | `Resolved t -> + (match Path.Resolved.(identifier (t :> t)) with + | Some i -> Format.fprintf h "%a" show_ident_long i + | None -> + (match t with + | `CoreType n -> Format.fprintf h "%s" (Odoc_model.Names.TypeName.to_string n) + | _ -> Format.fprintf h "%s" "Core type")) + | `Identifier (path, _hidden) -> + let name = String.concat "." @@ Identifier.fullname path in + Format.fprintf h "%s" name + | `DotT (mdl, x) -> + Format.fprintf + h + "%s.%s" + (Odoc_document.Url.render_path (mdl :> Path.t)) + (Odoc_model.Names.TypeName.to_string x) + | `SubstitutedT x -> show_type_name_verbose h x + +let to_string t = Format.asprintf "%a" show_type_name_verbose t diff --git a/vendor/sherlodoc/index/typename.mli b/vendor/sherlodoc/index/typename.mli new file mode 100644 index 0000000000..c6410ce6ad --- /dev/null +++ b/vendor/sherlodoc/index/typename.mli @@ -0,0 +1,5 @@ +val to_string : Odoc_model.Paths.Path.Type.t -> string +(** [Typename.string tn] is a string representing the type name of [tn] as a string. + Such a function could be provided by Odoc but we do two things differently : + - Core types like [int] and [string] are represented as [Stdlib.int] or [Stdlib.string] + - We do not use any parenthesis on functors. *) diff --git a/vendor/sherlodoc/jsoo/dune b/vendor/sherlodoc/jsoo/dune new file mode 100644 index 0000000000..eb4be501b5 --- /dev/null +++ b/vendor/sherlodoc/jsoo/dune @@ -0,0 +1,9 @@ +(executable + (name main) + (modes js) + (libraries brr query)) + +(rule + (alias all) + (action + (copy main.bc.js sherlodoc.js))) diff --git a/vendor/sherlodoc/jsoo/main.ml b/vendor/sherlodoc/jsoo/main.ml new file mode 100644 index 0000000000..1f7315ea1e --- /dev/null +++ b/vendor/sherlodoc/jsoo/main.ml @@ -0,0 +1,155 @@ +let print_error e = + print_string + @@ String.concat + "" + [ "Error : " + ; Jstr.to_string @@ Jv.Error.name e + ; " " + ; Jstr.to_string @@ Jv.Error.message e + ; "\n" + ; Jstr.to_string @@ Jv.Error.stack e + ] + +let new_ cl = Jv.(new' (get global cl)) + +let stream_of_string str = + let str = str |> Brr.Tarray.of_binary_jstr |> Result.get_ok |> Brr.Tarray.to_jv in + let stream = + new_ + "ReadableStream" + Jv. + [| obj + [| ( "start" + , callback ~arity:1 (fun controller -> + let _ = call controller "enqueue" [| str |] in + let _ = call controller "close" [||] in + ()) ) + |] + |] + in + stream + +module Decompress_browser = struct + (** This module contains binding to the browser string compression api. It is + much faster than using an OCaml library, and does not require sending code + over the network. *) + + let string_of_stream stream = + let buffer = Buffer.create 128 in + let append str = + Buffer.add_string buffer (str |> Brr.Tarray.of_jv |> Brr.Tarray.to_string) + in + let open Jv in + let reader = call stream "getReader" [||] in + let open Fut.Syntax in + let rec read_step obj = + let done_ = get obj "done" |> to_bool in + let str = get obj "value" in + if not done_ + then ( + append str ; + read ()) + else Fut.return () + and read () : unit Fut.t = + let read = call reader "read" [||] in + let promise = Fut.of_promise ~ok:Fun.id read in + Fut.bind promise (function + | Ok v -> read_step v + | Error e -> + print_endline "error in string_of_stream" ; + print_error e ; + Fut.return ()) + in + let+ () = read () in + let r = Buffer.contents buffer in + r + + let inflate str = + let dekompressor = Jv.(new_ "DecompressionStream" [| of_string "deflate" |]) in + let str = Jv.(call global "atob" [| str |]) |> Jv.to_jstr in + let stream = stream_of_string str in + let decompressed_stream = Jv.call stream "pipeThrough" [| dekompressor |] in + string_of_stream decompressed_stream +end + +let db = + Jv.(Decompress_browser.inflate @@ call global "sherlodoc_db" [||]) + |> Fut.map (fun str -> [ Marshal.from_string str 0 ]) + +let string_of_kind = + let open Db.Entry.Kind in + let open Odoc_html_frontend in + function + | Db.Entry.Kind.Doc -> kind_doc + | Page -> kind_doc + | Impl -> kind_impl + | Type_decl _ -> kind_typedecl + | Module -> kind_module + | Exception _ -> kind_exception + | Class_type -> kind_class_type + | Method -> kind_method + | Class -> kind_class + | Type_extension -> kind_extension + | Extension_constructor _ -> kind_extension_constructor + | Module_type -> kind_module_type + | Constructor _ -> kind_constructor + | Field _ -> kind_field + | Val _ -> kind_value + +let search message db = + let query = Jv.get message "data" in + let query = query |> Jv.to_jstr |> Jstr.to_string in + let results = + Query.Blocking.search ~shards:db { Query.query; packages = []; limit = 50 } + in + let _ = + Jv.(apply (get global "postMessage")) + [| Jv.of_list + (fun Db.Entry.{ name; rhs; doc_html; kind; url; _ } -> + let typedecl_params = + match kind with + | Db.Entry.Kind.Type_decl args -> args + | _ -> None + in + let prefix_name, name = + match kind with + | Db.Entry.Kind.Doc -> None, None + | _ -> begin + match List.rev (String.split_on_char '.' name) with + | [] -> None, None + | [ hd ] -> None, Some hd + | hd :: tl -> Some (String.concat "." (List.rev tl)), Some hd + end + in + let kind = string_of_kind kind in + let html = + Tyxml.Html.string_of_list + @@ Odoc_html_frontend.of_strings + ~kind + ~prefix_name + ~name + ~typedecl_params + ~rhs + ~doc:doc_html + in + Jv.obj [| "html", Jv.of_string html; "url", Jv.of_string url |]) + results + |] + in + () + +let don't_wait_for fut = Fut.await fut Fun.id + +let search message = + don't_wait_for + @@ + let open Fut.Syntax in + let+ db = db in + search message db + +let main () = + let module J' = Jstr in + let o = Jv.callback ~arity:1 search in + Jv.(set global "onmessage" o) + +let _ = main () diff --git a/vendor/sherlodoc/jsoo/odoc_html_frontend.ml b/vendor/sherlodoc/jsoo/odoc_html_frontend.ml new file mode 100644 index 0000000000..9496d0d289 --- /dev/null +++ b/vendor/sherlodoc/jsoo/odoc_html_frontend.ml @@ -0,0 +1,52 @@ +(* copy-pasted from odoc/src/search/odoc_html_frontend.ml *) + +let of_strings ~kind ~prefix_name ~name ~rhs ~typedecl_params ~doc = + let open Tyxml.Html in + let kind = code ~a:[ a_class [ "entry-kind" ] ] [ txt kind ] + and typedecl_params = + match typedecl_params with + | None -> [] + | Some p -> + [ span + ~a: + [ a_class + [ (* the parameter of the typedecl are highlighted as if part of main entry name. *) + "entry-name" + ] + ] + [ txt (p ^ " ") ] + ] + and prefix_name = + match prefix_name with + | None -> [] + | Some "" -> [] + | Some prefix_name -> + [ span ~a:[ a_class [ "prefix-name" ] ] [ txt (prefix_name ^ ".") ] ] + and name = + match name with + | Some name -> [ span ~a:[ a_class [ "entry-name" ] ] [ txt name ] ] + | None -> [] + and rhs = + match rhs with + | None -> [] + | Some rhs -> [ code ~a:[ a_class [ "entry-rhs" ] ] [ txt rhs ] ] + in + [ kind + ; code ~a:[ a_class [ "entry-title" ] ] (typedecl_params @ prefix_name @ name @ rhs) + ; div ~a:[ a_class [ "entry-comment" ] ] [ Unsafe.data doc ] + ] + +let kind_doc = "doc" +let kind_typedecl = "type" +let kind_module = "mod" +let kind_exception = "exn" +let kind_class_type = "class" +let kind_class = "class" +let kind_method = "meth" +let kind_extension_constructor = "cons" +let kind_module_type = "sig" +let kind_constructor = "cons" +let kind_field = "field" +let kind_value = "val" +let kind_extension = "ext" +let kind_impl = "source" diff --git a/vendor/sherlodoc/jsoo/tyxml.ml b/vendor/sherlodoc/jsoo/tyxml.ml new file mode 100644 index 0000000000..3ebabd7e18 --- /dev/null +++ b/vendor/sherlodoc/jsoo/tyxml.ml @@ -0,0 +1,84 @@ +module Html : sig + type t + + val string_of_list : t list -> string + + type attr + + val a_class : string list -> attr + val code : a:attr list -> t list -> t + val span : a:attr list -> t list -> t + val div : a:attr list -> t list -> t + val txt : string -> t + + module Unsafe : sig + val data : string -> t + end +end = struct + type t = + | Raw of string + | Txt of string + | Concat of t list + + let add_escape_string buf s = + (* https://discuss.ocaml.org/t/html-encoding-of-string/4289/4 *) + let add = Buffer.add_string buf in + let len = String.length s in + let max_idx = len - 1 in + let flush start i = + if start < len then Buffer.add_substring buf s start (i - start) + in + let rec loop start i = + if i > max_idx + then flush start i + else begin + match String.get s i with + | '&' -> escape "&" start i + | '<' -> escape "<" start i + | '>' -> escape ">" start i + | '\'' -> escape "'" start i + | '"' -> escape """ start i + | '@' -> escape "@" start i + | _ -> loop start (i + 1) + end + and escape amperstr start i = + flush start i ; + add amperstr ; + let next = i + 1 in + loop next next + in + loop 0 0 + + let to_string t = + let buf = Buffer.create 16 in + let rec go = function + | Raw s -> Buffer.add_string buf s + | Txt s -> add_escape_string buf s + | Concat xs -> List.iter go xs + in + go t ; + Buffer.contents buf + + let string_of_list lst = to_string (Concat lst) + + type attr = t + + let a_class lst = Concat [ Raw "class=\""; Txt (String.concat " " lst); Raw "\"" ] + + let attrs = function + | [] -> Concat [] + | xs -> Concat (Raw " " :: xs) + + let block name ~a body = + let name = Raw name in + Concat [ Raw "<"; name; attrs a; Raw ">"; Concat body; Raw "" ] + + let code = block "code" + let span = block "span" + let div = block "span" + let txt s = Txt s + + module Unsafe = struct + let data s = Raw s + end +end diff --git a/vendor/sherlodoc/jsoo/tyxml.mli b/vendor/sherlodoc/jsoo/tyxml.mli new file mode 100644 index 0000000000..f539ea363a --- /dev/null +++ b/vendor/sherlodoc/jsoo/tyxml.mli @@ -0,0 +1,18 @@ +(* smaller js bundle than the real TyXml *) +module Html : sig + type t + + val string_of_list : t list -> string + + type attr + + val a_class : string list -> attr + val code : a:attr list -> t list -> t + val span : a:attr list -> t list -> t + val div : a:attr list -> t list -> t + val txt : string -> t + + module Unsafe : sig + val data : string -> t + end +end diff --git a/vendor/sherlodoc/query/dune b/vendor/sherlodoc/query/dune new file mode 100644 index 0000000000..c9f0de2ac0 --- /dev/null +++ b/vendor/sherlodoc/query/dune @@ -0,0 +1,9 @@ +(library + (name query) + (libraries db)) + +(menhir + (modules type_parser) + (flags --explain)) + +(ocamllex type_lexer) diff --git a/vendor/sherlodoc/query/dynamic_cost.ml b/vendor/sherlodoc/query/dynamic_cost.ml new file mode 100644 index 0000000000..e3fac28a15 --- /dev/null +++ b/vendor/sherlodoc/query/dynamic_cost.ml @@ -0,0 +1,30 @@ +module Entry = Db.Entry + +type query = + { name : string list + ; type_paths : Type_distance.t option + } + +let of_query { Query_parser.name; typ } = + let type_paths = + match typ with + | `typ t -> Some (Type_distance.paths_of_type t) + | _ -> None + in + { name; type_paths } + +let type_distance query_type entry = + match query_type, Entry.Kind.get_type entry.Entry.kind with + | Some query_paths, Some entry_type -> + Some (Type_distance.v ~query_paths ~entry:entry_type) + | Some _, None -> Some 1000 + | _ -> None + +let score query entry = + let name_matches = Name_cost.best_matches query.name entry.Db.Entry.name in + let type_cost = + match type_distance query.type_paths entry with + | Some cost -> cost + | None -> 0 + in + 5 * (name_matches + type_cost) diff --git a/vendor/sherlodoc/query/io.ml b/vendor/sherlodoc/query/io.ml new file mode 100644 index 0000000000..a7bc53305c --- /dev/null +++ b/vendor/sherlodoc/query/io.ml @@ -0,0 +1,40 @@ +module type S = sig + (* avoids a dependency on lwt for sherlodoc.js *) + + type 'a t + + val return : 'a -> 'a t + val map : 'a t -> ('a -> 'b) -> 'b t + val bind : 'a t -> ('a -> 'b t) -> 'b t +end + +module Seq (Io : S) = struct + type 'a t = unit -> 'a node Io.t + + and 'a node = + | Nil + | Cons of 'a * 'a t + + let rec of_seq s () = + match s () with + | Seq.Nil -> Io.return Nil + | Cons (x, xs) -> Io.return (Cons (x, of_seq xs)) + + let rec take n xs () = + if n = 0 + then Io.return Nil + else begin + Io.map (xs ()) + @@ function + | Nil -> Nil + | Cons (x, xs) -> Cons (x, take (n - 1) xs) + end + + let rec to_list acc s = + Io.bind (s ()) + @@ function + | Nil -> Io.return (List.rev acc) + | Cons (x, xs) -> to_list (x :: acc) xs + + let to_list s = to_list [] s +end diff --git a/vendor/sherlodoc/query/name_cost.ml b/vendor/sherlodoc/query/name_cost.ml new file mode 100644 index 0000000000..3062473d74 --- /dev/null +++ b/vendor/sherlodoc/query/name_cost.ml @@ -0,0 +1,63 @@ +let rec prefix_at ~case ~sub i s j = + if i >= String.length sub + then Some case + else if sub.[i] = s.[j] + then prefix_at ~case ~sub (i + 1) s (j + 1) + else if sub.[i] = Char.lowercase_ascii s.[j] + then prefix_at ~case:(case + 3) ~sub (i + 1) s (j + 1) + else if Char.lowercase_ascii sub.[i] = s.[j] + then prefix_at ~case:(case + 10) ~sub (i + 1) s (j + 1) + else None + +let prefix_at ~sub s j = prefix_at ~case:0 ~sub 0 s j + +let find_all ~sub s = + let rec go j acc = + if j + String.length sub > String.length s + then acc + else begin + let acc = + match prefix_at ~sub s j with + | None -> acc + | Some cost -> (j, cost) :: acc + in + go (j + 1) acc + end + in + go 0 [] + +let is_substring ~sub s = find_all ~sub s <> [] + +let word_boundary s i = + if i < 0 + then 0 + else if i >= String.length s || List.mem s.[i] [ '.'; '('; ')' ] + then 1 + else if s.[i] = '_' + then 3 + else 10 + +let best_match ?(after = 0) ~sub str = + List.fold_left + (fun acc (i, case_cost) -> + let left = word_boundary str (i - 1) in + let right = word_boundary str (i + String.length sub) / 3 in + let is_after = if i >= after then 0 else 10 in + let cost = case_cost + left + right + is_after in + match acc with + | Some (_, cost') when cost' < cost -> acc + | _ -> Some (i, cost)) + None + (find_all ~sub str) + +let best_matches words str = + let _, found, not_found = + List.fold_left + (fun (i, found, not_found) sub -> + match best_match ~after:i ~sub str with + | Some (i, cost) -> i + String.length sub, found + cost, not_found + | None -> i, found, not_found + String.length sub + 50) + (0, 0, 0) + words + in + found + not_found diff --git a/vendor/sherlodoc/query/priority_queue.ml b/vendor/sherlodoc/query/priority_queue.ml new file mode 100644 index 0000000000..6c38416a0c --- /dev/null +++ b/vendor/sherlodoc/query/priority_queue.ml @@ -0,0 +1,135 @@ +module String_automata = Db.String_automata +module Entry = Db.Entry + +type elt = Entry.t + +type t = + | Empty + | Array of int * elt array + | All of elt * String_automata.t + | Union of elt * t list + +let rec size = function + | Empty -> 0 + | Array (i, arr) -> Array.length arr - i + | All (_, s) -> String_automata.size s + | Union (_, xs) -> List.fold_left (fun acc x -> acc + size x) 0 xs + +let minimum = function + | Empty -> None + | Array (i, arr) -> Some arr.(i) + | All (elt, _) | Union (elt, _) -> Some elt + +let of_sorted_array arr = Array (0, arr) + +let of_automata s = + let elt = String_automata.minimum s in + All (elt, s) + +let of_list lst = + let lst = List.filter (( <> ) Empty) lst in + let min x = + match minimum x with + | None -> assert false + | Some elt -> elt + in + let compare a b = Entry.compare (min a) (min b) in + match List.sort compare lst with + | [] -> Empty + | hd :: _ as lst -> Union (min hd, lst) + +let insert_sort x lst = + match minimum x with + | None -> lst + | Some min_elt -> + let rec insert lst = + match lst with + | [] -> [ x ] + | y :: ys -> begin + match minimum y with + | None -> insert ys + | Some min_y when Entry.compare min_elt min_y <= 0 -> x :: lst + | _ -> y :: insert ys + end + in + insert lst + +let union_with ~min_elt lst = + match List.filter (( <> ) Empty) lst with + | [] -> Empty + | [ t ] -> t + | sorted_lst -> Union (min_elt, sorted_lst) + +let rec union_sorted lst = + match lst with + | [] -> Empty + | [ t ] -> t + | x :: xs -> begin + match minimum x with + | None -> union_sorted xs + | Some min_elt -> Union (min_elt, lst) + end + +let expand_automata ~min_elt ({ String_automata.t; _ } as automata) = + match t.terminals with + | String_automata.Summary arr -> Array (0, arr) + | terminals -> + let terminals = + match terminals with + | String_automata.Empty -> Empty + | Terminals terminals -> Array (0, terminals) + | _ -> assert false + in + let lift child = of_automata { automata with String_automata.t = child } in + let children = + Array.to_list @@ Array.map lift @@ Option.value ~default:[||] t.children + in + let all = insert_sort terminals children in + union_with ~min_elt all + +let rec pop_until cond = function + | Empty -> Empty + | Array (i, arr) as t -> + let rec search i j = + assert (not (cond arr.(i))) ; + assert (cond arr.(j)) ; + let m = (i + j) / 2 in + if i = m then Array (j, arr) else if cond arr.(m) then search i m else search m j + in + let rec search_from j step = + if j >= Array.length arr + then begin + let last = Array.length arr - 1 in + let j_prev = j - (step / 2) in + if cond arr.(last) then search j_prev last else Empty + end + else if cond arr.(j) + then if i = j then t else search (j - (step / 2)) j + else search_from (j + step) (step * 2) + in + search_from i 1 + | All (min_elt, _) as t when cond min_elt -> t + | All (min_elt, automata) -> pop_until cond (expand_automata ~min_elt automata) + | Union (min_elt, _) as t when cond min_elt -> t + | Union (_, lst) -> + let rec pop_union i = function + | [] -> [] + | x :: xs -> + let x' = pop_until cond x in + if x == x' + then begin + assert (i > 0) ; + x :: xs + end + else insert_sort x' (pop_union (i + 1) xs) + in + let lst = pop_union 0 lst in + union_sorted lst + +let pop_lt elt t = + let cmp_lt x = Entry.compare x elt >= 0 in + pop_until cmp_lt t + +let pop_lte elt t = + let cmp_lte x = Entry.compare x elt > 0 in + pop_until cmp_lte t diff --git a/vendor/sherlodoc/query/priority_queue.mli b/vendor/sherlodoc/query/priority_queue.mli new file mode 100644 index 0000000000..24f42d41bb --- /dev/null +++ b/vendor/sherlodoc/query/priority_queue.mli @@ -0,0 +1,10 @@ +type elt = Db.Entry.t +type t + +val minimum : t -> elt option +val of_automata : Db.String_automata.t -> t +val of_sorted_array : elt array -> t +val of_list : t list -> t +val pop_lt : elt -> t -> t +val pop_lte : elt -> t -> t +val size : t -> int diff --git a/vendor/sherlodoc/query/query.ml b/vendor/sherlodoc/query/query.ml new file mode 100644 index 0000000000..e683071127 --- /dev/null +++ b/vendor/sherlodoc/query/query.ml @@ -0,0 +1,116 @@ +module Parser = Query_parser +module Dynamic_cost = Dynamic_cost +module Storage = Db.Storage +module Tree = Db.String_automata + +module Private = struct + module Succ = Succ + + module Type_parser = struct + let of_string str = + let lexbuf = Lexing.from_string str in + Ok (Type_parser.main Type_lexer.token lexbuf) + end +end + +let polarities typ = + List.of_seq + @@ Seq.filter + (fun (word, _count, _) -> String.length word > 0) + (Db.Type_polarity.of_typ ~any_is_poly:false typ) + +let find_types ~shard typ = + let polarities = polarities typ in + Succ.inter_of_list + @@ List.map + (fun (name, count, polarity) -> + let st_occ = + match polarity with + | Db.Type_polarity.Sign.Pos -> shard.Db.db_pos_types + | Neg -> shard.Db.db_neg_types + in + Succ.of_automatas + @@ Db.Occurences.fold + (fun occurrences st acc -> + if occurrences < count + then acc + else begin + let ts = Tree.find_star st name in + List.rev_append ts acc + end) + st_occ + []) + polarities + +let find_names ~shard names = + let names = List.map String.lowercase_ascii names in + let db_names = Db.(shard.db_names) in + let candidates = + List.map + (fun name -> + match Tree.find db_names name with + | Some trie -> Succ.of_automata trie + | None -> Succ.empty) + names + in + Succ.inter_of_list candidates + +let search ~shard { Query_parser.name; typ } = + match name, typ with + | _ :: _, `typ typ -> + let results_name = find_names ~shard name in + let results_typ = find_types ~shard typ in + Succ.inter results_name results_typ + | _ :: _, _ -> find_names ~shard name + | [], `typ typ -> find_types ~shard typ + | [], (`no_typ | `parse_error) -> Succ.empty + +let search ~shards query = + Succ.union_of_list (List.map (fun shard -> search ~shard query) shards) + +type t = + { query : string + ; packages : string list + ; limit : int + } + +let pretty params = Parser.(to_string @@ of_string params.query) + +let match_packages ~packages { Db.Entry.pkg; _ } = + List.exists (String.equal pkg.name) packages + +let match_packages ~packages results = + match packages with + | [] -> results + | _ -> Seq.filter (match_packages ~packages) results + +let search ~shards params = + let query = Parser.of_string params.query in + let results = search ~shards query in + let results = Succ.to_seq results in + query, match_packages ~packages:params.packages results + +module type IO = Io.S + +module Make (Io : IO) = struct + module Tr = Top_results.Make (Io) + + let search ~shards ?(dynamic_sort = true) params = + let limit = params.limit in + let query, results = search ~shards params in + let results = Tr.Seq.of_seq results in + if dynamic_sort + then begin + let query = Dynamic_cost.of_query query in + Tr.of_seq ~query ~limit results + end + else Tr.Seq.to_list @@ Tr.Seq.take limit results +end + +module Blocking = Make (struct + type 'a t = 'a + + let return x = x + let map x f = f x + let bind x f = f x + end) diff --git a/vendor/sherlodoc/query/query.mli b/vendor/sherlodoc/query/query.mli new file mode 100644 index 0000000000..f7f7d78ada --- /dev/null +++ b/vendor/sherlodoc/query/query.mli @@ -0,0 +1,52 @@ +type t = + { query : string + ; packages : string list + ; limit : int + } + +val pretty : t -> string + +module type IO = Io.S + +module Make (Io : IO) : sig + val search : shards:Db.t list -> ?dynamic_sort:bool -> t -> Db.Entry.t list Io.t + (** [search ~shard ~dynamic_sort {query; packages; limit}] returns [(pretty_query, + results)] where [pretty_query] is a re-printed version of [query] and + [results] is the list of results corresponding to the query and the + various parameters. + + - [shards] is a list of databases. [results] is the union of the results of + each database of the list [shards]. If [shards] is a very long list, [api] + might be slow to return, but in some cases you do not have a choice. + Currently, [index] generates only one shard, but it used to generate many + to be able to handle the sheer size of the opam repository. + + - [~dynamic_sort] changes the order of [results]. It is [true] by default, + and is only set to [false] for debugging purposes. + + - [query] is the query string whose shape is a list of space-separated + words, followed by an optionnal [: ...] type annotation that filters the + results by type. The type annotation accepts [_] as a wildcard : [: string + -> _] will return entries that take a [string] as argument, but returns + anything. + + - [limit] is the maximum length of [results]. Having a very large number + might be an issue. + + - [packages] is not function, use [[]] for this argument. *) +end + +module Blocking : sig + val search : shards:Db.t list -> ?dynamic_sort:bool -> t -> Db.Entry.t list +end + +(* val search_lwt : shards:Db.t list -> ?dynamic_sort:bool -> t -> Db.Entry.t list Lwt.t *) + +(** For testing *) +module Private : sig + module Succ = Succ + + module Type_parser : sig + val of_string : string -> (Db.Typexpr.t, string) result + end +end diff --git a/vendor/sherlodoc/query/query_parser.ml b/vendor/sherlodoc/query/query_parser.ml new file mode 100644 index 0000000000..0283842dac --- /dev/null +++ b/vendor/sherlodoc/query/query_parser.ml @@ -0,0 +1,50 @@ +let balance_parens str = + let rec go i open_parens close_parens = + if i >= String.length str + then open_parens, close_parens + else ( + match str.[i] with + | '(' -> go (i + 1) (open_parens + 1) close_parens + | ')' when open_parens > 0 -> go (i + 1) (open_parens - 1) close_parens + | ')' -> go (i + 1) open_parens (close_parens + 1) + | _ -> go (i + 1) open_parens close_parens) + in + let open_parens, close_parens = go 0 0 0 in + String.make close_parens '(' ^ str ^ String.make open_parens ')' + +let type_of_string str = + let str = balance_parens str in + let lexbuf = Lexing.from_string str in + try `typ (Type_parser.main Type_lexer.token lexbuf) with + | _ -> `parse_error + +let naive_of_string str = + List.filter (fun s -> String.length s > 0) (String.split_on_char ' ' str) + +let guess_type_search str = + String.length str >= 1 + && (str.[0] = '\'' || String.contains str '-' || String.contains str '(') + +type t = + { name : string list + ; typ : [ `typ of Db.Typexpr.t | `no_typ | `parse_error ] + } + +let of_string str = + let query_name, typ = + match String.index_opt str ':' with + | None -> if guess_type_search str then "", type_of_string str else str, `no_typ + | Some loc -> + let str_name = String.sub str 0 loc in + let str_typ = String.sub str (loc + 1) (String.length str - loc - 1) in + str_name, type_of_string str_typ + in + let name = naive_of_string query_name in + { name; typ } + +let to_string { name; typ } = + let words = String.concat " " name in + match typ with + | `typ typ -> words ^ " : " ^ Db.Typexpr.show typ + | `parse_error -> words ^ " : " + | `no_typ -> words diff --git a/vendor/sherlodoc/query/query_parser.mli b/vendor/sherlodoc/query/query_parser.mli new file mode 100644 index 0000000000..7c7d1d74a9 --- /dev/null +++ b/vendor/sherlodoc/query/query_parser.mli @@ -0,0 +1,7 @@ +type t = + { name : string list + ; typ : [ `typ of Db.Typexpr.t | `no_typ | `parse_error ] + } + +val of_string : string -> t +val to_string : t -> string diff --git a/vendor/sherlodoc/query/succ.ml b/vendor/sherlodoc/query/succ.ml new file mode 100644 index 0000000000..d258e0450c --- /dev/null +++ b/vendor/sherlodoc/query/succ.ml @@ -0,0 +1,155 @@ +module Entry = Db.Entry + +type elt = Entry.t + +type s = + | Empty + | All + | Pq of Priority_queue.t + | Inter of s * s + | Union of s * s + +type t = + { s : s + ; size : int + } + +let all = { s = All; size = 0 } +let empty = { s = Empty; size = 0 } +let make_pq t = { s = Pq t; size = Priority_queue.size t } +let of_automata t = make_pq (Priority_queue.of_automata t) +let of_automatas ts = make_pq Priority_queue.(of_list (List.map of_automata ts)) +let of_array arr = make_pq (Priority_queue.of_sorted_array arr) + +let inter a b = + match a.s, b.s with + | Empty, _ | _, Empty -> empty + | _, All -> a + | All, _ -> b + | x, y when x == y -> a + | x, y -> + let s = if a.size <= b.size then Inter (x, y) else Inter (y, x) in + { s; size = min a.size b.size } + +let union a b = + match a.s, b.s with + | All, _ | _, All -> all + | _, Empty -> a + | Empty, _ -> b + | x, y when x == y -> a + | x, y -> + let s = if a.size >= b.size then Union (x, y) else Union (y, x) in + { s; size = a.size + b.size } + +let rec join_with fn = function + | [] -> [] + | [ x ] -> [ x ] + | a :: b :: xs -> fn a b :: join_with fn xs + +let rec perfect ~default fn = function + | [] -> default + | [ x ] -> x + | xs -> perfect ~default fn (join_with fn xs) + +let inter_of_list xs = + let xs = List.sort (fun a b -> Int.compare a.size b.size) xs in + perfect ~default:all inter xs + +let union_of_list xs = + let xs = List.sort (fun a b -> Int.compare b.size a.size) xs in + perfect ~default:empty union xs + +type strictness = + | First + | Ge of elt + | Gt of elt + +type result = + | Is_empty + | Is_all + | Found_eq of s + | Found_gt of elt * s + +let rec succ ~strictness t = + match t with + | Empty -> Is_empty + | All -> begin + match strictness with + | First -> Is_all + | Gt _ -> Is_all + | Ge _ -> Found_eq All + end + | Pq pqueue -> begin + let pqueue' = + match strictness with + | First -> pqueue + | Ge elt -> Priority_queue.pop_lt elt pqueue + | Gt elt -> Priority_queue.pop_lte elt pqueue + in + match strictness, Priority_queue.minimum pqueue' with + | _, None -> Is_empty + | Ge elt, Some e when Db.Entry.equal e elt -> Found_eq (Pq pqueue') + | _, Some e -> Found_gt (e, Pq pqueue') + end + | Union (l, r) -> begin + match succ ~strictness l with + | Is_empty -> succ ~strictness r + | Is_all -> failwith "union all" + | Found_eq l -> Found_eq (Union (l, r)) + | Found_gt (elt_l, l') -> begin + match succ ~strictness r with + | Is_empty -> Found_gt (elt_l, l') + | Is_all -> failwith "union all" + | Found_eq r' -> Found_eq (Union (l', r')) + | Found_gt (elt_r, r') when Db.Entry.compare elt_l elt_r <= 0 -> + Found_gt (elt_l, Union (l', r')) + | Found_gt (elt_r, r') -> Found_gt (elt_r, Union (l', r')) + end + end + | Inter (l, r) -> begin + match succ ~strictness l with + | Is_empty -> Is_empty + | Is_all -> failwith "inter all" + | Found_eq l' -> begin + match succ ~strictness r with + | Is_empty -> Is_empty + | Is_all -> failwith "inter all" + | Found_eq r' -> Found_eq (Inter (l', r')) + | Found_gt (elt, r') -> Found_gt (elt, Inter (l', r')) + end + | Found_gt (elt, l') -> Found_gt (elt, Inter (l', r)) + end + +let rec succ_loop ?(count = 0) ~strictness t = + match strictness, succ ~strictness t with + | _, Is_empty -> None + | _, Is_all -> None + | Ge elt, Found_eq t -> Some (elt, t) + | _, Found_gt (elt, t) -> succ_loop ~count:(count + 1) ~strictness:(Ge elt) t + | _ -> assert false + +let first t = succ_loop ~strictness:First t + +let seq_of_dispenser fn = + let rec go () = + match fn () with + | None -> Seq.Nil + | Some x -> Seq.Cons (x, go) + in + go + +let to_seq { s = t; _ } = + let state = ref None in + let loop () = + let result = + match !state with + | None -> first t + | Some (previous_elt, t) -> succ_loop ~strictness:(Gt previous_elt) t + in + match result with + | None -> None + | Some (elt, _) -> + state := result ; + Some elt + in + seq_of_dispenser loop diff --git a/vendor/sherlodoc/query/succ.mli b/vendor/sherlodoc/query/succ.mli new file mode 100644 index 0000000000..cfd9df7008 --- /dev/null +++ b/vendor/sherlodoc/query/succ.mli @@ -0,0 +1,14 @@ +(** This module provides a way to get the first n elements of a very large set + without computing the whole list of elements. *) + +type t + +val to_seq : t -> Db.Entry.t Seq.t +val empty : t +val of_automata : Db.String_automata.t -> t +val of_automatas : Db.String_automata.t list -> t +val inter : t -> t -> t +val union : t -> t -> t +val inter_of_list : t list -> t +val union_of_list : t list -> t +val of_array : Db.Entry.t array -> t diff --git a/vendor/sherlodoc/query/test/dune b/vendor/sherlodoc/query/test/dune new file mode 100644 index 0000000000..46d89d810c --- /dev/null +++ b/vendor/sherlodoc/query/test/dune @@ -0,0 +1,3 @@ +(test + (name test) + (libraries alcotest query)) diff --git a/vendor/sherlodoc/query/test/test.ml b/vendor/sherlodoc/query/test/test.ml new file mode 100644 index 0000000000..11fcf5cf4b --- /dev/null +++ b/vendor/sherlodoc/query/test/test.ml @@ -0,0 +1,3 @@ +let () = + let open Alcotest in + run "Query" [ "Succ", Test_succ.tests_to_seq; "Type_parser", Test_type_parser.tests ] diff --git a/vendor/sherlodoc/query/test/test_succ.ml b/vendor/sherlodoc/query/test/test_succ.ml new file mode 100644 index 0000000000..3650a52f34 --- /dev/null +++ b/vendor/sherlodoc/query/test/test_succ.ml @@ -0,0 +1,62 @@ +open Query.Private + +let pkg = Db.Entry.Package.v ~name:"" ~version:"" + +let elt cost = + Db.Entry.v ~cost ~name:"" ~kind:Db.Entry.Kind.Doc ~rhs:None ~doc_html:"" ~url:"" ~pkg () + +(** This module does the same thing as Succ, but its correctness is obvious + and its performance terrible. *) +module Reference = struct + include Set.Make (Db.Entry) + + let of_array arr = arr |> Array.to_seq |> of_seq +end + +(** This module is used to construct a pair of a "set array" using [Reference] + and a Succ that are exactly the same. *) +module Both = struct + let empty = Reference.empty, Succ.empty + let union (l, l') (r, r') = Reference.union l r, Succ.union l' r' + let inter (l, l') (r, r') = Reference.inter l r, Succ.inter l' r' + let of_array arr = Reference.of_array arr, Succ.of_array arr +end + +(** This is a problematic exemple that was found randomly. It is saved here + to check for regressions. *) +let extra_succ = + let open Both in + let of_array arr = Both.of_array (Array.map elt arr) in + union + (inter (of_array [| 0; 1 |]) (of_array [| 0; 1 |])) + (inter (of_array [| 0; 2; 3 |]) (of_array [| 1; 3; 5; 7 |])) + +let random_array size = + List.init size (fun _ -> elt @@ Random.int (size * 2)) + |> List.sort_uniq Db.Entry.compare + |> Array.of_list + +let rec random_set ~empty ~union ~inter ~of_array size = + let random_set = random_set ~empty ~union ~inter ~of_array in + if size = 0 + then empty + else ( + match Random.int 3 with + | 0 -> of_array @@ random_array size + | 1 -> inter (random_set (size / 2)) (random_set (size / 2)) + | 2 -> union (random_set (size / 2)) (random_set (size / 2)) + | _ -> assert false) + +let to_costs lst = List.map (fun e -> e.Db.Entry.cost) (List.of_seq lst) + +let test_to_seq tree () = + let ref = fst tree |> Reference.to_seq |> to_costs in + let real = snd tree |> Succ.to_seq |> to_costs in + Alcotest.(check (list int)) "same int list" ref real + +let tests_to_seq = + [ Alcotest.test_case "Succ.to_seq extra" `Quick (test_to_seq extra_succ) ] + @ List.init 50 (fun i -> + let i = i * 7 in + let succ = i |> Both.(random_set ~empty ~union ~inter ~of_array) in + Alcotest.test_case (Printf.sprintf "Succ.to_seq size %i" i) `Quick (test_to_seq succ)) diff --git a/vendor/sherlodoc/query/test/test_type_parser.ml b/vendor/sherlodoc/query/test/test_type_parser.ml new file mode 100644 index 0000000000..9835dc84e6 --- /dev/null +++ b/vendor/sherlodoc/query/test/test_type_parser.ml @@ -0,0 +1,38 @@ +open Db.Typexpr + +let random_elt arr = arr.(Random.int (Array.length arr)) +let random_poly () = Poly (random_elt [| "a"; "b"; "c"; "d"; "e" |]) + +let random_constr () = + Constr (random_elt [| "float"; "int"; "string"; "foo"; "bar"; "t" |], []) + +let rec random_type size = + match size with + | 0 | 1 -> random_elt [| random_poly; random_constr; (fun () -> Any) |] () + | (2 | 3 | 4) when Random.bool () -> random_constr_params size + | _ when Random.int 100 < 20 -> + let n = 2 + Random.int 3 in + tuple (List.init n (fun _i -> random_type (size / n))) + | _ when Random.int 100 < 5 -> random_constr_params size + | _ -> + let size = size / 2 in + Arrow (random_type size, random_type size) + +and random_constr_params size = + let n_params = 1 + Random.int 3 in + let name = random_elt [| "list"; "option"; "t"; "result"; "array" |] in + Constr (name, List.init n_params (fun _i -> random_type (size / n_params))) + +open Query.Private + +let test_parser typ () = + let str = Db.Typexpr.show typ in + let typ' = Type_parser.of_string str in + let str' = Result.map Db.Typexpr.show typ' in + Alcotest.(check (result string string)) "same string" (Ok str) str' + +let tests = + List.init 50 (fun i -> + let i = i * 5 in + let typ = random_type i in + Alcotest.test_case (Printf.sprintf "Type_parser size %i" i) `Quick (test_parser typ)) diff --git a/vendor/sherlodoc/query/top_results.ml b/vendor/sherlodoc/query/top_results.ml new file mode 100644 index 0000000000..60287b357f --- /dev/null +++ b/vendor/sherlodoc/query/top_results.ml @@ -0,0 +1,57 @@ +module Bests = Set.Make (Db.Entry) + +type t = + { size : int + ; bests : Bests.t + } + +let empty = { size = 0; bests = Bests.empty } + +type step = + | Continue of t + | Stop of t + +let update_entry query entry = + let extra_cost = Dynamic_cost.score query entry in + Db.Entry.{ entry with cost = entry.cost + extra_cost } + +let add ~query ~limit elt t = + if t.size < limit + then begin + let elt = update_entry query elt in + Continue { size = t.size + 1; bests = Bests.add elt t.bests } + end + else begin + let worst = Bests.max_elt t.bests in + if Db.Entry.(elt.cost > worst.cost) + then Stop t + else begin + let elt = update_entry query elt in + if Db.Entry.(elt.cost > worst.cost) + then Continue t + else Continue { t with bests = Bests.add elt @@ Bests.remove worst t.bests } + end + end + +let max_seek = 10 + +module Make (IO : Io.S) = struct + module Seq = Io.Seq (IO) + + let of_seq ~query ~limit seq = + let rec go total_seen t seq = + if total_seen >= limit + max_seek + then IO.return t + else begin + IO.bind (seq ()) + @@ function + | Seq.Nil -> IO.return t + | Cons (x, xs) -> begin + match add ~query ~limit x t with + | Stop t -> IO.return t + | Continue t -> go (total_seen + 1) t xs + end + end + in + IO.map (go 0 empty seq) @@ fun t -> List.of_seq @@ Bests.to_seq t.bests +end diff --git a/vendor/sherlodoc/query/top_results.mli b/vendor/sherlodoc/query/top_results.mli new file mode 100644 index 0000000000..a1533763a8 --- /dev/null +++ b/vendor/sherlodoc/query/top_results.mli @@ -0,0 +1,9 @@ +module Make (IO : Io.S) : sig + module Seq : module type of Io.Seq (IO) + + val of_seq + : query:Dynamic_cost.query + -> limit:int + -> Db.Entry.t Seq.t + -> Db.Entry.t list IO.t +end diff --git a/vendor/sherlodoc/query/type_distance.ml b/vendor/sherlodoc/query/type_distance.ml new file mode 100644 index 0000000000..72e414e7fd --- /dev/null +++ b/vendor/sherlodoc/query/type_distance.ml @@ -0,0 +1,172 @@ +type step = + | Type of string + | Poly + | Any + | Arrow_left + | Arrow_right + | Product of + { pos : int + ; length : int + } + | Argument of + { pos : int + ; length : int + } + +module Sign = Db.Type_polarity.Sign + +type t = step list list + +let rev_concat lst = List.fold_left (fun acc xs -> List.rev_append xs acc) [] lst + +let rec paths_of_type ~prefix t = + match t with + | Db.Typexpr.Poly _ -> [ Poly :: prefix ] + | Any -> [ Any :: prefix ] + | Arrow (a, b) -> + let prefix_left = Arrow_left :: prefix in + let prefix_right = Arrow_right :: prefix in + List.rev_append + (paths_of_type ~prefix:prefix_left a) + (paths_of_type ~prefix:prefix_right b) + | Constr (name, args) -> + let prefix = Type name :: prefix in + begin + match args with + | [] -> [ prefix ] + | _ -> + let length = List.length args in + rev_concat + @@ List.mapi + (fun i arg -> + let prefix = Argument { pos = i; length } :: prefix in + paths_of_type ~prefix arg) + args + end + | Tuple args -> + let length = List.length args in + rev_concat + @@ List.mapi (fun i arg -> + let prefix = Product { pos = i; length } :: prefix in + paths_of_type ~prefix arg) + @@ args + | Unhandled -> [] + +let paths_of_type t = List.map List.rev @@ paths_of_type ~prefix:[] t + +(* *) + +let skip_entry _ = 10 + +let distance xs ys = + let len_xs = List.length xs in + let len_ys = List.length ys in + let cache = Array.make_matrix (1 + len_xs) (1 + len_ys) (-1) in + let inv = Db.Type_polarity.Sign.not in + let rec memo ~xsgn ~ysgn i j xs ys = + let r = cache.(i).(j) in + if r >= 0 + then r + else begin + let r = go ~xsgn ~ysgn i j xs ys in + cache.(i).(j) <- r ; + r + end + and go ~xsgn ~ysgn i j xs ys = + match xs, ys with + | [], [] -> 0 + | [], _ -> 0 + | [ Any ], _ when xsgn = ysgn -> 0 + | [ Poly ], [ (Any | Poly) ] when xsgn = ysgn -> 0 + | Arrow_left :: xs, Arrow_left :: ys -> + memo ~xsgn:(inv xsgn) ~ysgn:(inv ysgn) (i + 1) (j + 1) xs ys + | x :: xs, y :: ys when x = y && xsgn = ysgn -> memo ~xsgn ~ysgn (i + 1) (j + 1) xs ys + | _, Arrow_left :: ys -> 1 + memo ~xsgn ~ysgn:(inv ysgn) i (j + 1) xs ys + | Arrow_left :: xs, _ -> 1 + memo ~xsgn:(inv xsgn) ~ysgn (i + 1) j xs ys + | _, Arrow_right :: ys -> memo ~xsgn ~ysgn i (j + 1) xs ys + | Arrow_right :: xs, _ -> memo ~xsgn ~ysgn (i + 1) j xs ys + | _, [] -> 10_000 + | Product _ :: xs, Product _ :: ys -> 1 + memo ~xsgn ~ysgn (i + 1) (j + 1) xs ys + | Argument _ :: xs, Argument _ :: ys -> 1 + memo ~xsgn ~ysgn (i + 1) (j + 1) xs ys + | Product _ :: xs, ys -> 1 + memo ~xsgn ~ysgn (i + 1) j xs ys + | xs, Product _ :: ys -> 1 + memo ~xsgn ~ysgn i (j + 1) xs ys + | Type x :: xs', Type y :: ys' when xsgn = ysgn -> begin + let skip_y = skip_entry y in + match Name_cost.best_match ~sub:x y with + | None -> skip_y + memo ~xsgn ~ysgn i (j + 1) xs ys' + | Some (_, cost) -> (cost / 3) + memo ~xsgn ~ysgn (i + 1) (j + 1) xs' ys' + end + | xs, Type y :: ys' -> skip_entry y + memo ~xsgn ~ysgn i (j + 1) xs ys' + | xs, Argument _ :: ys' -> memo ~xsgn ~ysgn i (j + 1) xs ys' + | _, (Any | Poly) :: _ -> 10_000 + in + let pos = Db.Type_polarity.Sign.Pos in + go ~xsgn:pos ~ysgn:pos 0 0 xs ys + +let minimize = function + | [] -> 0 + | arr -> + let used = Array.make (List.length (List.hd arr)) false in + let arr = + Array.map (fun lst -> + let lst = List.mapi (fun i x -> x, i) lst in + List.sort Stdlib.compare lst) + @@ Array.of_list arr + in + Array.sort (fun xs ys -> Stdlib.compare xs ys) arr ; + let heuristics = Array.make (Array.length arr + 1) 0 in + for i = Array.length heuristics - 2 downto 0 do + let best = fst (List.hd arr.(i)) in + heuristics.(i) <- heuristics.(i + 1) + best + done ; + let best = ref 1000 in + let limit = ref 0 in + let rec go rem acc i = + incr limit ; + if !limit > 10_000 + then false + else if rem <= 0 + then begin + (* entry type is smaller than query type *) + let score = acc + (1000 * (Array.length arr - i)) in + best := min score !best ; + true + end + else if i >= Array.length arr + then begin + (* query type is smaller than entry type *) + let score = acc + (5 * rem) in + best := min score !best ; + true + end + else if acc + heuristics.(i) >= !best + then true + else begin + let rec find = function + | [] -> true + | (cost, j) :: rest -> + let continue = + if used.(j) + then true + else begin + used.(j) <- true ; + let continue = go (rem - 1) (acc + cost) (i + 1) in + used.(j) <- false ; + continue + end + in + if continue then find rest else false + in + find arr.(i) + end + in + let _ = go (Array.length used) 0 0 in + !best + +let v ~query_paths ~entry = + let entry_paths = paths_of_type entry in + match entry_paths, query_paths with + | _, [] | [], _ -> 0 + | _ -> + let arr = List.map (fun p -> List.map (distance p) entry_paths) query_paths in + minimize arr diff --git a/vendor/sherlodoc/query/type_distance.mli b/vendor/sherlodoc/query/type_distance.mli new file mode 100644 index 0000000000..ab97edef37 --- /dev/null +++ b/vendor/sherlodoc/query/type_distance.mli @@ -0,0 +1,8 @@ +type t + +val paths_of_type : Db.Typexpr.t -> t + +val v : query_paths:t -> entry:Db.Typexpr.t -> int +(** [Type_distance.v ~query_paths ~entry] is an integer representing a notion of + distance between two types. [query_paths] is a type from a query, and [entry] is + the type of a possible candidate for this query. *) diff --git a/vendor/sherlodoc/query/type_lexer.mll b/vendor/sherlodoc/query/type_lexer.mll new file mode 100644 index 0000000000..e0d197ae85 --- /dev/null +++ b/vendor/sherlodoc/query/type_lexer.mll @@ -0,0 +1,15 @@ +{ + open Type_parser +} + +rule token = parse +| ' ' { token lexbuf } +| "-" | "->" { ARROW } (* minus sign is interpreted as an arrow to support partially written queries *) +| "(" { PARENS_OPEN } +| ")" { PARENS_CLOSE } +| "," { COMMA } +| '_' { ANY } +| '*' { STAR } +| "'" (['a'-'z' 'A'-'Z' '0'-'9' '\'' '_']* as p) { POLY p } +| ['a'-'z' 'A'-'Z' '0'-'9' '\'' '_' '.']+ as w { WORD w } +| eof { EOF } diff --git a/vendor/sherlodoc/query/type_parser.mly b/vendor/sherlodoc/query/type_parser.mly new file mode 100644 index 0000000000..7e4528051d --- /dev/null +++ b/vendor/sherlodoc/query/type_parser.mly @@ -0,0 +1,60 @@ +(* Type expressions parser, with error correction + to support incomplete / partially written user queries. *) + +%{ + module Printf = struct + (* Without the following placeholder, [menhir_fail] induces + a large dependency to [camlinternalFormat] in the js bundle. *) + let eprintf _ = () + end + + open Db.Typexpr +%} + +%token EOF +%token PARENS_OPEN PARENS_CLOSE +%token ARROW COMMA ANY STAR +%token WORD +%token POLY + +%start main +%type main + +%% + +main: + | t=typ EOF { t } + ; + +typ: + | t=typ2 { t } + | a=typ2 ARROW b=typ { Arrow (a, b) } + ; + +typ2: + | xs=list1(typ1, STAR) { tuple xs } + ; + +typ1: + | { Any } + | ts=typs { tuple ts } + | ts=typs w=WORD ws=list(WORD) { + List.fold_left (fun acc w -> Constr (w, [acc])) (Constr (w, ts)) ws + } + ; + +typ0: + | ANY { Any } + | w=POLY { Poly w } + | w=WORD { Constr (w, []) } + ; + +typs: + | t=typ0 { [t] } + | PARENS_OPEN ts=list1(typ, COMMA) PARENS_CLOSE { ts } + ; + +list1(term, separator): + | x=term { [x] } + | x=term separator xs=list1(term, separator) { x::xs } + ; diff --git a/vendor/sherlodoc/sherlodoc.opam b/vendor/sherlodoc/sherlodoc.opam new file mode 100644 index 0000000000..46be9538fc --- /dev/null +++ b/vendor/sherlodoc/sherlodoc.opam @@ -0,0 +1,48 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.2" +synopsis: "Search engine for OCaml documentation" +maintainer: ["art.wendling@gmail.com"] +authors: ["Arthur Wendling" "Emile Trotignon"] +license: "MIT" +homepage: "https://github.com/art-w/sherlodoc" +bug-reports: "https://github.com/art-w/sherlodoc/issues" +depends: [ + "dune" {>= "3.5"} + "ocaml" {>= "4.0.8"} + "odoc" {>= "3.0.0"} + "base64" {>= "3.5.1"} + "bigstringaf" {>= "0.9.1"} + "js_of_ocaml" {>= "5.6.0"} + "brr" {>= "0.0.6"} + "cmdliner" {>= "1.2.0"} + "decompress" {>= "1.5.3"} + "fpath" {>= "0.7.3"} + "lwt" {>= "5.7.0"} + "menhir" {>= "20230608"} + "ppx_blob" {>= "0.7.2"} + "tyxml" {>= "4.6.0"} + "result" {>= "1.5"} + "odig" {with-test} + "base" {with-test & = "v0.16.3"} + "alcotest" {with-test} +] +depopts: [ + "dream" {>= "1.0.0~alpha5"} + "ancient" {>= "0.9.1"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/art-w/sherlodoc.git" diff --git a/vendor/sherlodoc/store/db_store.default.ml b/vendor/sherlodoc/store/db_store.default.ml new file mode 100644 index 0000000000..36fb89cb73 --- /dev/null +++ b/vendor/sherlodoc/store/db_store.default.ml @@ -0,0 +1,12 @@ +type db_format = + [ `ancient + | `marshal + | `js + ] + +let available_backends = [ "marshal", `marshal; "js", `js ] + +let storage_module = function + | `marshal -> (module Storage_marshal : Db.Storage.S) + | `js -> (module Storage_js : Db.Storage.S) + | `ancient -> failwith "ancient is unsupported" diff --git a/vendor/sherlodoc/store/db_store.with_ancient.ml b/vendor/sherlodoc/store/db_store.with_ancient.ml new file mode 100644 index 0000000000..344dae6eef --- /dev/null +++ b/vendor/sherlodoc/store/db_store.with_ancient.ml @@ -0,0 +1,12 @@ +type db_format = + [ `ancient + | `marshal + | `js + ] + +let available_backends = [ "ancient", `ancient; "marshal", `marshal; "js", `js ] + +let storage_module = function + | `ancient -> (module Storage_ancient : Db.Storage.S) + | `marshal -> (module Storage_marshal : Db.Storage.S) + | `js -> (module Storage_js : Db.Storage.S) diff --git a/vendor/sherlodoc/store/dune b/vendor/sherlodoc/store/dune new file mode 100644 index 0000000000..d138d9cc78 --- /dev/null +++ b/vendor/sherlodoc/store/dune @@ -0,0 +1,27 @@ +(library + (name db_store) + (modules db_store) + (libraries + storage_marshal + storage_js + (select + db_store.ml + from + (storage_ancient -> db_store.with_ancient.ml) + (!storage_ancient -> db_store.default.ml)))) + +(library + (name storage_ancient) + (modules storage_ancient) + (optional) + (libraries db ancient unix)) + +(library + (name storage_js) + (modules storage_js) + (libraries db base64 bigstringaf decompress.zl)) + +(library + (name storage_marshal) + (modules storage_marshal) + (libraries db)) diff --git a/vendor/sherlodoc/store/storage_ancient.ml b/vendor/sherlodoc/store/storage_ancient.ml new file mode 100644 index 0000000000..beb07b13c7 --- /dev/null +++ b/vendor/sherlodoc/store/storage_ancient.ml @@ -0,0 +1,45 @@ +let base_addr () = + if Sys.word_size > 32 + then Int64.to_nativeint 0x100000000000L + else failwith "TODO: support ancient on 32 bits" + +type writer = + { mutable write_shard : int + ; ancient : Ancient.md + } + +let open_out filename = + let handle = Unix.openfile filename Unix.[ O_RDWR; O_TRUNC; O_CREAT ] 0o640 in + let ancient = Ancient.attach handle (base_addr ()) in + { write_shard = 0; ancient } + +let save ~db (t : Db.t) = + ignore (Ancient.share db.ancient db.write_shard t) ; + db.write_shard <- db.write_shard + 1 + +let close_out db = Ancient.detach db.ancient + +type reader = { shards : Db.t array } + +let load_shard md shard = + match Ancient.get md shard with + | t -> Some (Ancient.follow t) + | exception _ -> None + +let load_shards md = + let rec go i = + match load_shard md i with + | None -> [] + | Some t -> t :: go (i + 1) + in + Array.of_list (go 0) + +let db_open_in db : reader = + let filename = db in + let handle = Unix.openfile filename Unix.[ O_RDWR ] 0o640 in + let md = Ancient.attach handle (base_addr ()) in + { shards = load_shards md } + +let load db_filename = + let h = db_open_in db_filename in + Array.to_list h.shards diff --git a/vendor/sherlodoc/store/storage_ancient.mli b/vendor/sherlodoc/store/storage_ancient.mli new file mode 100644 index 0000000000..bf1293dcd8 --- /dev/null +++ b/vendor/sherlodoc/store/storage_ancient.mli @@ -0,0 +1 @@ +include Db.Storage.S diff --git a/vendor/sherlodoc/store/storage_js.ml b/vendor/sherlodoc/store/storage_js.ml new file mode 100644 index 0000000000..11f8122438 --- /dev/null +++ b/vendor/sherlodoc/store/storage_js.ml @@ -0,0 +1,32 @@ +type writer = out_channel + +let open_out = open_out +let close_out = close_out + +let deflate_string ?(level = 4) str = + let i = De.bigstring_create De.io_buffer_size in + let o = De.bigstring_create De.io_buffer_size in + let w = De.Lz77.make_window ~bits:15 in + let q = De.Queue.create 0x1000 in + let r = Buffer.create 0x1000 in + let p = ref 0 in + let refill buf = + let len = min (String.length str - !p) De.io_buffer_size in + Bigstringaf.blit_from_string str ~src_off:!p buf ~dst_off:0 ~len ; + p := !p + len ; + len + in + let flush buf len = + let str = Bigstringaf.substring buf ~off:0 ~len in + Buffer.add_string r str + in + Zl.Higher.compress ~level ~dynamic:true ~w ~q ~refill ~flush i o ; + Buffer.contents r + +let save ~db t = + let str = Marshal.to_string t [] in + let str = deflate_string str in + let str = Base64.encode_string str in + Printf.fprintf db "function sherlodoc_db () { return %S; }\n%!" str + +let load _ = failwith "js database format is unsupported" diff --git a/vendor/sherlodoc/store/storage_js.mli b/vendor/sherlodoc/store/storage_js.mli new file mode 100644 index 0000000000..bf1293dcd8 --- /dev/null +++ b/vendor/sherlodoc/store/storage_js.mli @@ -0,0 +1 @@ +include Db.Storage.S diff --git a/vendor/sherlodoc/store/storage_marshal.ml b/vendor/sherlodoc/store/storage_marshal.ml new file mode 100644 index 0000000000..6f913a0947 --- /dev/null +++ b/vendor/sherlodoc/store/storage_marshal.ml @@ -0,0 +1,11 @@ +type writer = out_channel + +let open_out = open_out +let close_out = close_out +let save ~db t = Marshal.to_channel db t [] + +let load name = + let file = open_in name in + let t = Marshal.from_channel file in + close_in file ; + [ t ] diff --git a/vendor/sherlodoc/store/storage_marshal.mli b/vendor/sherlodoc/store/storage_marshal.mli new file mode 100644 index 0000000000..bf1293dcd8 --- /dev/null +++ b/vendor/sherlodoc/store/storage_marshal.mli @@ -0,0 +1 @@ +include Db.Storage.S diff --git a/vendor/sherlodoc/test/cram/base_benchmark.t b/vendor/sherlodoc/test/cram/base_benchmark.t new file mode 100644 index 0000000000..efbc168d07 --- /dev/null +++ b/vendor/sherlodoc/test/cram/base_benchmark.t @@ -0,0 +1,4 @@ +This test will fail, it is not deterministic. Please just check that the values +are not crazy and discard the changes + $ ODOCLS=$(find ../docs/odoc/base/ -name '*.odocl' | grep -v "__") + $ sherlodoc index --format=js --db=db.js $ODOCLS diff --git a/vendor/sherlodoc/test/cram/base_cli.t b/vendor/sherlodoc/test/cram/base_cli.t new file mode 100644 index 0000000000..011a36a90d --- /dev/null +++ b/vendor/sherlodoc/test/cram/base_cli.t @@ -0,0 +1,296 @@ + $ ODOCLS=$(find ../docs/odoc/base/ -name '*.odocl' | grep -v "__") + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index --index-docstring=false $ODOCLS + $ sherlodoc search --print-cost --limit 100 "S_poly" + 200 sig Base.Map.S_poly + 200 sig Base.Set.S_poly + 204 sig Base.Hashtbl.S_poly + 248 type 'a Base.Hashtbl.S_poly.key = 'a + 257 type ('a, 'b) Base.Map.S_poly.t + 257 type 'elt Base.Set.S_poly.t + 259 type ('a, 'cmp) Base.Set.S_poly.set + 260 val Base.Set.S_poly.mem : 'a t -> 'a -> bool + 260 type ('a, 'b) Base.Map.S_poly.tree + 260 type 'elt Base.Set.S_poly.tree + 261 type ('a, 'b) Base.Hashtbl.S_poly.t + 261 mod Base.Set.S_poly.Named + 267 val Base.Hashtbl.S_poly.data : (_, 'b) t -> 'b list + 271 val Base.Hashtbl.S_poly.keys : ('a, _) t -> 'a key list + 274 type Base.Map.S_poly.comparator_witness + 274 type Base.Set.S_poly.comparator_witness + 277 val Base.Set.S_poly.map : ('a, _) set -> f:('a -> 'b) -> 'b t + 277 val Base.Hashtbl.S_poly.find_exn : ('a, 'b) t -> 'a key -> 'b + 278 val Base.Hashtbl.S_poly.choose_exn : ('a, 'b) t -> 'a key * 'b + 280 val Base.Hashtbl.S_poly.find : ('a, 'b) t -> 'a key -> 'b option + 283 val Base.Hashtbl.S_poly.choose : ('a, 'b) t -> ('a key * 'b) option + 283 val Base.Hashtbl.S_poly.to_alist : ('a, 'b) t -> ('a key * 'b) list + 283 mod Base.Map.S_poly.Make_applicative_traversals + 286 val Base.Hashtbl.S_poly.map : ('a, 'b) t -> f:('b -> 'c) -> ('a, 'c) t + 287 val Base.Hashtbl.S_poly.map_inplace : (_, 'b) t -> f:('b -> 'b) -> unit + 287 val Base.Hashtbl.S_poly.remove_multi : ('a, _ list) t -> 'a key -> unit + 289 val Base.Hashtbl.S_poly.set : ('a, 'b) t -> key:'a key -> data:'b -> unit + 289 val Base.Hashtbl.S_poly.find_multi : ('a, 'b list) t -> 'a key -> 'b list + 291 val Base.Hashtbl.S_poly.find_and_remove : ('a, 'b) t -> 'a key -> 'b option + 300 val Base.Hashtbl.S_poly.update : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> unit + 300 val Base.Hashtbl.S_poly.add_multi : ('a, 'b list) t -> key:'a key -> data:'b -> unit + 300 val Base.Hashtbl.S_poly.filter_map : ('a, 'b) t -> f:('b -> 'c option) -> ('a, 'c) t + 301 val Base.Hashtbl.S_poly.filter_map_inplace : (_, 'b) t -> f:('b -> 'b option) -> unit + 301 val Base.Hashtbl.S_poly.filter_keys_inplace : ('a, _) t -> f:('a key -> bool) -> unit + 302 val Base.Hashtbl.S_poly.equal : ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + 303 val Base.Hashtbl.S_poly.iteri : ('a, 'b) t -> f:(key:'a key -> data:'b -> unit) -> unit + 304 val Base.Hashtbl.S_poly.find_or_add : ('a, 'b) t -> 'a key -> default:(unit -> 'b) -> 'b + 305 val Base.Hashtbl.S_poly.add : ('a, 'b) t -> key:'a key -> data:'b -> [ `Ok | `Duplicate ] + 306 val Base.Hashtbl.S_poly.mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c) -> ('a, 'c) t + 307 val Base.Hashtbl.S_poly.change : ('a, 'b) t -> 'a key -> f:('b option -> 'b option) -> unit + 307 val Base.Hashtbl.S_poly.findi_or_add : ('a, 'b) t -> 'a key -> default:('a key -> 'b) -> 'b + 309 val Base.Hashtbl.S_poly.update_and_return : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> 'b + 310 val Base.Hashtbl.S_poly.partition_tf : ('a, 'b) t -> f:('b -> bool) -> ('a, 'b) t * ('a, 'b) t + 311 val Base.Hashtbl.S_poly.incr : ?by:int -> ?remove_if_zero:bool -> ('a, int) t -> 'a key -> unit + 319 val Base.Hashtbl.S_poly.choose_randomly_exn : ?random_state:Random.State.t -> ('a, 'b) t -> 'a key * 'b + 320 val Base.Hashtbl.S_poly.filter_mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c option) -> ('a, 'c) t + 323 val Base.Hashtbl.S_poly.fold : ('a, 'b) t -> init:'acc -> f:(key:'a key -> data:'b -> 'acc -> 'acc) -> 'acc + 324 val Base.Hashtbl.S_poly.partition_map : ('a, 'b) t -> f:('b -> ('c, 'd) Either.t) -> ('a, 'c) t * ('a, 'd) t + 324 val Base.Hashtbl.S_poly.choose_randomly : ?random_state:Random.State.t -> ('a, 'b) t -> ('a key * 'b) option + 330 val Base.Hashtbl.S_poly.partitioni_tf : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> ('a, 'b) t * ('a, 'b) t + 344 val Base.Hashtbl.S_poly.find_and_call : ('a, 'b) t -> + 'a key -> + if_found:('b -> 'c) -> + if_not_found:('a key -> 'c) -> + 'c + 348 val Base.Set.S_poly.empty : 'a t + 348 val Base.Hashtbl.S_poly.partition_mapi : ('a, 'b) t -> + f:(key:'a key -> data:'b -> ('c, 'd) Either.t) -> + ('a, 'c) t * ('a, 'd) t + 353 val Base.Map.S_poly.empty : ('k, _) t + 355 val Base.Set.S_poly.length : _ t -> int + 358 val Base.Set.S_poly.is_empty : _ t -> bool + 358 val Base.Set.S_poly.singleton : 'a -> 'a t + 359 val Base.Set.S_poly.choose_exn : 'a t -> 'a + 360 val Base.Set.S_poly.add : 'a t -> 'a -> 'a t + 360 val Base.Map.S_poly.length : (_, _) t -> int + 360 val Base.Set.S_poly.max_elt_exn : 'a t -> 'a + 360 val Base.Set.S_poly.min_elt_exn : 'a t -> 'a + 361 val Base.Set.S_poly.of_list : 'a list -> 'a t + 361 val Base.Set.S_poly.of_tree : 'a tree -> 'a t + 361 val Base.Set.S_poly.to_list : 'a t -> 'a list + 361 val Base.Set.S_poly.to_tree : 'a t -> 'a tree + 361 val Base.Set.S_poly.invariants : 'a t -> bool + 362 val Base.Set.S_poly.choose : 'a t -> 'a option + 362 val Base.Set.S_poly.elements : 'a t -> 'a list + 362 val Base.Hashtbl.S_poly.merge_into : src:('k, 'a) t -> + dst:('k, 'b) t -> + f:(key:'k key -> 'a -> 'b option -> 'b Merge_into_action.t) -> + unit + 363 val Base.Map.S_poly.data : (_, 'v) t -> 'v list + 363 val Base.Map.S_poly.keys : ('k, _) t -> 'k list + 363 val Base.Set.S_poly.diff : 'a t -> 'a t -> 'a t + 363 val Base.Set.S_poly.remove : 'a t -> 'a -> 'a t + 363 val Base.Set.S_poly.max_elt : 'a t -> 'a option + 363 val Base.Set.S_poly.min_elt : 'a t -> 'a option + 363 val Base.Map.S_poly.is_empty : (_, _) t -> bool + 363 val Base.Set.S_poly.of_array : 'a array -> 'a t + 363 val Base.Set.S_poly.to_array : 'a t -> 'a array + 364 val Base.Set.S_poly.equal : 'a t -> 'a t -> bool + 364 val Base.Set.S_poly.inter : 'a t -> 'a t -> 'a t + 364 val Base.Set.S_poly.union : 'a t -> 'a t -> 'a t + 364 val Base.Hashtbl.S_poly.clear : (_, _) t -> unit + 364 val Base.Hashtbl.S_poly.length : (_, _) t -> int + 364 val Base.Hashtbl.S_poly.hashable : 'a Hashable.t + 365 val Base.Map.S_poly.mem : ('k, _) t -> 'k -> bool + 366 val Base.Set.S_poly.nth : 'a t -> int -> 'a option + 366 val Base.Set.S_poly.union_list : 'a t list -> 'a t + 367 val Base.Map.S_poly.invariants : ('k, 'v) t -> bool + 367 val Base.Hashtbl.S_poly.is_empty : (_, _) t -> bool + 367 val Base.Hashtbl.S_poly.find_and_call1 : ('a, 'b) t -> + 'a key -> + a:'d -> + if_found:('b -> 'd -> 'c) -> + if_not_found:('a key -> 'd -> 'c) -> + 'c + 369 val Base.Map.S_poly.find_exn : ('k, 'v) t -> 'k -> 'v + 370 val Base.Map.S_poly.singleton : 'k -> 'v -> ('k, 'v) t + 370 val Base.Set.S_poly.remove_index : 'a t -> int -> 'a t + 371 val Base.Hashtbl.S_poly.copy : ('a, 'b) t -> ('a, 'b) t + 371 val Base.Map.S_poly.max_elt_exn : ('k, 'v) t -> 'k * 'v + 371 val Base.Map.S_poly.min_elt_exn : ('k, 'v) t -> 'k * 'v + 371 val Base.Set.S_poly.of_sequence : 'a Sequence.t -> 'a t + 371 val Base.Set.S_poly.are_disjoint : 'a t -> 'a t -> bool + 372 val Base.Set.S_poly.compare_direct : 'a t -> 'a t -> int + $ sherlodoc search --print-cost --no-rhs "group b" + 231 val Base.Set.group_by + 255 val Base.List.group + 262 val Base.Sequence.group + 275 val Base.List.sort_and_group + 278 val Base.List.groupi + 285 val Base.List.Assoc.group + 305 val Base.List.Assoc.sort_and_group + 325 val Base.Set.Poly.group_by + 353 val Base.Set.Using_comparator.group_by + 363 val Base.Set.Using_comparator.Tree.group_by + 373 val Base.Hashtbl.group + 427 val Base.Set.S_poly.group_by + 462 val Base.Set.Accessors_generic.group_by + 473 val Base.Hashtbl.Poly.group + 475 val Base.Set.Creators_and_accessors_generic.group_by + 480 val Base.Hashtbl.Creators.group + 487 val Base.Hashtbl.Creators.group + 499 val Base.Hashtbl.S_without_submodules.group + 575 val Base.Hashtbl.S_poly.group + $ sherlodoc search --no-rhs "group by" + val Base.Set.group_by + val Base.Set.Poly.group_by + val Base.Set.Using_comparator.group_by + val Base.Set.Using_comparator.Tree.group_by + val Base.Set.S_poly.group_by + val Base.Set.Accessors_generic.group_by + val Base.Set.Creators_and_accessors_generic.group_by + $ sherlodoc search --print-cost "map2" + 177 mod Base.Applicative.Make_using_map2 + 178 mod Base.Applicative.Make2_using_map2 + 178 mod Base.Applicative.Make3_using_map2 + 188 mod Base.Applicative.Make_using_map2_local + 189 mod Base.Applicative.Make2_using_map2_local + 189 mod Base.Applicative.Make3_using_map2_local + 192 val Base.Uniform_array.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 197 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 200 mod Base.Applicative.Make_using_map2.Applicative_infix + 201 mod Base.Applicative.Make2_using_map2.Applicative_infix + 201 mod Base.Applicative.Make3_using_map2.Applicative_infix + 205 val Base.Applicative.Make_using_map2.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 211 mod Base.Applicative.Make_using_map2_local.Applicative_infix + 212 mod Base.Applicative.Make2_using_map2_local.Applicative_infix + 212 mod Base.Applicative.Make3_using_map2_local.Applicative_infix + 216 val Base.Applicative.Make_using_map2_local.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 228 sig Base.Applicative.Basic_using_map2 + 228 val Base.Applicative.Make_using_map2.Applicative_infix.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 229 sig Base.Applicative.Basic2_using_map2 + 229 sig Base.Applicative.Basic3_using_map2 + 239 sig Base.Applicative.Basic_using_map2_local + 239 val Base.Applicative.Make_using_map2_local.Applicative_infix.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 240 sig Base.Applicative.Basic2_using_map2_local + 240 sig Base.Applicative.Basic3_using_map2_local + 276 val Base.Option.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + + $ sherlodoc search --print-cost --static-sort "List map2" + 177 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 273 val Base.List.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 290 val Base.List.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + 292 val Base.List.Cartesian_product.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 294 val Base.List.rev_map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + + $ sherlodoc search --print-cost "List map2" + 202 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 288 val Base.List.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 300 val Base.List.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + 302 val Base.List.Cartesian_product.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 314 val Base.List.rev_map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + + $ sherlodoc search --no-rhs "Base.Hashtbl.S_without_submodules.group" + val Base.Hashtbl.S_without_submodules.group + $ sherlodoc search --print-cost "list" + 131 type 'a Base.list = 'a List.t + 143 type 'a Base.Export.list = 'a List.t + 151 type 'a Base.List.t = 'a list + 154 mod Base.List + 154 mod Caml.List + 158 val Base.List.rev : 'a t -> 'a t + 159 val Base.List.hd_exn : 'a t -> 'a + 159 val Base.List.return : 'a -> 'a t + 160 val Base.Bytes.to_list : t -> char list + 161 val Base.List.join : 'a t t -> 'a t + 161 val Base.List.tl_exn : 'a t -> 'a t + 161 val Base.Queue.of_list : 'a list -> 'a t + 161 val Base.Stack.of_list : 'a list -> 'a t + 163 val Base.List.concat : 'a t t -> 'a t + 163 mod Shadow_stdlib.List + 164 val Base.List.last : 'a t -> 'a option + 164 val Base.Set.to_list : ('a, _) t -> 'a list + 165 mod Base.List.Assoc + 165 mod Base.List.Infix + 165 cons Base.Sexp.t.List : t list -> t + 165 val Base.List.ignore_m : 'a t -> unit t + 165 val Base.Bytes.of_char_list : char list -> t + 166 val Base.List.drop : 'a t -> int -> 'a t + 166 val Base.List.take : 'a t -> int -> 'a t + 167 val Base.List.nth_exn : 'a t -> int -> 'a + $ sherlodoc search --print-cost ": list" + 168 val Base.List.rev : 'a t -> 'a t + 169 val Base.List.return : 'a -> 'a t + 170 val Base.Bytes.to_list : t -> char list + 171 val Base.List.join : 'a t t -> 'a t + 171 val Base.List.tl_exn : 'a t -> 'a t + 172 val Base.String.split_lines : t -> t list + 173 val Base.List.concat : 'a t t -> 'a t + 175 val Base.List.ignore_m : 'a t -> unit t + 175 val Base.String.to_list_rev : t -> char list + 178 val Base.Sequence.to_list_rev : 'a t -> 'a list + 180 val Base.Pretty_printer.all : unit -> string list + 182 val Base.List.all_unit : unit t list -> unit t + 182 val Base.List.filter_opt : 'a option t -> 'a t + 182 val Base.List.transpose_exn : 'a t t -> 'a t t + 182 val Base.List.concat_no_order : 'a t t -> 'a t + 199 val Base.Set.to_list : ('a, _) t -> 'a list + 200 val Base.Hashtbl.data : (_, 'b) t -> 'b list + 200 val Base.Set.elements : ('a, _) t -> 'a list + 201 val Base.List.drop : 'a t -> int -> 'a t + 201 val Base.List.take : 'a t -> int -> 'a t + 202 val Base.String.split : t -> on:char -> t list + 204 val Base.List.append : 'a t -> 'a t -> 'a t + 204 val Base.Hashtbl.keys : ('a, _) t -> 'a key list + 208 val Base.List.rev_append : 'a t -> 'a t -> 'a t + 211 val Base.List.intersperse : 'a t -> sep:'a -> 'a t + +Partial name search: + $ sherlodoc search --print-cost "strin" + 147 type Base.string = String.t + 159 type Base.Export.string = String.t + 166 val Base.Sexp.of_string : unit + 167 type Base.String.t = string + 167 type Base.String.elt = char + 169 val Base.String.rev : t -> t + 171 mod Base.String + 171 mod Caml.String + 172 val Base.String.hash : t -> int + 172 val Base.Exn.to_string : t -> string + 172 val Base.Sys.max_string_length : int + 173 val Base.String.escaped : t -> t + 173 val Base.String.max_length : int + 174 val Base.String.(^) : t -> t -> t + 174 val Base.Float.to_string : t -> string + 175 mod Base.Stringable + 175 val Base.String.uppercase : t -> t + 176 type Base.String.Caseless.t = t + 176 val Base.String.capitalize : t -> t + 177 mod Caml.StringLabels + 177 val Base.String.append : t -> t -> t + 177 val Base.Exn.to_string_mach : t -> string + 177 val Base.Info.to_string_hum : t -> string + 177 val Base.Sign.to_string_hum : t -> string + 178 val Base.Info.to_string_mach : t -> string + $ sherlodoc search --print-cost "tring" + 177 type Base.string = String.t + 182 type Base.String.t = string + 182 type Base.String.elt = char + 184 val Base.String.rev : t -> t + 186 mod Base.String + 186 mod Caml.String + 186 val Base.Sexp.of_string : unit + 187 val Base.String.hash : t -> int + 188 val Base.String.escaped : t -> t + 188 val Base.String.max_length : int + 189 val Base.String.(^) : t -> t -> t + 189 type Base.Export.string = String.t + 190 val Base.String.uppercase : t -> t + 191 type Base.String.Caseless.t = t + 191 val Base.String.capitalize : t -> t + 192 val Base.Exn.to_string : t -> string + 192 val Base.String.append : t -> t -> t + 194 val Base.String.equal : t -> t -> bool + 194 val Base.String.prefix : t -> int -> t + 194 val Base.String.suffix : t -> int -> t + 194 val Base.Float.to_string : t -> string + 195 val Base.String.compare : t -> t -> int + 195 mod Shadow_stdlib.String + 197 val Base.String.ascending : t -> t -> int + 197 val Base.String.split_lines : t -> t list diff --git a/vendor/sherlodoc/test/cram/base_odocls.t b/vendor/sherlodoc/test/cram/base_odocls.t new file mode 100644 index 0000000000..42197104fd --- /dev/null +++ b/vendor/sherlodoc/test/cram/base_odocls.t @@ -0,0 +1,151 @@ + $ find ../docs/odoc/base/ -name '*.odocl' -exec basename '{}' ';' | grep -v "__" | sort + base.odocl + base_internalhash_types.odocl + caml.odocl + md5_lib.odocl + page-index.odocl + shadow_stdlib.odocl + + $ find ../docs/odoc/base/ -name '*.odocl' -exec basename '{}' ';' | sort + base.odocl + base__.odocl + base__Applicative.odocl + base__Applicative_intf.odocl + base__Array.odocl + base__Array0.odocl + base__Array_permute.odocl + base__Avltree.odocl + base__Backtrace.odocl + base__Binary_search.odocl + base__Binary_searchable.odocl + base__Binary_searchable_intf.odocl + base__Blit.odocl + base__Blit_intf.odocl + base__Bool.odocl + base__Bool0.odocl + base__Buffer.odocl + base__Buffer_intf.odocl + base__Bytes.odocl + base__Bytes0.odocl + base__Bytes_tr.odocl + base__Char.odocl + base__Char0.odocl + base__Comparable.odocl + base__Comparable_intf.odocl + base__Comparator.odocl + base__Comparisons.odocl + base__Container.odocl + base__Container_intf.odocl + base__Either.odocl + base__Either0.odocl + base__Either_intf.odocl + base__Equal.odocl + base__Error.odocl + base__Exn.odocl + base__Field.odocl + base__Fieldslib.odocl + base__Float.odocl + base__Float0.odocl + base__Floatable.odocl + base__Fn.odocl + base__Formatter.odocl + base__Globalize.odocl + base__Hash.odocl + base__Hash_intf.odocl + base__Hash_set.odocl + base__Hash_set_intf.odocl + base__Hashable.odocl + base__Hashable_intf.odocl + base__Hasher.odocl + base__Hashtbl.odocl + base__Hashtbl_intf.odocl + base__Hex_lexer.odocl + base__Identifiable.odocl + base__Identifiable_intf.odocl + base__Import.odocl + base__Import0.odocl + base__Indexed_container.odocl + base__Indexed_container_intf.odocl + base__Info.odocl + base__Info_intf.odocl + base__Int.odocl + base__Int0.odocl + base__Int32.odocl + base__Int63.odocl + base__Int63_emul.odocl + base__Int64.odocl + base__Int_conversions.odocl + base__Int_intf.odocl + base__Int_math.odocl + base__Intable.odocl + base__Invariant.odocl + base__Invariant_intf.odocl + base__Lazy.odocl + base__Linked_queue.odocl + base__Linked_queue0.odocl + base__List.odocl + base__List0.odocl + base__List1.odocl + base__Map.odocl + base__Map_intf.odocl + base__Maybe_bound.odocl + base__Monad.odocl + base__Monad_intf.odocl + base__Nativeint.odocl + base__Nothing.odocl + base__Obj_array.odocl + base__Obj_local.odocl + base__Option.odocl + base__Option_array.odocl + base__Or_error.odocl + base__Ordered_collection_common.odocl + base__Ordered_collection_common0.odocl + base__Ordering.odocl + base__Poly0.odocl + base__Popcount.odocl + base__Pow_overflow_bounds.odocl + base__Ppx_compare_lib.odocl + base__Ppx_enumerate_lib.odocl + base__Ppx_hash_lib.odocl + base__Pretty_printer.odocl + base__Printf.odocl + base__Queue.odocl + base__Queue_intf.odocl + base__Random.odocl + base__Random_repr.odocl + base__Ref.odocl + base__Result.odocl + base__Sequence.odocl + base__Set.odocl + base__Set_intf.odocl + base__Sexp.odocl + base__Sexp_with_comparable.odocl + base__Sexpable.odocl + base__Sign.odocl + base__Sign0.odocl + base__Sign_or_nan.odocl + base__Source_code_position.odocl + base__Source_code_position0.odocl + base__Stack.odocl + base__Stack_intf.odocl + base__Staged.odocl + base__String.odocl + base__String0.odocl + base__Stringable.odocl + base__Sys.odocl + base__Sys0.odocl + base__T.odocl + base__Type_equal.odocl + base__Uchar.odocl + base__Uchar0.odocl + base__Uniform_array.odocl + base__Unit.odocl + base__Variant.odocl + base__Variantslib.odocl + base__With_return.odocl + base__Word_size.odocl + base_internalhash_types.odocl + caml.odocl + md5_lib.odocl + page-index.odocl + shadow_stdlib.odocl diff --git a/vendor/sherlodoc/test/cram/base_web.t b/vendor/sherlodoc/test/cram/base_web.t new file mode 100644 index 0000000000..c6ea9ddf56 --- /dev/null +++ b/vendor/sherlodoc/test/cram/base_web.t @@ -0,0 +1,40 @@ + $ ODOCLS=$(find ../docs/odoc/base/ -name '*.odocl' | grep -v "__" | sort) + $ cat $ODOCLS > megaodocl +$ du -sh megaodocl +13M megaodocl + $ sherlodoc index --index-docstring=true --index-name=true --type-search=true --format=js --db=db.js $ODOCLS + + $ gzip -k db.js + +We want to compare the compressed size with the size of the odocl. The search +database contains information than the odocl, but the information is organised +in queryable way, so a size increase is expected. It should just be reasonable. + $ gzip -k megaodocl + +Marshal size changes between OCaml versions +$ du -s db.js db.js.gz +2112 db.js +1596 db.js.gz + + $ for f in $(find . -name '*.odocl'); do + > odoc html-generate --search-uri=db.js --search-uri=sherlodoc.js --output-dir html $f + > done + $ odoc support-files -o html + $ cp db.js html/ +The --no-preserve flag is here so that copying to /tmp will not fail because of +a previous run. .js files built by dune are read only. + $ sherlodoc js html/sherlodoc.js +$ du -sh html/sherlodoc.js +104K html/sherlodoc.js + $ ls html + db.js + fonts + highlight.pack.js + katex.min.css + katex.min.js + odoc.css + odoc_search.js + sherlodoc.js +indent to see results +$ cp -r html /tmp +$ firefox /tmp/html/base/index.html diff --git a/vendor/sherlodoc/test/cram/cli.t/main.mli b/vendor/sherlodoc/test/cram/cli.t/main.mli new file mode 100644 index 0000000000..9c483d7021 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli.t/main.mli @@ -0,0 +1,77 @@ +type foo + +val unique_name : foo +val multiple_hit_1 : foo +val multiple_hit_2 : foo +val multiple_hit_3 : foo + +type name_conflict = foo + +val name_conflict : foo + +module Nest : sig + val nesting_priority : foo +end + +val nesting_priority : foo + +module Map : sig + val to_list : foo +end + +type 'a list + +module List : sig + type 'a t = 'a list + + val map : ('a -> 'b) -> 'a t -> 'b t + val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t +end + +val foo : foo +(** this is not a list nor a map *) + +type moo +type t + +val value : moo +val consume : moo -> unit +val consume_2 : moo -> moo -> unit +val consume_2_other : moo -> t -> unit +val produce : unit -> moo +val produce_2' : unit -> unit -> moo + +module type Modtype = sig + val v_modtype : foo +end + +module type S = sig end + +module S_to_S1 : sig end + +(**/**) + +val hidden : foo + +(**/**) + +val poly_1 : 'a -> 'b -> 'c +val poly_2 : 'a -> 'b -> 'c -> 'a -> 'b -> 'c + +type 'a boo + +val poly_param : 'a boo + +type extensible_type = .. +type extensible_type += MyExtension of moo + +type exn_payload + +exception Implicit_exn of exn_payload +exception Explicit_exn : exn_payload -> exn +type exn += Very_explicit_exn : exn_payload -> exn + +type long_name_type + +val long_name_value : long_name_type \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/cli.t/page.mld b/vendor/sherlodoc/test/cram/cli.t/page.mld new file mode 100644 index 0000000000..37fe4527d8 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli.t/page.mld @@ -0,0 +1,10 @@ +{0 A title} + +A paragraph + +{v some verbatim v} + +{[and code]} + +- a list {e of} things +- bliblib diff --git a/vendor/sherlodoc/test/cram/cli.t/run.t b/vendor/sherlodoc/test/cram/cli.t/run.t new file mode 100644 index 0000000000..c5e31762dc --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli.t/run.t @@ -0,0 +1,126 @@ + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc compile -I . page.mld + $ odoc link -I . main.odoc + $ odoc link -I . page-page.odoc + $ odoc compile-index -o index.odoc-index --root ./ + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index index.odoc-index + $ sherlodoc search "unique_name" + val Main.unique_name : foo + $ sherlodoc search "multiple_hit" + val Main.multiple_hit_1 : foo + val Main.multiple_hit_2 : foo + val Main.multiple_hit_3 : foo + $ sherlodoc search --print-cost "name_conflict" + 134 type Main.name_conflict = foo + 234 val Main.name_conflict : foo + $ sherlodoc search "nesting_priority" + val Main.nesting_priority : foo + val Main.Nest.nesting_priority : foo + $ sherlodoc search "list" + type 'a Main.list + type 'a Main.List.t = 'a list + mod Main.List + val Main.Map.to_list : foo + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val Main.foo : foo + $ sherlodoc search "map" + mod Main.Map + val Main.Map.to_list : foo + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val Main.foo : foo + $ sherlodoc search "list map" + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.Map.to_list : foo + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + val Main.foo : foo + $ sherlodoc search "map2" + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + $ sherlodoc search ":moo" + val Main.value : moo + val Main.produce : unit -> moo + val Main.produce_2' : unit -> unit -> moo + $ sherlodoc search ":_ -> moo" + val Main.produce : unit -> moo + val Main.produce_2' : unit -> unit -> moo + val Main.value : moo + $ sherlodoc search ":moo -> _" + cons Main.MyExtension : moo -> extensible_type + val Main.consume : moo -> unit + val Main.consume_2 : moo -> moo -> unit + val Main.consume_2_other : moo -> t -> unit + $ sherlodoc search "modtype" + sig Main.Modtype + val Main.Modtype.v_modtype : foo + $ sherlodoc search "extensible" + type Main.extensible_type = .. + $ sherlodoc search "S" + mod Main.S_to_S1 + sig Main.S + type Main.extensible_type = .. + type 'a Main.List.t = 'a list + mod Main.List + mod Main.Nest + type 'a Main.list + cons Main.MyExtension : moo -> extensible_type + val Main.consume : moo -> unit + val Main.Map.to_list : foo + val Main.nesting_priority : foo + val Main.consume_2 : moo -> moo -> unit + val Main.Nest.nesting_priority : foo + val Main.consume_2_other : moo -> t -> unit + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.foo : foo + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + $ sherlodoc search "qwertyuiopasdfghjklzxcvbnm" + [No results] + $ sherlodoc search "hidden" + [No results] + $ sherlodoc search ":mo" + val Main.value : moo + val Main.produce : unit -> moo + val Main.produce_2' : unit -> unit -> moo + $ sherlodoc search ":'a" + val Main.poly_param : 'a boo + val Main.poly_1 : 'a -> 'b -> 'c + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.poly_2 : 'a -> 'b -> 'c -> 'a -> 'b -> 'c + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + $ sherlodoc search ": 'a -> 'b -> 'c " + val Main.poly_1 : 'a -> 'b -> 'c + val Main.poly_2 : 'a -> 'b -> 'c -> 'a -> 'b -> 'c + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + $ sherlodoc search ": ('a -> 'b) -> 'a t -> 'b t" + val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + val Main.List.map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val Main.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + $ sherlodoc search ": 'a bo" + val Main.poly_param : 'a boo + $ sherlodoc search ":extensible_type" + cons Main.MyExtension : moo -> extensible_type + $ sherlodoc search ":exn" + exn Main.Explicit_exn : exn_payload -> exn + exn Main.Implicit_exn : exn_payload -> exn + cons Main.Very_explicit_exn : exn_payload -> exn + $ sherlodoc search ": exn_payload -> _" + exn Main.Explicit_exn : exn_payload -> exn + exn Main.Implicit_exn : exn_payload -> exn + cons Main.Very_explicit_exn : exn_payload -> exn + $ sherlodoc search ": long_name_type" + val Main.long_name_value : long_name_type + $ sherlodoc search ": long_nam" + val Main.long_name_value : long_name_type + $ sherlodoc search "long_name" + type Main.long_name_type + val Main.long_name_value : long_name_type diff --git a/vendor/sherlodoc/test/cram/cli_poly.t/main.mli b/vendor/sherlodoc/test/cram/cli_poly.t/main.mli new file mode 100644 index 0000000000..02fe405fc4 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli_poly.t/main.mli @@ -0,0 +1,7 @@ + + +val poly_1 : 'a -> 'b -> 'c + + + + diff --git a/vendor/sherlodoc/test/cram/cli_poly.t/page.mld b/vendor/sherlodoc/test/cram/cli_poly.t/page.mld new file mode 100644 index 0000000000..37fe4527d8 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli_poly.t/page.mld @@ -0,0 +1,10 @@ +{0 A title} + +A paragraph + +{v some verbatim v} + +{[and code]} + +- a list {e of} things +- bliblib diff --git a/vendor/sherlodoc/test/cram/cli_poly.t/run.t b/vendor/sherlodoc/test/cram/cli_poly.t/run.t new file mode 100644 index 0000000000..266a77111a --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli_poly.t/run.t @@ -0,0 +1,17 @@ + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc compile -I . page.mld + $ odoc link -I . main.odoc + $ odoc link -I . page-page.odoc + $ cat $(find . -name '*.odocl') > megaodocl +$ du -sh megaodocl +4.0K megaodocl + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index $(find . -name '*.odocl') +TODO : get a result for the query bellow + $ sherlodoc search ":'a" + val Main.poly_1 : 'a -> 'b -> 'c + $ sherlodoc search ": 'a -> 'b -> 'c " + val Main.poly_1 : 'a -> 'b -> 'c +TODO : get a result for the query bellow diff --git a/vendor/sherlodoc/test/cram/cli_small.t/main.mli b/vendor/sherlodoc/test/cram/cli_small.t/main.mli new file mode 100644 index 0000000000..9e1d7609a7 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli_small.t/main.mli @@ -0,0 +1,18 @@ + +type 'a list + +module List : sig + type 'a t = 'a list + + val map : ('a -> 'b) -> 'a t -> 'b t + + val empty : 'a t * 'b t + + +end + +type ('a, 'b) result + +val ok: 'a -> ('a, 'b) result + +val ok_zero : (int, 'a) result \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/cli_small.t/run.t b/vendor/sherlodoc/test/cram/cli_small.t/run.t new file mode 100644 index 0000000000..7b0b4aa341 --- /dev/null +++ b/vendor/sherlodoc/test/cram/cli_small.t/run.t @@ -0,0 +1,14 @@ + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc link -I . main.odoc + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index $(find . -name '*.odocl') + $ sherlodoc search --print-cost "list" + 139 type 'a Main.list + 151 type 'a Main.List.t = 'a list + 154 mod Main.List + 259 val Main.List.empty : 'a t * 'b t + 272 val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + $ sherlodoc search ": (int, 'a) result" + val Main.ok_zero : (int, 'a) result diff --git a/vendor/sherlodoc/test/cram/dune b/vendor/sherlodoc/test/cram/dune new file mode 100644 index 0000000000..958bfaa70a --- /dev/null +++ b/vendor/sherlodoc/test/cram/dune @@ -0,0 +1,2 @@ +(cram + (deps ../docs %{bin:odoc} %{bin:sherlodoc})) diff --git a/vendor/sherlodoc/test/cram/empty.t/dune b/vendor/sherlodoc/test/cram/empty.t/dune new file mode 100644 index 0000000000..d5b98e5629 --- /dev/null +++ b/vendor/sherlodoc/test/cram/empty.t/dune @@ -0,0 +1,3 @@ +(executable + (name foo) + (public_name foo)) diff --git a/vendor/sherlodoc/test/cram/empty.t/dune-project b/vendor/sherlodoc/test/cram/empty.t/dune-project new file mode 100644 index 0000000000..82632eb46c --- /dev/null +++ b/vendor/sherlodoc/test/cram/empty.t/dune-project @@ -0,0 +1,4 @@ +(lang dune 3.7) + +(package + (name foo)) diff --git a/vendor/sherlodoc/test/cram/empty.t/foo.ml b/vendor/sherlodoc/test/cram/empty.t/foo.ml new file mode 100644 index 0000000000..8b3c77862e --- /dev/null +++ b/vendor/sherlodoc/test/cram/empty.t/foo.ml @@ -0,0 +1 @@ +let a = 123 \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/empty.t/run.t b/vendor/sherlodoc/test/cram/empty.t/run.t new file mode 100644 index 0000000000..3073cd3974 --- /dev/null +++ b/vendor/sherlodoc/test/cram/empty.t/run.t @@ -0,0 +1,9 @@ +This test checkes that project that is empty despite not looking empty does not +crash sherlodoc. + $ export PATH=.:$PATH + $ export OCAMLRUNPARAM=b + $ dune build @doc + $ sherlodoc index ./_build/default/_doc/_odocls/foo/page-index.odocl --format=marshal --db=db.marshal + $ sherlodoc search --db=db.marshal lorem + [No results] + diff --git a/vendor/sherlodoc/test/cram/link_in_docstring.t/a.mli b/vendor/sherlodoc/test/cram/link_in_docstring.t/a.mli new file mode 100644 index 0000000000..e0fd4ff968 --- /dev/null +++ b/vendor/sherlodoc/test/cram/link_in_docstring.t/a.mli @@ -0,0 +1,6 @@ + +(** This is a docstring with a {{:https://sherlocode.com}link} *) +val foo : int + +(** This is a docstring with a ref to {!foo} *) +val bar : int \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/link_in_docstring.t/run.t b/vendor/sherlodoc/test/cram/link_in_docstring.t/run.t new file mode 100644 index 0000000000..365f686593 --- /dev/null +++ b/vendor/sherlodoc/test/cram/link_in_docstring.t/run.t @@ -0,0 +1,12 @@ + $ ocamlc -c a.mli -bin-annot -I . + $ odoc compile -I . a.cmti + $ odoc link -I . a.odoc + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index $(find . -name '*.odocl') + $ sherlodoc search --print-docstring "foo" + val A.foo : int +

This is a docstring with a link

+ $ sherlodoc search --print-docstring "bar" + val A.bar : int +

This is a docstring with a ref to foo

diff --git a/vendor/sherlodoc/test/cram/module_type_cost.t/main.mli b/vendor/sherlodoc/test/cram/module_type_cost.t/main.mli new file mode 100644 index 0000000000..6f95af3239 --- /dev/null +++ b/vendor/sherlodoc/test/cram/module_type_cost.t/main.mli @@ -0,0 +1,13 @@ +module M : sig + val my_function : int -> int +end + +module type S = sig + val my_function : int -> int +end + +module type Module_type = sig end + +module Module_nype : sig end + +module Make (M : S) : S \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/module_type_cost.t/run.t b/vendor/sherlodoc/test/cram/module_type_cost.t/run.t new file mode 100644 index 0000000000..ef7069cedd --- /dev/null +++ b/vendor/sherlodoc/test/cram/module_type_cost.t/run.t @@ -0,0 +1,19 @@ + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc link -I . main.odoc + $ cat $(find . -name '*.odocl') > megaodocl +$ du -sh megaodocl +4.0K megaodocl + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index $(find . -name '*.odocl') +Here we expect to have the `my_function` from the module be above the one from +the module type. + $ sherlodoc search --print-cost --no-rhs "my_function" + 246 val Main.M.my_function + 249 val Main.Make.my_function + 346 val Main.S.my_function +Here we expect both the module type and the module to be ranked the same + $ sherlodoc search --print-cost "module" + 166 mod Main.Module_nype + 216 sig Main.Module_type diff --git a/vendor/sherlodoc/test/cram/multi_package.t b/vendor/sherlodoc/test/cram/multi_package.t new file mode 100644 index 0000000000..884961a990 --- /dev/null +++ b/vendor/sherlodoc/test/cram/multi_package.t @@ -0,0 +1,352 @@ + $ ODOCLS=$(find ../docs/odoc/ -name '*.odocl' | grep -v "__" | sort) + $ echo "$ODOCLS" | awk 'END { print NR }' + 6 + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index --index-docstring=false $ODOCLS + $ sherlodoc search --print-cost --limit 100 "S_poly" + 200 sig Base.Map.S_poly + 200 sig Base.Set.S_poly + 204 sig Base.Hashtbl.S_poly + 248 type 'a Base.Hashtbl.S_poly.key = 'a + 257 type ('a, 'b) Base.Map.S_poly.t + 257 type 'elt Base.Set.S_poly.t + 259 type ('a, 'cmp) Base.Set.S_poly.set + 260 val Base.Set.S_poly.mem : 'a t -> 'a -> bool + 260 type ('a, 'b) Base.Map.S_poly.tree + 260 type 'elt Base.Set.S_poly.tree + 261 type ('a, 'b) Base.Hashtbl.S_poly.t + 261 mod Base.Set.S_poly.Named + 267 val Base.Hashtbl.S_poly.data : (_, 'b) t -> 'b list + 271 val Base.Hashtbl.S_poly.keys : ('a, _) t -> 'a key list + 274 type Base.Map.S_poly.comparator_witness + 274 type Base.Set.S_poly.comparator_witness + 277 val Base.Set.S_poly.map : ('a, _) set -> f:('a -> 'b) -> 'b t + 277 val Base.Hashtbl.S_poly.find_exn : ('a, 'b) t -> 'a key -> 'b + 278 val Base.Hashtbl.S_poly.choose_exn : ('a, 'b) t -> 'a key * 'b + 280 val Base.Hashtbl.S_poly.find : ('a, 'b) t -> 'a key -> 'b option + 283 val Base.Hashtbl.S_poly.choose : ('a, 'b) t -> ('a key * 'b) option + 283 val Base.Hashtbl.S_poly.to_alist : ('a, 'b) t -> ('a key * 'b) list + 283 mod Base.Map.S_poly.Make_applicative_traversals + 286 val Base.Hashtbl.S_poly.map : ('a, 'b) t -> f:('b -> 'c) -> ('a, 'c) t + 287 val Base.Hashtbl.S_poly.map_inplace : (_, 'b) t -> f:('b -> 'b) -> unit + 287 val Base.Hashtbl.S_poly.remove_multi : ('a, _ list) t -> 'a key -> unit + 289 val Base.Hashtbl.S_poly.set : ('a, 'b) t -> key:'a key -> data:'b -> unit + 289 val Base.Hashtbl.S_poly.find_multi : ('a, 'b list) t -> 'a key -> 'b list + 291 val Base.Hashtbl.S_poly.find_and_remove : ('a, 'b) t -> 'a key -> 'b option + 300 val Base.Hashtbl.S_poly.update : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> unit + 300 val Base.Hashtbl.S_poly.add_multi : ('a, 'b list) t -> key:'a key -> data:'b -> unit + 300 val Base.Hashtbl.S_poly.filter_map : ('a, 'b) t -> f:('b -> 'c option) -> ('a, 'c) t + 301 val Base.Hashtbl.S_poly.filter_map_inplace : (_, 'b) t -> f:('b -> 'b option) -> unit + 301 val Base.Hashtbl.S_poly.filter_keys_inplace : ('a, _) t -> f:('a key -> bool) -> unit + 302 val Base.Hashtbl.S_poly.equal : ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + 303 val Base.Hashtbl.S_poly.iteri : ('a, 'b) t -> f:(key:'a key -> data:'b -> unit) -> unit + 304 val Base.Hashtbl.S_poly.find_or_add : ('a, 'b) t -> 'a key -> default:(unit -> 'b) -> 'b + 305 val Base.Hashtbl.S_poly.add : ('a, 'b) t -> key:'a key -> data:'b -> [ `Ok | `Duplicate ] + 306 val Base.Hashtbl.S_poly.mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c) -> ('a, 'c) t + 307 val Base.Hashtbl.S_poly.change : ('a, 'b) t -> 'a key -> f:('b option -> 'b option) -> unit + 307 val Base.Hashtbl.S_poly.findi_or_add : ('a, 'b) t -> 'a key -> default:('a key -> 'b) -> 'b + 309 val Base.Hashtbl.S_poly.update_and_return : ('a, 'b) t -> 'a key -> f:('b option -> 'b) -> 'b + 310 val Base.Hashtbl.S_poly.partition_tf : ('a, 'b) t -> f:('b -> bool) -> ('a, 'b) t * ('a, 'b) t + 311 val Base.Hashtbl.S_poly.incr : ?by:int -> ?remove_if_zero:bool -> ('a, int) t -> 'a key -> unit + 319 val Base.Hashtbl.S_poly.choose_randomly_exn : ?random_state:Random.State.t -> ('a, 'b) t -> 'a key * 'b + 320 val Base.Hashtbl.S_poly.filter_mapi : ('a, 'b) t -> f:(key:'a key -> data:'b -> 'c option) -> ('a, 'c) t + 323 val Base.Hashtbl.S_poly.fold : ('a, 'b) t -> init:'acc -> f:(key:'a key -> data:'b -> 'acc -> 'acc) -> 'acc + 324 val Base.Hashtbl.S_poly.partition_map : ('a, 'b) t -> f:('b -> ('c, 'd) Either.t) -> ('a, 'c) t * ('a, 'd) t + 324 val Base.Hashtbl.S_poly.choose_randomly : ?random_state:Random.State.t -> ('a, 'b) t -> ('a key * 'b) option + 330 val Base.Hashtbl.S_poly.partitioni_tf : ('a, 'b) t -> f:(key:'a key -> data:'b -> bool) -> ('a, 'b) t * ('a, 'b) t + 344 val Base.Hashtbl.S_poly.find_and_call : ('a, 'b) t -> + 'a key -> + if_found:('b -> 'c) -> + if_not_found:('a key -> 'c) -> + 'c + 348 val Base.Set.S_poly.empty : 'a t + 348 val Base.Hashtbl.S_poly.partition_mapi : ('a, 'b) t -> + f:(key:'a key -> data:'b -> ('c, 'd) Either.t) -> + ('a, 'c) t * ('a, 'd) t + 353 val Base.Map.S_poly.empty : ('k, _) t + 355 val Base.Set.S_poly.length : _ t -> int + 358 val Base.Set.S_poly.is_empty : _ t -> bool + 358 val Base.Set.S_poly.singleton : 'a -> 'a t + 359 val Base.Set.S_poly.choose_exn : 'a t -> 'a + 360 val Base.Set.S_poly.add : 'a t -> 'a -> 'a t + 360 val Base.Map.S_poly.length : (_, _) t -> int + 360 val Base.Set.S_poly.max_elt_exn : 'a t -> 'a + 360 val Base.Set.S_poly.min_elt_exn : 'a t -> 'a + 361 val Base.Set.S_poly.of_list : 'a list -> 'a t + 361 val Base.Set.S_poly.of_tree : 'a tree -> 'a t + 361 val Base.Set.S_poly.to_list : 'a t -> 'a list + 361 val Base.Set.S_poly.to_tree : 'a t -> 'a tree + 361 val Base.Set.S_poly.invariants : 'a t -> bool + 362 val Base.Set.S_poly.choose : 'a t -> 'a option + 362 val Base.Set.S_poly.elements : 'a t -> 'a list + 362 val Base.Hashtbl.S_poly.merge_into : src:('k, 'a) t -> + dst:('k, 'b) t -> + f:(key:'k key -> 'a -> 'b option -> 'b Merge_into_action.t) -> + unit + 363 val Base.Map.S_poly.data : (_, 'v) t -> 'v list + 363 val Base.Map.S_poly.keys : ('k, _) t -> 'k list + 363 val Base.Set.S_poly.diff : 'a t -> 'a t -> 'a t + 363 val Base.Set.S_poly.remove : 'a t -> 'a -> 'a t + 363 val Base.Set.S_poly.max_elt : 'a t -> 'a option + 363 val Base.Set.S_poly.min_elt : 'a t -> 'a option + 363 val Base.Map.S_poly.is_empty : (_, _) t -> bool + 363 val Base.Set.S_poly.of_array : 'a array -> 'a t + 363 val Base.Set.S_poly.to_array : 'a t -> 'a array + 364 val Base.Set.S_poly.equal : 'a t -> 'a t -> bool + 364 val Base.Set.S_poly.inter : 'a t -> 'a t -> 'a t + 364 val Base.Set.S_poly.union : 'a t -> 'a t -> 'a t + 364 val Base.Hashtbl.S_poly.clear : (_, _) t -> unit + 364 val Base.Hashtbl.S_poly.length : (_, _) t -> int + 364 val Base.Hashtbl.S_poly.hashable : 'a Hashable.t + 365 val Base.Map.S_poly.mem : ('k, _) t -> 'k -> bool + 366 val Base.Set.S_poly.nth : 'a t -> int -> 'a option + 366 val Base.Set.S_poly.union_list : 'a t list -> 'a t + 367 val Base.Map.S_poly.invariants : ('k, 'v) t -> bool + 367 val Base.Hashtbl.S_poly.is_empty : (_, _) t -> bool + 367 val Base.Hashtbl.S_poly.find_and_call1 : ('a, 'b) t -> + 'a key -> + a:'d -> + if_found:('b -> 'd -> 'c) -> + if_not_found:('a key -> 'd -> 'c) -> + 'c + 369 val Base.Map.S_poly.find_exn : ('k, 'v) t -> 'k -> 'v + 370 val Base.Map.S_poly.singleton : 'k -> 'v -> ('k, 'v) t + 370 val Base.Set.S_poly.remove_index : 'a t -> int -> 'a t + 371 val Base.Hashtbl.S_poly.copy : ('a, 'b) t -> ('a, 'b) t + 371 val Base.Map.S_poly.max_elt_exn : ('k, 'v) t -> 'k * 'v + 371 val Base.Map.S_poly.min_elt_exn : ('k, 'v) t -> 'k * 'v + 371 val Base.Set.S_poly.of_sequence : 'a Sequence.t -> 'a t + 371 val Base.Set.S_poly.are_disjoint : 'a t -> 'a t -> bool + 372 val Base.Set.S_poly.compare_direct : 'a t -> 'a t -> int + $ sherlodoc search --print-cost --no-rhs "group b" + 231 val Base.Set.group_by + 255 val Base.List.group + 262 val Base.Sequence.group + 275 val Base.List.sort_and_group + 278 val Base.List.groupi + 285 val Base.List.Assoc.group + 305 val Base.List.Assoc.sort_and_group + 325 val Base.Set.Poly.group_by + 353 val Base.Set.Using_comparator.group_by + 363 val Base.Set.Using_comparator.Tree.group_by + 373 val Base.Hashtbl.group + 427 val Base.Set.S_poly.group_by + 462 val Base.Set.Accessors_generic.group_by + 473 val Base.Hashtbl.Poly.group + 475 val Base.Set.Creators_and_accessors_generic.group_by + 480 val Base.Hashtbl.Creators.group + 487 val Base.Hashtbl.Creators.group + 499 val Base.Hashtbl.S_without_submodules.group + 575 val Base.Hashtbl.S_poly.group + $ sherlodoc search --no-rhs "group by" + val Base.Set.group_by + val Base.Set.Poly.group_by + val Base.Set.Using_comparator.group_by + val Base.Set.Using_comparator.Tree.group_by + val Base.Set.S_poly.group_by + val Base.Set.Accessors_generic.group_by + val Base.Set.Creators_and_accessors_generic.group_by + $ sherlodoc search --print-cost "map2" + 177 mod Base.Applicative.Make_using_map2 + 178 mod Base.Applicative.Make2_using_map2 + 178 mod Base.Applicative.Make3_using_map2 + 188 mod Base.Applicative.Make_using_map2_local + 189 mod Base.Applicative.Make2_using_map2_local + 189 mod Base.Applicative.Make3_using_map2_local + 192 val Base.Uniform_array.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 197 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 200 mod Base.Applicative.Make_using_map2.Applicative_infix + 201 mod Base.Applicative.Make2_using_map2.Applicative_infix + 201 mod Base.Applicative.Make3_using_map2.Applicative_infix + 205 val Base.Applicative.Make_using_map2.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 211 mod Base.Applicative.Make_using_map2_local.Applicative_infix + 212 mod Base.Applicative.Make2_using_map2_local.Applicative_infix + 212 mod Base.Applicative.Make3_using_map2_local.Applicative_infix + 216 val Base.Applicative.Make_using_map2_local.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 228 sig Base.Applicative.Basic_using_map2 + 228 val Base.Applicative.Make_using_map2.Applicative_infix.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 229 sig Base.Applicative.Basic2_using_map2 + 229 sig Base.Applicative.Basic3_using_map2 + 239 sig Base.Applicative.Basic_using_map2_local + 239 val Base.Applicative.Make_using_map2_local.Applicative_infix.(<*>) : ('a -> 'b) X.t -> 'a X.t -> 'b X.t + 240 sig Base.Applicative.Basic2_using_map2_local + 240 sig Base.Applicative.Basic3_using_map2_local + 276 val Base.Option.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + + $ sherlodoc search --print-cost --static-sort "List map2" + 177 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 273 val Base.List.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 290 val Base.List.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + 292 val Base.List.Cartesian_product.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 294 val Base.List.rev_map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + + $ sherlodoc search --print-cost "List map2" + 202 val Base.List.rev_map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 288 val Base.List.map2_exn : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 300 val Base.List.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + 302 val Base.List.Cartesian_product.map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t + 314 val Base.List.rev_map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t Or_unequal_lengths.t + + $ sherlodoc search --no-rhs "Base.Hashtbl.S_without_submodules.group" + val Base.Hashtbl.S_without_submodules.group + $ sherlodoc search --print-cost "list" + 131 type 'a Base.list = 'a List.t + 143 type 'a Base.Export.list = 'a List.t + 151 type 'a Base.List.t = 'a list + 154 mod Base.List + 154 mod Caml.List + 158 val Base.List.rev : 'a t -> 'a t + 159 val Base.List.hd_exn : 'a t -> 'a + 159 val Base.List.return : 'a -> 'a t + 160 val Base.Bytes.to_list : t -> char list + 161 val Base.List.join : 'a t t -> 'a t + 161 val Base.List.tl_exn : 'a t -> 'a t + 161 val Base.Queue.of_list : 'a list -> 'a t + 161 val Base.Stack.of_list : 'a list -> 'a t + 163 val Base.List.concat : 'a t t -> 'a t + 163 mod Shadow_stdlib.List + 164 val Base.List.last : 'a t -> 'a option + 164 val Base.Set.to_list : ('a, _) t -> 'a list + 165 mod Base.List.Assoc + 165 mod Base.List.Infix + 165 cons Base.Sexp.t.List : t list -> t + 165 val Base.List.ignore_m : 'a t -> unit t + 165 val Base.Bytes.of_char_list : char list -> t + 166 val Base.List.drop : 'a t -> int -> 'a t + 166 val Base.List.take : 'a t -> int -> 'a t + 167 val Base.List.nth_exn : 'a t -> int -> 'a + $ sherlodoc search --print-cost ": list" + 168 val Base.List.rev : 'a t -> 'a t + 169 val Base.List.return : 'a -> 'a t + 170 val Base.Bytes.to_list : t -> char list + 171 val Base.List.join : 'a t t -> 'a t + 171 val Base.List.tl_exn : 'a t -> 'a t + 172 val Base.String.split_lines : t -> t list + 173 val Base.List.concat : 'a t t -> 'a t + 175 val Base.List.ignore_m : 'a t -> unit t + 175 val Base.String.to_list_rev : t -> char list + 178 val Base.Sequence.to_list_rev : 'a t -> 'a list + 180 val Base.Pretty_printer.all : unit -> string list + 182 val Base.List.all_unit : unit t list -> unit t + 182 val Base.List.filter_opt : 'a option t -> 'a t + 182 val Base.List.transpose_exn : 'a t t -> 'a t t + 182 val Base.List.concat_no_order : 'a t t -> 'a t + 199 val Base.Set.to_list : ('a, _) t -> 'a list + 200 val Base.Hashtbl.data : (_, 'b) t -> 'b list + 200 val Base.Set.elements : ('a, _) t -> 'a list + 201 val Base.List.drop : 'a t -> int -> 'a t + 201 val Base.List.take : 'a t -> int -> 'a t + 202 val Base.String.split : t -> on:char -> t list + 204 val Base.List.append : 'a t -> 'a t -> 'a t + 204 val Base.Hashtbl.keys : ('a, _) t -> 'a key list + 208 val Base.List.rev_append : 'a t -> 'a t -> 'a t + 211 val Base.List.intersperse : 'a t -> sep:'a -> 'a t + +Partial name search: + $ sherlodoc search --print-cost "strin" + 147 type Base.string = String.t + 159 type Base.Export.string = String.t + 166 val Base.Sexp.of_string : unit + 167 type Base.String.t = string + 167 type Base.String.elt = char + 169 val Base.String.rev : t -> t + 171 mod Base.String + 171 mod Caml.String + 172 val Base.String.hash : t -> int + 172 val Base.Exn.to_string : t -> string + 172 val Base.Sys.max_string_length : int + 173 val Base.String.escaped : t -> t + 173 val Base.String.max_length : int + 174 val Base.String.(^) : t -> t -> t + 174 val Base.Float.to_string : t -> string + 175 mod Base.Stringable + 175 val Base.String.uppercase : t -> t + 176 type Base.String.Caseless.t = t + 176 val Base.String.capitalize : t -> t + 177 mod Caml.StringLabels + 177 val Base.String.append : t -> t -> t + 177 val Base.Exn.to_string_mach : t -> string + 177 val Base.Info.to_string_hum : t -> string + 177 val Base.Sign.to_string_hum : t -> string + 178 val Base.Info.to_string_mach : t -> string + $ sherlodoc search --print-cost "base strin" + 162 type Base.string = String.t + 174 type Base.Export.string = String.t + 181 val Base.Sexp.of_string : unit + 182 type Base.String.t = string + 182 type Base.String.elt = char + 184 val Base.String.rev : t -> t + 186 mod Base.String + 187 val Base.String.hash : t -> int + 187 val Base.Exn.to_string : t -> string + 187 val Base.Sys.max_string_length : int + 188 val Base.String.escaped : t -> t + 188 val Base.String.max_length : int + 189 val Base.String.(^) : t -> t -> t + 189 val Base.Float.to_string : t -> string + 190 mod Base.Stringable + 190 val Base.String.uppercase : t -> t + 191 type Base.String.Caseless.t = t + 191 val Base.String.capitalize : t -> t + 192 val Base.String.append : t -> t -> t + 192 val Base.Exn.to_string_mach : t -> string + 192 val Base.Info.to_string_hum : t -> string + 192 val Base.Sign.to_string_hum : t -> string + 193 val Base.Error.to_string_hum : t -> string + 193 val Base.Info.to_string_mach : t -> string + 194 val Base.Error.to_string_mach : t -> string + + $ sherlodoc search --print-cost "tring" + 177 type Base.string = String.t + 182 type Base.String.t = string + 182 type Base.String.elt = char + 184 val Base.String.rev : t -> t + 186 mod Base.String + 186 mod Caml.String + 186 val Base.Sexp.of_string : unit + 187 val Base.String.hash : t -> int + 188 val Base.String.escaped : t -> t + 188 val Base.String.max_length : int + 189 val Base.String.(^) : t -> t -> t + 189 type Base.Export.string = String.t + 190 val Base.String.uppercase : t -> t + 191 type Base.String.Caseless.t = t + 191 val Base.String.capitalize : t -> t + 192 val Base.Exn.to_string : t -> string + 192 val Base.String.append : t -> t -> t + 194 val Base.String.equal : t -> t -> bool + 194 val Base.String.prefix : t -> int -> t + 194 val Base.String.suffix : t -> int -> t + 194 val Base.Float.to_string : t -> string + 195 val Base.String.compare : t -> t -> int + 195 mod Shadow_stdlib.String + 197 val Base.String.ascending : t -> t -> int + 197 val Base.String.split_lines : t -> t list + $ sherlodoc search --print-cost "base tring" + 192 type Base.string = String.t + 197 type Base.String.t = string + 197 type Base.String.elt = char + 199 val Base.String.rev : t -> t + 201 mod Base.String + 201 val Base.Sexp.of_string : unit + 202 val Base.String.hash : t -> int + 203 val Base.String.escaped : t -> t + 203 val Base.String.max_length : int + 204 val Base.String.(^) : t -> t -> t + 204 type Base.Export.string = String.t + 205 val Base.String.uppercase : t -> t + 206 type Base.String.Caseless.t = t + 206 val Base.String.capitalize : t -> t + 207 val Base.Exn.to_string : t -> string + 207 val Base.String.append : t -> t -> t + 209 val Base.String.equal : t -> t -> bool + 209 val Base.String.prefix : t -> int -> t + 209 val Base.String.suffix : t -> int -> t + 209 val Base.Float.to_string : t -> string + 210 val Base.String.compare : t -> t -> int + 212 val Base.String.ascending : t -> t -> int + 212 val Base.String.split_lines : t -> t list + 212 val Base.Sys.max_string_length : int + 214 val Base.String.common_suffix : t list -> t + diff --git a/vendor/sherlodoc/test/cram/odocl_favouritism.t/a.mli b/vendor/sherlodoc/test/cram/odocl_favouritism.t/a.mli new file mode 100644 index 0000000000..076f4196bd --- /dev/null +++ b/vendor/sherlodoc/test/cram/odocl_favouritism.t/a.mli @@ -0,0 +1 @@ +val unique_name : int diff --git a/vendor/sherlodoc/test/cram/odocl_favouritism.t/b.mli b/vendor/sherlodoc/test/cram/odocl_favouritism.t/b.mli new file mode 100644 index 0000000000..076f4196bd --- /dev/null +++ b/vendor/sherlodoc/test/cram/odocl_favouritism.t/b.mli @@ -0,0 +1 @@ +val unique_name : int diff --git a/vendor/sherlodoc/test/cram/odocl_favouritism.t/run.t b/vendor/sherlodoc/test/cram/odocl_favouritism.t/run.t new file mode 100644 index 0000000000..50f766e4f7 --- /dev/null +++ b/vendor/sherlodoc/test/cram/odocl_favouritism.t/run.t @@ -0,0 +1,25 @@ + $ ocamlc -c a.mli -bin-annot -I . + $ odoc compile -I . a.cmti + $ ocamlc -c b.mli -bin-annot -I . + $ odoc compile -I . b.cmti + $ odoc link -I . a.odoc + $ odoc link -I . b.odoc + + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index a.odocl b.odocl + $ sherlodoc search --print-cost "unique_name" + 229 val A.unique_name : int + 229 val B.unique_name : int + $ sherlodoc index --favoured a.odocl b.odocl + $ sherlodoc search --print-cost "unique_name" + 179 val A.unique_name : int + 229 val B.unique_name : int + $ sherlodoc index a.odocl --favoured b.odocl + $ sherlodoc search --print-cost "unique_name" + 179 val B.unique_name : int + 229 val A.unique_name : int + $ sherlodoc index --favoured a.odocl --favoured b.odocl + $ sherlodoc search --print-cost "unique_name" + 179 val A.unique_name : int + 179 val B.unique_name : int diff --git a/vendor/sherlodoc/test/cram/prefix_favouritism.t b/vendor/sherlodoc/test/cram/prefix_favouritism.t new file mode 100644 index 0000000000..1b98e182a7 --- /dev/null +++ b/vendor/sherlodoc/test/cram/prefix_favouritism.t @@ -0,0 +1,140 @@ + $ ODOCLS=$(find ../docs/odoc/base/ -name '*.odocl') + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=marshal + $ sherlodoc index $ODOCLS > /dev/null + $ sherlodoc search --print-cost "list" + 131 type 'a Base.list = 'a List.t + 143 type 'a Base.Export.list = 'a List.t + 151 type 'a Base.List.t = 'a list + 154 mod Base.List + 154 mod Caml.List + 158 val Base.List.rev : 'a t -> 'a t + 159 val Base.List.hd_exn : 'a t -> 'a + 159 val Base.List.return : 'a -> 'a t + 160 val Base.Bytes.to_list : t -> char list + 161 val Base.List.join : 'a t t -> 'a t + 161 val Base.List.tl_exn : 'a t -> 'a t + 161 val Base.Queue.of_list : 'a list -> 'a t + 161 val Base.Stack.of_list : 'a list -> 'a t + 163 val Base.List.concat : 'a t t -> 'a t + 163 mod Shadow_stdlib.List + 164 val Base.List.last : 'a t -> 'a option + 165 mod Base.List.Assoc + 165 mod Base.List.Infix + 165 cons Base.Sexp.t.List : t list -> t + 165 val Base.List.ignore_m : 'a t -> unit t + 166 val Base.List.drop : 'a t -> int -> 'a t + 166 val Base.List.take : 'a t -> int -> 'a t + 175 mod Caml.ListLabels + 394 mod Base + 397 type Base.Nothing.t = + $ sherlodoc index --favoured-prefixes=Base $ODOCLS > /dev/null + $ sherlodoc search --print-cost "list" + 81 type 'a Base.list = 'a List.t + 93 type 'a Base.Export.list = 'a List.t + 101 type 'a Base.List.t = 'a list + 104 mod Base.List + 108 val Base.List.rev : 'a t -> 'a t + 109 val Base.List.hd_exn : 'a t -> 'a + 109 val Base.List.return : 'a -> 'a t + 110 val Base.Bytes.to_list : t -> char list + 111 val Base.List.join : 'a t t -> 'a t + 111 val Base.List.tl_exn : 'a t -> 'a t + 111 val Base.Queue.of_list : 'a list -> 'a t + 111 val Base.Stack.of_list : 'a list -> 'a t + 113 val Base.List.concat : 'a t t -> 'a t + 114 val Base.List.last : 'a t -> 'a option + 115 mod Base.List.Assoc + 115 mod Base.List.Infix + 115 cons Base.Sexp.t.List : t list -> t + 115 val Base.List.ignore_m : 'a t -> unit t + 116 val Base.List.drop : 'a t -> int -> 'a t + 116 val Base.List.take : 'a t -> int -> 'a t + 344 mod Base + 347 type Base.Nothing.t = + 362 val Base.String.append : t -> t -> t + 364 val Base.Int.ascending : t -> t -> int + 365 val Base.Bool.ascending : t -> t -> int + $ sherlodoc index --favoured-prefixes=Caml $ODOCLS > /dev/null + $ sherlodoc search --print-cost "list" + 104 mod Caml.List + 125 mod Caml.ListLabels + 131 type 'a Base.list = 'a List.t + 143 type 'a Base.Export.list = 'a List.t + 151 type 'a Base.List.t = 'a list + 154 mod Base.List + 158 val Base.List.rev : 'a t -> 'a t + 159 val Base.List.hd_exn : 'a t -> 'a + 159 val Base.List.return : 'a -> 'a t + 160 val Base.Bytes.to_list : t -> char list + 161 val Base.List.join : 'a t t -> 'a t + 161 val Base.List.tl_exn : 'a t -> 'a t + 161 val Base.Queue.of_list : 'a list -> 'a t + 161 val Base.Stack.of_list : 'a list -> 'a t + 163 val Base.List.concat : 'a t t -> 'a t + 163 mod Shadow_stdlib.List + 164 val Base.List.last : 'a t -> 'a option + 165 mod Base.List.Assoc + 165 mod Base.List.Infix + 165 cons Base.Sexp.t.List : t list -> t + 165 val Base.List.ignore_m : 'a t -> unit t + 166 val Base.List.drop : 'a t -> int -> 'a t + 166 val Base.List.take : 'a t -> int -> 'a t + 394 mod Base + 397 type Base.Nothing.t = + $ sherlodoc index --favoured-prefixes=Base,Caml $ODOCLS > /dev/null + $ sherlodoc search --print-cost "list" + 81 type 'a Base.list = 'a List.t + 93 type 'a Base.Export.list = 'a List.t + 101 type 'a Base.List.t = 'a list + 104 mod Base.List + 104 mod Caml.List + 108 val Base.List.rev : 'a t -> 'a t + 109 val Base.List.hd_exn : 'a t -> 'a + 109 val Base.List.return : 'a -> 'a t + 110 val Base.Bytes.to_list : t -> char list + 111 val Base.List.join : 'a t t -> 'a t + 111 val Base.List.tl_exn : 'a t -> 'a t + 111 val Base.Queue.of_list : 'a list -> 'a t + 111 val Base.Stack.of_list : 'a list -> 'a t + 113 val Base.List.concat : 'a t t -> 'a t + 114 val Base.List.last : 'a t -> 'a option + 115 mod Base.List.Assoc + 115 mod Base.List.Infix + 115 cons Base.Sexp.t.List : t list -> t + 115 val Base.List.ignore_m : 'a t -> unit t + 116 val Base.List.drop : 'a t -> int -> 'a t + 116 val Base.List.take : 'a t -> int -> 'a t + 125 mod Caml.ListLabels + 344 mod Base + 347 type Base.Nothing.t = + 362 val Base.String.append : t -> t -> t + $ sherlodoc index $ODOCLS --favoured-prefixes "" > /dev/null + $ sherlodoc search --print-cost "list" + 131 type 'a Base.list = 'a List.t + 143 type 'a Base.Export.list = 'a List.t + 151 type 'a Base.List.t = 'a list + 154 mod Base.List + 154 mod Caml.List + 158 val Base.List.rev : 'a t -> 'a t + 159 val Base.List.hd_exn : 'a t -> 'a + 159 val Base.List.return : 'a -> 'a t + 160 val Base.Bytes.to_list : t -> char list + 161 val Base.List.join : 'a t t -> 'a t + 161 val Base.List.tl_exn : 'a t -> 'a t + 161 val Base.Queue.of_list : 'a list -> 'a t + 161 val Base.Stack.of_list : 'a list -> 'a t + 163 val Base.List.concat : 'a t t -> 'a t + 163 mod Shadow_stdlib.List + 164 val Base.List.last : 'a t -> 'a option + 165 mod Base.List.Assoc + 165 mod Base.List.Infix + 165 cons Base.Sexp.t.List : t list -> t + 165 val Base.List.ignore_m : 'a t -> unit t + 166 val Base.List.drop : 'a t -> int -> 'a t + 166 val Base.List.take : 'a t -> int -> 'a t + 175 mod Caml.ListLabels + 394 mod Base + 397 type Base.Nothing.t = + +Partial name search: diff --git a/vendor/sherlodoc/test/cram/query_syntax.t b/vendor/sherlodoc/test/cram/query_syntax.t new file mode 100644 index 0000000000..3eda2f4d94 --- /dev/null +++ b/vendor/sherlodoc/test/cram/query_syntax.t @@ -0,0 +1,65 @@ +We need a dummy file because sherlodoc requires an odocl. + $ touch main.mli + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc link -I . main.odoc + $ export SHERLODOC_FORMAT=marshal + $ export SHERLODOC_DB=db.bin + $ sherlodoc index main.odocl + $ sherlodoc search --pretty-query ": int list option" + : int list option + [No results] + $ export OCAMLRUNPARAM=b + $ sherlodoc search --pretty-query ": _" + : _ + [No results] +Testing incomplete queries + $ sherlodoc search --pretty-query ": ->" + : _ -> _ + [No results] + $ sherlodoc search --pretty-query ": int ->" + : int -> _ + [No results] + $ sherlodoc search --pretty-query ": int *" + : int * _ + [No results] + $ sherlodoc search --pretty-query ": string -> (" + : string -> _ + [No results] + $ sherlodoc search --pretty-query ": (int" + : int + [No results] + $ sherlodoc search --pretty-query ": (int ->" + : int -> _ + [No results] + $ sherlodoc search --pretty-query ": (int *" + : int * _ + [No results] + $ sherlodoc search --pretty-query ": foo bar qux" + : foo bar qux + [No results] + $ sherlodoc search --pretty-query ": ()" + : _ + [No results] + $ sherlodoc search --pretty-query ": )" + : _ + [No results] + $ sherlodoc search --pretty-query ": (int," + : int * _ + [No results] + $ sherlodoc search --pretty-query ": (int,string" + : int * string + [No results] + $ sherlodoc search --pretty-query ": 'a, 'b) result -" + : ('a, 'b) result -> _ + [No results] + $ sherlodoc search --pretty-query ": 'a * 'b) list" + : ('a * 'b) list + [No results] + $ sherlodoc search --pretty-query ": - ,'a * 'b, 'c) result -) - ( -" + : ((_ -> _, 'a * 'b, 'c) result -> _) -> _ -> _ + [No results] +Testing syntax errors + $ sherlodoc search --pretty-query ": )(" + : + [No results] diff --git a/vendor/sherlodoc/test/cram/simple.t/main.ml b/vendor/sherlodoc/test/cram/simple.t/main.ml new file mode 100644 index 0000000000..f5eb8813f0 --- /dev/null +++ b/vendor/sherlodoc/test/cram/simple.t/main.ml @@ -0,0 +1,92 @@ +type t = int +(** A comment *) + +(** {1 this is a title} + + and this is a paragraph + + *) + +module type Signature = sig end + +class istack = + object + val mutable v = [ 0; 2 ] + + method pop = + match v with + | hd :: tl -> + v <- tl ; + Some hd + | [] -> None + + method push hd = v <- hd :: v + end + +class type my_class_type = object end + +module Modulule = struct + type t + (** dsdsd *) +end + +(** a reference {!t}, and some {e formatted} {b content} with [code] and + +{[ + code blocks +]} + + *) +let v = 9 + +(** lorem 1 + *) +let lorem _ = 'a' + +(** lorem 2 + *) +let lorem2 _ = 'a' + +(** lorem 3 + *) +let lorem3 _ = 'e' + +(** lorem 4 + *) +module Trucmuche = struct + let bidule = 4 +end + +include Trucmuche + +let lorem4 = 1 + +type my_type = int * char + +type babar = + | A of string + | B + | C of + { z : int + ; w : char + } + +type _ celeste = + { x : babar + ; y : int -> string + } + +type 'a list = + | Cons of 'a * 'a list + | Nil + +(** Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod + tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, + quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo + consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse + cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat + non proident, sunt in culpa qui officia deserunt mollit anim id est laborum. *) +let long = 3 + +type ext_t = .. +type ext_t += Ext_const of int diff --git a/vendor/sherlodoc/test/cram/simple.t/page.mld b/vendor/sherlodoc/test/cram/simple.t/page.mld new file mode 100644 index 0000000000..a2a2439df7 --- /dev/null +++ b/vendor/sherlodoc/test/cram/simple.t/page.mld @@ -0,0 +1,12 @@ +{0 A title} + +A paragraph + +{v some verbatim v} + +{[and code]} + +- a list {e of} things +- bliblib + +{!Main} \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram/simple.t/run.t b/vendor/sherlodoc/test/cram/simple.t/run.t new file mode 100644 index 0000000000..145698ae28 --- /dev/null +++ b/vendor/sherlodoc/test/cram/simple.t/run.t @@ -0,0 +1,68 @@ + $ ocamlc -c main.ml -bin-annot -I . + $ odoc compile --child module-main -I . page.mld + $ odoc compile --parent page -I . main.cmt + $ odoc link -I . main.odoc + $ odoc link -I . page-page.odoc + $ cat $(find . -name '*.odocl') > megaodocl +$ du -sh megaodocl +12K megaodocl + $ mkdir html + $ sherlodoc index --format=js --db=html/db.js $(find . -name '*.odocl') 2> /dev/null + $ sherlodoc js html/sherlodoc.js + $ odoc support-files -o html + $ for f in $(find . -name '*.odocl' | sort); do + > echo $f ; + > cd html ; + > odoc html-generate --search-uri db.js --search-uri sherlodoc.js --output-dir . ../$f ; + > cd .. + > done | sort + ./main.odocl + ./page-page.odocl + $ ls | sort + html + main.cmi + main.cmo + main.cmt + main.ml + main.odoc + main.odocl + megaodocl + page-page.odoc + page-page.odocl + page.mld + $ ls html | sort + db.js + fonts + highlight.pack.js + katex.min.css + katex.min.js + odoc.css + odoc_search.js + page + sherlodoc.js + $ ls html/page | sort + Main + index.html + $ find . -name "*.html" -type f | sort + ./html/page/Main/Modulule/index.html + ./html/page/Main/Trucmuche/index.html + ./html/page/Main/class-istack/index.html + ./html/page/Main/class-type-my_class_type/index.html + ./html/page/Main/index.html + ./html/page/Main/module-type-Signature/index.html + ./html/page/index.html + $ find . -name "*.js" -type f | sort + ./html/db.js + ./html/highlight.pack.js + ./html/katex.min.js + ./html/odoc_search.js + ./html/sherlodoc.js + +Indent to see results +$ cp -r html /tmp +$ firefox /tmp/html/page/index.html + $ grep -E -o "'[\./a-zA-Z0-9_]*\.js" html/page/index.html + '../db.js + '../sherlodoc.js + + diff --git a/vendor/sherlodoc/test/cram/size_bound.t b/vendor/sherlodoc/test/cram/size_bound.t new file mode 100644 index 0000000000..2d7b2c530f --- /dev/null +++ b/vendor/sherlodoc/test/cram/size_bound.t @@ -0,0 +1,12 @@ +This tests that sherlodoc.js is not bigger than 120000 bytes. We test a threshold +of the size because the precise size depends on specific ocaml and dependencies +versions. This test should pass on every version. If it fails, we can either +update the threshold to be large enough or forbid certain dependency versions +in the opam file. + $ sherlodoc js sherlodoc.js + $ if [ "$(du sherlodoc.js | cut -f 1)" -gt 120000 ]; then + > du sherlodoc.js + > else + > echo "All good! "; + > fi + All good! diff --git a/vendor/sherlodoc/test/cram/version.t b/vendor/sherlodoc/test/cram/version.t new file mode 100644 index 0000000000..6a58e4dd78 --- /dev/null +++ b/vendor/sherlodoc/test/cram/version.t @@ -0,0 +1,2 @@ + $ sherlodoc --version + 0.2 diff --git a/vendor/sherlodoc/test/cram_ancient/cli_small.t/main.mli b/vendor/sherlodoc/test/cram_ancient/cli_small.t/main.mli new file mode 100644 index 0000000000..9e1d7609a7 --- /dev/null +++ b/vendor/sherlodoc/test/cram_ancient/cli_small.t/main.mli @@ -0,0 +1,18 @@ + +type 'a list + +module List : sig + type 'a t = 'a list + + val map : ('a -> 'b) -> 'a t -> 'b t + + val empty : 'a t * 'b t + + +end + +type ('a, 'b) result + +val ok: 'a -> ('a, 'b) result + +val ok_zero : (int, 'a) result \ No newline at end of file diff --git a/vendor/sherlodoc/test/cram_ancient/cli_small.t/run.t b/vendor/sherlodoc/test/cram_ancient/cli_small.t/run.t new file mode 100644 index 0000000000..452edd9458 --- /dev/null +++ b/vendor/sherlodoc/test/cram_ancient/cli_small.t/run.t @@ -0,0 +1,17 @@ + $ ocamlc -c main.mli -bin-annot -I . + $ odoc compile -I . main.cmti + $ odoc link -I . main.odoc + $ cat $(find . -name '*.odocl') > megaodocl + $ du -sh megaodocl + 4.0K megaodocl + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=ancient + $ sherlodoc index $(find . -name '*.odocl') + $ sherlodoc search --print-cost "list" + 139 type 'a Main.list + 151 type 'a Main.List.t = 'a list + 154 mod Main.List + 259 val Main.List.empty : 'a t * 'b t + 272 val Main.List.map : ('a -> 'b) -> 'a t -> 'b t + $ sherlodoc search ": (int, 'a) result" + val Main.ok_zero : (int, 'a) result diff --git a/vendor/sherlodoc/test/cram_ancient/dune b/vendor/sherlodoc/test/cram_ancient/dune new file mode 100644 index 0000000000..693a24fd21 --- /dev/null +++ b/vendor/sherlodoc/test/cram_ancient/dune @@ -0,0 +1,3 @@ +(cram + (enabled_if %{lib-available:ancient}) + (deps %{bin:odoc} %{bin:sherlodoc})) diff --git a/vendor/sherlodoc/test/cram_ancient/empty.t b/vendor/sherlodoc/test/cram_ancient/empty.t new file mode 100644 index 0000000000..443a468af0 --- /dev/null +++ b/vendor/sherlodoc/test/cram_ancient/empty.t @@ -0,0 +1,7 @@ + $ export SHERLODOC_DB=db.bin + $ export SHERLODOC_FORMAT=ancient + $ sherlodoc index + $ sherlodoc search "query" + [No results] + $ sherlodoc search ": type_query" + [No results] diff --git a/vendor/sherlodoc/test/cram_static/base_web.t b/vendor/sherlodoc/test/cram_static/base_web.t new file mode 100644 index 0000000000..11aa91d44a --- /dev/null +++ b/vendor/sherlodoc/test/cram_static/base_web.t @@ -0,0 +1,36 @@ + $ export ODOCLS=$(find ../docs/odoc/base/ -name '*.odocl') + $ cat $ODOCLS > megaodocl +$ du -sh megaodocl +5.4M megaodocl + $ sherlodoc index --index-docstring=true --index-name=true --type-search=true --format=js --db=db.js $ODOCLS > /dev/null + + $ gzip -k db.js + +We want to compare the compressed size with the size of the odocl. The search +database contains information than the odocl, but the information is organised +in queryable way, so a size increase is expected. It should just be reasonable. + +$ du -s *.js *.gz +2108 db.js +1592 db.js.gz + + $ for f in $(find . -name '*.odocl'); do + > odoc html-generate --search-uri=db.js --search-uri=sherlodoc.js --output-dir html $f + > done + $ odoc support-files -o html + $ cp db.js html/ +The --no-preserve flag is here so that copying to /tmp will not fail because of +a previous run. .js files built by dune are read only. + $ sherlodoc js html/sherlodoc.js + $ ls html + db.js + fonts + highlight.pack.js + katex.min.css + katex.min.js + odoc.css + odoc_search.js + sherlodoc.js +indent to see results +$ cp -r html /tmp +$ firefox /tmp/html/base/index.html diff --git a/vendor/sherlodoc/test/cram_static/dune b/vendor/sherlodoc/test/cram_static/dune new file mode 100644 index 0000000000..54d19fea64 --- /dev/null +++ b/vendor/sherlodoc/test/cram_static/dune @@ -0,0 +1,6 @@ +(cram + (enabled_if + (and + (= %{version:menhirLib} 20230608) + (= %{ocaml_version} 4.14.1))) + (deps ../docs %{bin:odoc} %{bin:sherlodoc})) diff --git a/vendor/sherlodoc/test/cram_static/js_static_size.t b/vendor/sherlodoc/test/cram_static/js_static_size.t new file mode 100644 index 0000000000..966d3f18fe --- /dev/null +++ b/vendor/sherlodoc/test/cram_static/js_static_size.t @@ -0,0 +1,3 @@ + $ sherlodoc js sherlodoc.js + $ du -sh sherlodoc.js + 92K sherlodoc.js diff --git a/vendor/sherlodoc/test/dune b/vendor/sherlodoc/test/dune new file mode 100644 index 0000000000..94a91be7bb --- /dev/null +++ b/vendor/sherlodoc/test/dune @@ -0,0 +1,10 @@ +(rule + (target + (dir docs)) + (deps + (package base)) + (action + (progn + (run mkdir -p docs) + (run odig odoc --cache-dir=docs --no-pkg-deps --quiet base) + (run rm docs/html/base/_doc-dir)))) diff --git a/vendor/sherlodoc/test/whole_switch/.gitignore b/vendor/sherlodoc/test/whole_switch/.gitignore new file mode 100644 index 0000000000..f9ced93c2f --- /dev/null +++ b/vendor/sherlodoc/test/whole_switch/.gitignore @@ -0,0 +1 @@ +packages diff --git a/vendor/sherlodoc/test/whole_switch/readme.md b/vendor/sherlodoc/test/whole_switch/readme.md new file mode 100644 index 0000000000..aa43e6e575 --- /dev/null +++ b/vendor/sherlodoc/test/whole_switch/readme.md @@ -0,0 +1,11 @@ +This is directory meants for test on a whole switch. We only test that we can +actually build a documentation database in for every package. We do not check +that the results of search are good, because we do not have a definition of that +for any package. + +It has two scripts : + +- `set_big_switch.sh` installs a lot of compatible packages in the current + switch. +- `test.sh` generates the search database of every installed package. Its output + is in the `packages` folder. \ No newline at end of file diff --git a/vendor/sherlodoc/test/whole_switch/setup_big_switch.sh b/vendor/sherlodoc/test/whole_switch/setup_big_switch.sh new file mode 100644 index 0000000000..5411f1553d --- /dev/null +++ b/vendor/sherlodoc/test/whole_switch/setup_big_switch.sh @@ -0,0 +1,436 @@ +opam install +absolute.0.3 +accessor.v0.16.0 +aches.1.0.0 +aches-lwt.1.0.0 +acp4.1.0.1 +alcotest.1.7.0 +alsa.0.3.0 +alt-ergo.2.5.2 +alt-ergo-lib.2.5.2 +alt-ergo-parsers.2.5.2 +ancient.0.9.1 +angstrom.0.15.0 +apron.v0.9.14 +apronext.1.0.4 +arrakis.1.0.0 +art.0.2.0 +asetmap.0.8.1 +asn1-combinators.0.2.6 +astring.0.8.5 +async.v0.16.0 +async_kernel.v0.16.0 +async_rpc_kernel.v0.16.0 +async_unix.v0.16.0 +async_websocket.v0.16.0 +b0.0.0.5 +base.v0.16.3 +base-bigarray.base +base-bytes.base +base-threads.base +base-unix.base +base64.3.5.1 +base_bigstring.v0.16.0 +base_quickcheck.v0.16.0 +batteries.3.7.1 +bheap.2.0.0 +bigarray-compat.1.1.0 +bigarray-overlap.0.2.1 +bigstring.0.3 +bigstringaf.0.9.1 +bin_prot.v0.16.0 +bls12-381.18.0 +bos.0.2.1 +brr.0.0.6 +bst.7.0.1 +ca-certs.0.2.3 +camlidl.1.11 +camlp-streams.5.0.1 +camlzip.1.11 +caqti.1.9.0 +caqti-lwt.1.9.0 +checkseum.0.5.2 +chrome-trace.3.11.1 +class_group_vdf.0.0.4 +cmdliner.1.2.0 +cohttp.5.3.0 +cohttp-lwt.5.3.0 +cohttp-lwt-unix.5.3.0 +conduit.6.2.0 +conduit-lwt.6.2.0 +conduit-lwt-unix.6.2.0 +conf-alsa.1 +conf-autoconf.0.1 +conf-cmake.1 +conf-g++.1.0 +conf-gmp.4 +conf-gmp-powm-sec.3 +conf-hidapi.0 +conf-libev.4-12 +conf-libffi.2.0.0 +conf-libssl.4 +conf-mpfr.3 +conf-perl.2 +conf-pkg-config.3 +conf-rust.0.1 +conf-rust-2021.1 +conf-sdl2.1 +conf-which.1 +conf-zlib.1 +core.v0.16.2 +core_kernel.v0.16.0 +core_unix.v0.16.0 +cpm.12.2.0 +cppo.1.6.9 +cpu.2.0.0 +cryptokit.1.16.1 +csexp.1.5.2 +cstruct.6.2.0 +cstruct-lwt.6.2.0 +ctypes.0.20.2 +ctypes-foreign.0.18.0 +ctypes_stubs_js.0.1 +data-encoding.0.7.1 +decompress.1.5.3 +digestif.1.1.4 +dolmen.0.9 +dolmen_loop.0.9 +dolmen_type.0.9 +dolog.6.0.0 +domain-name.0.4.0 +dream.1.0.0~alpha5 +dream-httpaf.1.0.0~alpha2 +dream-pure.1.0.0~alpha2 +dune.3.10.0 +dune-build-info.3.11.1 +dune-configurator.3.11.1 +dune-private-libs.3.11.1 +dune-rpc.3.11.1 +dune-site.3.11.1 +duration.0.2.1 +dyn.3.11.1 +either.1.0.0 +eqaf.0.9 +expect_test_helpers_core.v0.16.0 +ezjsonm.1.3.0 +faraday.0.8.2 +faraday-lwt.0.8.2 +faraday-lwt-unix.0.8.2 +fiber.3.7.0 +fieldslib.v0.16.0 +fix.20230505 +fmlib.0.5.6 +fmlib_browser.0.5.6 +fmlib_js.0.5.6 +fmlib_parse.0.5.6 +fmlib_pretty.0.5.6 +fmlib_std.0.5.6 +fmt.0.9.0 +fpath.0.7.3 +gen.1.1 +gg.1.0.0 +gmap.0.3.0 +graphql.0.14.0 +graphql-lwt.0.14.0 +graphql_parser.0.14.0 +hacl-star.0.7.1 +hacl-star-raw.0.7.1 +hashcons.1.3 +hex.1.5.0 +hidapi.1.1.2 +higher_kinded.v0.16.0 +hkdf.1.0.4 +hmap.0.8.1 +htmlit.0.1.0 +index.1.6.1 +int_repr.v0.16.0 +integers.0.7.0 +integers_stubs_js.1.0 +ipaddr.5.5.0 +ipaddr-sexp.5.5.0 +irmin.3.7.2 +irmin-pack.3.7.2 +jane-street-headers.v0.16.0 +js_of_ocaml.5.4.0 +js_of_ocaml-compiler.5.4.0 +js_of_ocaml-ppx.5.4.0 +js_of_ocaml-toplevel.5.4.0 +json-data-encoding.0.12.1 +json-data-encoding-bson.0.12.1 +jsonm.1.0.2 +jst-config.v0.16.0 +ke.0.6 +ledgerwallet.0.3.0 +ledgerwallet-tezos.0.3.0 +libabsolute.0.1 +line_oriented.1.3.0 +logs.0.7.0 +lru.0.3.1 +lwt.5.7.0 +lwt-canceler.0.3 +lwt-exit.1.0 +lwt-watcher.0.2 +lwt_ppx.2.1.0 +lwt_ssl.1.2.0 +macaddr.5.5.0 +magic-mime.1.3.1 +matplotlib.0.2 +mdx.2.3.1 +menhir.20230608 +menhirLib.20230608 +menhirSdk.20230608 +merlin-lib.4.12-414 +minicli.5.0.2 +mirage-clock.4.2.0 +mirage-crypto.0.11.2 +mirage-crypto-ec.0.11.2 +mirage-crypto-pk.0.11.2 +mirage-crypto-rng.0.11.2 +mirage-crypto-rng-lwt.0.11.2 +mlgmpidl.1.2.15 +mtime.1.4.0 +multipart_form.0.5.0 +multipart_form-lwt.0.5.0 +num.1.4 +ocaml.4.14.1 +ocaml-base-compiler.4.14.1 +ocaml-compiler-libs.v0.12.4 +ocaml-config.2 +ocaml-migrate-parsetree.2.4.0 +ocaml-options-vanilla.1 +ocaml-syntax-shims.1.0.0 +ocaml-version.3.6.2 +ocaml_intrinsics.v0.16.0 +ocamlbuild.0.14.2 +ocamlc-loc.3.11.1 +ocamlfind.1.9.6 +ocamlformat.0.26.1 +ocamlformat-lib.0.26.1 +ocamlformat-rpc-lib.0.26.1 +ocamlgraph.2.1.0 +ocp-indent.1.8.1 +ocp-ocamlres.0.4 +ocplib-endian.1.2 +ocplib-simplex.0.5 +octez.18.0 +octez-accuser-Proxford.18.0 +octez-accuser-PtNairob.18.0 +octez-alcotezt.18.0 +octez-baker-Proxford.18.0 +octez-baker-PtNairob.18.0 +octez-client.18.0 +octez-codec.18.0 +octez-crawler.18.0 +octez-dac-client.18.0 +octez-dac-node.18.0 +octez-distributed-internal.18.0 +octez-distributed-lwt-internal.18.0 +octez-injector.18.0 +octez-l2-libs.18.0 +octez-libs.18.0 +octez-node.18.0 +octez-node-config.18.0 +octez-proto-libs.18.0 +octez-protocol-000-Ps9mPmXa-libs.18.0 +octez-protocol-001-PtCJ7pwo-libs.18.0 +octez-protocol-002-PsYLVpVv-libs.18.0 +octez-protocol-003-PsddFKi3-libs.18.0 +octez-protocol-004-Pt24m4xi-libs.18.0 +octez-protocol-005-PsBabyM1-libs.18.0 +octez-protocol-006-PsCARTHA-libs.18.0 +octez-protocol-007-PsDELPH1-libs.18.0 +octez-protocol-008-PtEdo2Zk-libs.18.0 +octez-protocol-009-PsFLoren-libs.18.0 +octez-protocol-010-PtGRANAD-libs.18.0 +octez-protocol-011-PtHangz2-libs.18.0 +octez-protocol-012-Psithaca-libs.18.0 +octez-protocol-013-PtJakart-libs.18.0 +octez-protocol-014-PtKathma-libs.18.0 +octez-protocol-015-PtLimaPt-libs.18.0 +octez-protocol-016-PtMumbai-libs.18.0 +octez-protocol-017-PtNairob-libs.18.0 +octez-protocol-018-Proxford-libs.18.0 +octez-protocol-alpha-libs.18.0 +octez-protocol-compiler.18.0 +octez-proxy-server.18.0 +octez-shell-libs.18.0 +octez-signer.18.0 +octez-smart-rollup-client-Proxford.18.0 +octez-smart-rollup-client-PtNairob.18.0 +octez-smart-rollup-node-lib.18.0 +octez-smart-rollup-node-Proxford.18.0 +octez-smart-rollup-node-PtNairob.18.0 +octez-smart-rollup-wasm-debugger.18.0 +octez-version.18.0 +odig.0.0.9 +odoc.2.3.0 +odoc-parser.2.3.0 +opam-core.2.1.5 +optint.0.3.0 +ordering.3.11.1 +parany.14.0.1 +parsexp.v0.16.0 +pbkdf.1.2.0 +pecu.0.6 +picasso.0.4.0 +pp.1.2.0 +pp_loc.2.1.0 +pprint.20230830 +ppx_assert.v0.16.0 +ppx_base.v0.16.0 +ppx_bench.v0.16.0 +ppx_bin_prot.v0.16.0 +ppx_blob.0.7.2 +ppx_cold.v0.16.0 +ppx_compare.v0.16.0 +ppx_custom_printf.v0.16.0 +ppx_derivers.1.2.1 +ppx_deriving.5.2.1 +ppx_disable_unused_warnings.v0.16.0 +ppx_enumerate.v0.16.0 +ppx_expect.v0.16.0 +ppx_fields_conv.v0.16.0 +ppx_fixed_literal.v0.16.0 +ppx_globalize.v0.16.0 +ppx_hash.v0.16.0 +ppx_here.v0.16.0 +ppx_ignore_instrumentation.v0.16.0 +ppx_import.1.10.0 +ppx_inline_test.v0.16.0 +ppx_irmin.3.7.2 +ppx_jane.v0.16.0 +ppx_let.v0.16.0 +ppx_log.v0.16.0 +ppx_module_timer.v0.16.0 +ppx_optcomp.v0.16.0 +ppx_optional.v0.16.0 +ppx_pipebang.v0.16.0 +ppx_repr.0.7.0 +ppx_sexp_conv.v0.16.0 +ppx_sexp_message.v0.16.0 +ppx_sexp_value.v0.16.0 +ppx_stable.v0.16.0 +ppx_stable_witness.v0.16.0 +ppx_string.v0.16.0 +ppx_tydi.v0.16.0 +ppx_typerep_conv.v0.16.0 +ppx_variants_conv.v0.16.0 +ppx_yojson_conv_lib.v0.16.0 +ppxlib.0.31.0 +prbnmcn-basic-structures.0.0.1 +prbnmcn-linalg.0.0.1 +prbnmcn-stats.0.0.6 +prettym.0.0.3 +pringo.1.3 +progress.0.2.1 +prometheus.1.2 +prometheus-app.1.2 +protocol_version_header.v0.16.0 +psmt2-frontend.0.4.0 +psq.0.2.1 +ptime.1.1.0 +pure-splitmix.0.3 +pyml.20220905 +qcheck-alcotest.0.21.2 +qcheck-core.0.21.2 +re.1.11.0 +redis.0.7.1 +repr.0.7.0 +resto.1.2 +resto-acl.1.2 +resto-cohttp.1.2 +resto-cohttp-client.1.2 +resto-cohttp-self-serving-client.1.2 +resto-cohttp-server.1.2 +resto-directory.1.2 +result.1.5 +ringo.1.0.0 +rresult.0.7.0 +rusage.1.0.0 +secp256k1-internal.0.4.0 +sedlex.3.2 +semaphore-compat.1.0.1 +seq.base +seqes.0.2 +sexp_pretty.v0.16.0 +sexplib.v0.16.0 +sexplib0.v0.16.0 +spawn.v0.15.1 +spelll.0.4 +splittable_random.v0.16.0 +ssl.0.7.0 +stdcompat.19 +stdint.0.7.2 +stdio.v0.16.0 +stdlib-shims.0.3.0 +stdune.3.11.1 +stringext.1.6.0 +tar.2.6.0 +tar-unix.2.6.0 +terminal.0.2.1 +textutils.v0.16.0 +textutils_kernel.v0.16.0 +tezos-benchmark.18.0 +tezos-dac-client-lib.18.0 +tezos-dac-lib.18.0 +tezos-dac-node-lib.18.0 +tezos-dal-node-lib.18.0 +tezos-dal-node-services.18.0 +tezos-lwt-result-stdlib.17.3 +tezos-protocol-000-Ps9mPmXa.18.0 +tezos-protocol-001-PtCJ7pwo.18.0 +tezos-protocol-002-PsYLVpVv.18.0 +tezos-protocol-003-PsddFKi3.18.0 +tezos-protocol-004-Pt24m4xi.18.0 +tezos-protocol-005-PsBABY5H.18.0 +tezos-protocol-005-PsBabyM1.18.0 +tezos-protocol-006-PsCARTHA.18.0 +tezos-protocol-007-PsDELPH1.18.0 +tezos-protocol-008-PtEdo2Zk.18.0 +tezos-protocol-008-PtEdoTez.18.0 +tezos-protocol-009-PsFLoren.18.0 +tezos-protocol-010-PtGRANAD.18.0 +tezos-protocol-011-PtHangz2.18.0 +tezos-protocol-012-Psithaca.18.0 +tezos-protocol-013-PtJakart.18.0 +tezos-protocol-014-PtKathma.18.0 +tezos-protocol-015-PtLimaPt.18.0 +tezos-protocol-016-PtMumbai.18.0 +tezos-protocol-017-PtNairob.18.0 +tezos-protocol-018-Proxford.18.0 +tezos-protocol-alpha.18.0 +tezos-proxy-server-config.18.0 +tezos-rust-libs.1.6 +tezos-sapling-parameters.1.1.0 +tezt.3.1.1 +tezt-tezos.18.0 +tgls.0.8.6 +time_now.v0.16.0 +timezone.v0.16.0 +tls.0.17.1 +tls-lwt.0.17.1 +topkg.1.0.7 +tsdl.1.0.0 +typerep.v0.16.0 +tyxml.4.6.0 +unstrctrd.0.3 +uri.4.4.0 +uri-sexp.4.4.0 +uucd.15.1.0 +uucp.15.1.0 +uuidm.0.9.8 +uunf.15.1.0 +uuseg.15.1.0 +uutf.1.0.3 +variantslib.v0.16.0 +vector.1.0.0 +vector3.1.0.0 +vg.0.9.4 +webbrowser.0.6.1 +x509.0.16.5 +xdg.3.11.1 +xmlm.1.4.0 +yaml.3.1.0 +yojson.2.1.1 +zarith.1.12 +zarith_stubs_js.v0.16.0 diff --git a/vendor/sherlodoc/test/whole_switch/test.sh b/vendor/sherlodoc/test/whole_switch/test.sh new file mode 100644 index 0000000000..3a310562a4 --- /dev/null +++ b/vendor/sherlodoc/test/whole_switch/test.sh @@ -0,0 +1,8 @@ +odig odoc +mkdir -p packages +cd packages +for PKG in $(ls $OPAM_SWITCH_PREFIX/var/cache/odig/odoc) +do + echo $PKG + dune exec sherlodoc_index -- --format=marshal --db=$PKG.db $(find $OPAM_SWITCH_PREFIX/var/cache/odig/odoc/$PKG -name "*.odocl") 2> $PKG.stderr > $PKG.stdout +done \ No newline at end of file diff --git a/vendor/sherlodoc/www/dune b/vendor/sherlodoc/www/dune new file mode 100644 index 0000000000..b8ea93c04f --- /dev/null +++ b/vendor/sherlodoc/www/dune @@ -0,0 +1,12 @@ +(library + (name www) + (optional) + (libraries lwt cmdliner dream tyxml db db_store query) + (preprocess + (pps ppx_blob)) + (preprocessor_deps + static/bg.jpg + static/favicon.ico + static/packages.csv + static/robots.txt + static/style.css)) diff --git a/vendor/sherlodoc/www/packages.ml b/vendor/sherlodoc/www/packages.ml new file mode 100644 index 0000000000..df8f9d4f85 --- /dev/null +++ b/vendor/sherlodoc/www/packages.ml @@ -0,0 +1,157 @@ +type package = + { category : string + ; name : string + ; description : string + } + +module M = Map.Make (String) + +module S = Set.Make (struct + type t = package + + let compare a b = + String.compare (String.lowercase_ascii a.name) (String.lowercase_ascii b.name) + end) + +let pretty = function + | "ai" -> "Sciences" + | "app" -> "Applications" + | "ascii" -> "Formats: Restricted alphabet" + | "audio" -> "Multimedia: Audio" + | "bap" -> "PLT: Binary Analysis Platform" + | "bench" -> "Benchmarking" + | "bindings" -> "Various bindings" + | "bio" -> "Sciences" + | "build" -> "Tooling: Build systems" + | "chemistry" -> "Sciences" + | "cloud" -> "Cloud" + | "color" -> "Multimedia: Images" + | "compression" -> "Formats: Compression" + | "conf" -> "conf" + | "cordova" -> "Javascript: Cordova" + | "crypto" -> "Cryptography" + | "data" -> "Datastructures" + | "databases" -> "Databases" + | "dns" -> "Network: DNS" + | "document" -> "Formats: Text document" + | "documentation" -> "Tooling: Documentation" + | "email" -> "Network: Email" + | "format" -> "Formats" + | "frp" -> "Reactive programming" + | "graphics2d" -> "Graphics: 2D" + | "graphics3d" -> "Graphics: 3D" + | "gui" -> "GUI" + | "hardcaml" -> "Hardcaml" + | "http" -> "Network: HTTP client" + | "ide" -> "Tooling: IDE" + | "images" -> "Multimedia: Images" + | "interoperability" -> "Interoperability" + | "io" -> "I/O" + | "irc" -> "Network: IRC" + | "irmin" -> "Databases: Irmin" + | "javascript" -> "Javascript" + | "js" -> "Javascript" + | "json" -> "Formats: Json" + | "language" -> "Programming languages" + | "linux" -> "System: Linux" + | "log" -> "Logs" + | "macos" -> "System: Mac Os" + | "maths" -> "Maths" + | "mirage" -> "Mirage" + | "monads" -> "Stdlib monadic" + | "monitor" -> "Monitoring" + | "multimedia" -> "Multimedia" + | "network" -> "Network" + | "notebook" -> "Tooling: Toplevel / Notebook" + | "opam" -> "Tooling: Opam / Packaging" + | "packaging" -> "Tooling: Opam / Packaging" + | "parser" -> "Parsers" + | "plt" -> "PLT" + | "ppx" -> "PPX" + | "prover" -> "Theorem provers" + | "retrocompatibility" -> "Stdlib retrocompatibility" + | "science" -> "Sciences" + | "security" -> "Cryptography" + | "sexp" -> "Formats: Sexp" + | "solver" -> "Constraint solvers" + | "ssh" -> "Network: SSH" + | "stdlib" -> "Stdlib extended" + | "system" -> "System" + | "terminal" -> "Terminal" + | "tests" -> "Testing" + | "text" -> "Text" + | "tezos" -> "Tezos" + | "time" -> "Date and Time" + | "tooling" -> "Tooling" + | "unix" -> "System: Unix" + | "utils" -> "Stdlib complements" + | "variants" -> "OCaml variants" + | "video" -> "Multimedia: Video" + | "web" -> "Web server" + | "windows" -> "System: Windows" + | "xen" -> "Xen" + | "xml" -> "Formats: Xml" + | "" -> "--- TODO ---" + | other -> + Format.printf "TODO: missing category name %S@." other ; + other + +let unescape str = + let str = String.trim str in + let buf = Buffer.create (String.length str) in + for i = 0 to String.length str - 1 do + let chr = str.[i] in + if not (chr = '\'' || chr = '"') then Buffer.add_char buf chr + done ; + Buffer.contents buf + +let parse_str str = + let parse_line acc line = + let package = + match String.split_on_char '\t' line with + | [ category; name; description ] -> + { category = pretty category; name; description = unescape description } + | [ name; description ] -> + { category = pretty ""; name; description = unescape description } + | _ -> failwith (Printf.sprintf "invalid package: %s" line) + in + let set = + try M.find package.category acc with + | Not_found -> S.empty + in + let set = S.add package set in + M.add package.category set acc + in + List.fold_left parse_line M.empty + @@ List.filter (( <> ) "") + @@ String.split_on_char '\n' str + +let packages () = parse_str [%blob "www/static/packages.csv"] + +let packages () = + List.fold_left (fun acc p -> M.remove p acc) (packages ()) [ "Tezos"; "conf" ] + +open Tyxml.Html + +let html () = + div + ~a:[ a_class [ "categories" ] ] + (M.bindings (packages ()) + |> List.map (fun (category, packages) -> + div + ~a:[ a_class [ "category" ] ] + [ h3 [ txt (if category = "" then "Not classified" else category) ] + ; div + ~a:[ a_class [ "packages" ] ] + (S.elements packages + |> List.map (fun package -> + a + ~a: + [ a_href ("https://ocaml.org/p/" ^ package.name) + ; a_title package.description + ] + [ txt package.name ])) + ])) + +let html = lazy (html ()) +let html () = Lazy.force html diff --git a/vendor/sherlodoc/www/static/bg.jpg b/vendor/sherlodoc/www/static/bg.jpg new file mode 100644 index 0000000000..748bbcfc45 Binary files /dev/null and b/vendor/sherlodoc/www/static/bg.jpg differ diff --git a/vendor/sherlodoc/www/static/favicon.ico b/vendor/sherlodoc/www/static/favicon.ico new file mode 100644 index 0000000000..3ae37187ff Binary files /dev/null and b/vendor/sherlodoc/www/static/favicon.ico differ diff --git a/vendor/sherlodoc/www/static/packages.csv b/vendor/sherlodoc/www/static/packages.csv new file mode 100644 index 0000000000..be30b8b128 --- /dev/null +++ b/vendor/sherlodoc/www/static/packages.csv @@ -0,0 +1,4013 @@ +ai aifad "AIFAD - Automated Induction of Functions over Algebraic Datatypes" +ai caisar "Implements a caching service for storing arbitrary strings that can be located by string keys" +ai caisar-nnet "NNet parser for CAISAR" +ai caisar-onnx "ONNX parser for CAISAR" +ai caisar-ovo "OVO parser for CAISAR" +ai dsfo "Download (anyhow) and interact (ocaml, utop) with common machine learning datasets." +ai libsvm "LIBSVM bindings for OCaml" +ai libtensorflow "TensorFlow library package" +ai libtorch "LibTorch library package" +ai linwrap "Wrapper on top of liblinear-tools" +ai odnnr "Regressor using a Deep Neural Network" +ai openai-gym "OCaml binding for openai Gym toolkit" +ai tensorflow "TensorFlow bindings for OCaml" +ai torch "PyTorch bindings for OCaml" +app 0install-gtk "Decentralised installation system - GTK UI" +app 0install "The antidote to app-stores" +app advi "Active DVI Dune package!" +app apalogretrieve +app aperf "OCaml tools for loop perforation" +app asak "Partitioning OCaml codes" +app ask "Create/Answer questionnaires" +app ask-integrator "Link questionnaires to an uuid of 'a type" +app benchpress-server "Server and web UI for benchpress" +app benchpress "Tool to run one or more logic programs, on a set of files, and collect the results" +app bibtex2html "BibTeX to HTML translator" +app bigbro "Management tool for hypertext (HTML) documents" +app bnfgen +app bracetax "Simple and deterministic text processing syntax" +app bytepdf "Tool to create PDFs that are also OCaml bytecodes" +app camels "A game about camels" +app caml2html "Produce ready-to-go HTML files" +app certify "CLI utilities for simple X509 certificate manipulation" +app chamo "Chamo is a source code editor, even if it can be used to edit any text file" +app coccinelle "Coccinelle is a C source code matching and transformation engine" +app comby "A tool for structural code search and replace that supports ~every language" +app comby-kernel "A match engine for structural code search and replace that supports ~every language" +app comby-semantic "A match engine for structural code search and replace that supports ~every language" +app conex "Establish trust in community repositories" +app conex-mirage-crypto "Establishing trust in community repositories: crypto provided via mirage-crypto" +app conex-nocrypto "Establishing trust in community repositories: crypto provided via nocrypto" +app csvtool "Command line tool for handling CSV files" +app ctoxml "Parses a C program into Cabs AST and dumps as an XML document" +app diskuvbox "Cross-platform basic set of script commands" +app diy "Tool suite for testing shared memory models" +app doculib "A GUI for tagging and managing document metadata for books, textbooks, or articles" +app dog "A loyal and faithful synchronisation tool that you can rely on." +app doi2bib "Small CLI to get a bibtex entry from a DOI, an arXiv ID or a PubMed ID" +app DrawGrammar "Draw railroad diagrams of EBNF grammars" +app elasticsearch-cli "Command-line client for Elasticsearch" +app elf2json "Converts an ELF binary to a JSON representation" +app freetennis "Free Tennis, a free tennis simulation." +app fury-puyo "Fury Puyo is a free clone of the Puyo Puyo game." +app gadelac "Preprocessor for the Game Description Language." +app gappa "Tool intended for formally proving properties on numerical programs dealing with floating-point or fixed-point arithmetic" +app hxd "Hexdump in OCaml" +app lab "GitLab cli" +app learn-ocaml-client "The learn-ocaml client" +app learn-ocaml "The learn-ocaml online platform (engine)" +app ledit "Line editor, a la rlwrap" +app merge-fmt "Git mergetool leveraging code formatters" +app mpp "MPP is both a preprocessor and a meta preprocessor" +app nebula "DCPU-16 emulator" +app ocal "An improved Unix `cal` utility" +app ocaml-probes "USDT probes for OCaml: command line tool" +app oclaunch "Command-line program allowing you to launch program on a human basis. Don't let a clock plan things!" +app opass "A simple command line tool for storing, retreiving," +app opomodoro "A simple Pomodoro timer" +app orpie "Curses-based RPN calculator" +app otetris "Tetris game implemented in OCaml language." +app owork "A productivity timer for focusing on work" +app pardi "Parallel execution of command lines, pardi!" +app passmakercmd "Command line utility for generating memorable passphrases" +app planets "A simple interactive program for playing with simulations of planetary systems" +app tcalc "Minimal desktop calculator for timestamps" +app telltime "Cli tool for interacting with Daypack-lib components" +app tldr "An ocaml tldr client" +app tryocaml "Easiest way to learn how to code in OCaml language" +app valentine "Validate HTML from command line" +app vimebac "Vimebac is graphical metronome and instructions display that interfaces with JACK-midi applications" +app wyrd "Text-based front-end to Remind, a sophisticated calendar and alarm program" +ascii ascii85 +ascii base32 "Base32 encoding for OCaml" +ascii base58 "Base58 encoding and decoding" +ascii base64 "Base64 encoding for OCaml" +ascii hex_encode "Hexadecimal encoding library" +ascii hex "Library providing hexadecimal converters" +ascii hexstring "A library to encode to and decode from hexadecimal strings" +ascii pp-binary-ints "Pretty Printing Binary Integers" +audio aacplus +audio alsa +audio ao +audio bjack +audio cue_sheet_maker "A library to create cue sheet" +audio dssi "Bindings for the DSSI API which provides audio synthesizers" +audio faad "Bindings for the faad library which provides functions for decoding AAC audio files" +audio fdkaac "Fraunhofer FDK AAC Codec Library" +audio flac "Bindings to libflac" +audio ladspa "Bindings for the LADSPA API which provides audio effects" +audio lame "MP3 encoding library" +audio lastfm "The lastfm library is an implementation of the API used by the last.fm to keep count of played songs" +audio lilv "Bindings to lilv library for using LV2 audio plugins" +audio mad "Mad decoding library" +audio misuja "A library to drive the MIDI system of the Jack Audio Connection Kit." +audio mkaudio "CLI program for generating audio files" +audio ml2mxml "Generate musicxml files from OCaml" +audio mpg123 "MP3 decoding library" +audio ogg "Bindings to libogg" +audio opus "Bindings to libopus" +audio osc-lwt "OpenSoundControl Lwt library" +audio osc "OpenSoundControl core library" +audio osc-unix "OpenSoundControl Unix library" +audio portaudio +audio portaudio_c_bindings "Bindings to the C PortAudio library" +audio portmidi "Bindings to libportmidi" +audio pulseaudio "Bindings to Pulseaudio client library" +audio samplerate "Samplerate audio conversion library" +audio sdl-liquidsoap "Virtual package installing liquidsoap's sdl dependencies" +audio shine "Fixed-point MP3 encoder" +audio soundtouch +audio speex "Bindings to libspeex" +audio vecosek "" +audio vecosek-engine "" +audio vecosek-scene "" +audio voaacenc "Bindings for the voaacenc library to encode audio files in AAC format" +audio vorbis "Bindings to libvorbis" +audio xmlplaylist "Library to parse various file playlists in XML format" +bap bap-abi "BAP ABI integration subsystem" +bap bap-analyze "Implements the analyze command" +bap bap-api "A pass that adds parameters to subroutines based on known API" +bap bap-arm "BAP ARM lifter and disassembler" +bap bap-beagle "BAP obfuscated string solver" +bap bap-beagle-strings "Finds strings of characters using microexecution" +bap bap-bil "Controls the BIL transformation pipeline" +bap bap "Binary Analysis Platform" +bap bap-build "BAP build automation tools" +bap bap-bundle "BAP bundler" +bap bap-byteweight "BAP facility for indentifying code entry points" +bap bap-byteweight-frontend "BAP Toolkit for training and controlling Byteweight algorithm" +bap bap-cache "BAP caching service" +bap bap-c "A C language support library for BAP" +bap bap-callgraph-collator "Collates programs based on their callgraphs" +bap bap-callsites "Inject data definition terms at callsites" +bap bap-constant-tracker "Constant Tracking Analysis based on Primus" +bap bap-core "Binary Analysis Platform" +bap bap-core-theory "BAP Semantics Representation" +bap bap-cxxfilt "A demangler that relies on a c++filt utility" +bap bap-dead-code-elimination "A BAP plugin that removes dead IR code" +bap bap-demangle "Provides names service and demangling facilities" +bap bap-dependencies "Analyzes program dependencies" +bap bap-disassemble "Implements the disassemble command" +bap bap-dump-symbols "BAP plugin that dumps symbols information from a binary" +bap bap-dwarf "BAP DWARF parsing library" +bap bap-elementary "BAP floating point approximations of elementary functions" +bap bap-elf "BAP ELF parser and loader written in native OCaml" +bap bap-emacs-dot +bap bap-emacs-goodies "A collection of useful Emacs tools for BAP" +bap bap-emacs-mode "Emacs major mode for reading and analyzing programs in BAP's IR" +bap bap-extra "Binary Analysis Platform" +bap bap-flatten "A BAP plugin, that translates a program into the flatten form" +bap bap-frames "A data format for storing execution traces" +bap bap-frontc "A C language frontend for based on FrontC library" +bap bap-frontend "BAP frontend" +bap bap-fsi-benchmark "BAP function start identification benchmark game" +bap bap-future "A library for asynchronous values" +bap bap-ghidra "BAP Ghidra backend" +bap bap-glibc-runtime "Detects the presence of glibc runtime" +bap bap-ida "An IDA Pro integration library" +bap bap-ida-plugin "Plugins for IDA and BAP integration" +bap bap-ida-python "A BAP - IDA Pro integration library" +bap bap-knowledge "Knowledge Representation Library" +bap bap-llvm "BAP LLVM backend" +bap bap-main "Build BAP Main Framework Configuration Library" +bap bap-mc "BAP machine instruction playground" +bap bap-microx "A micro execution framework" +bap bap-mips "BAP MIPS lifter" +bap bap-objdump "Extract symbols from binary, using binutils objdump" +bap bap-optimization "A BAP plugin that removes dead IR code" +bap bap-patterns "Applies semantic actions to the matching byte patterns" +bap bap-phoenix "BAP plugin that dumps information in a phoenix decompiler format" +bap bap-piqi "BAP plugin for serialization based on piqi library" +bap bap-plugins "BAP plugins support library" +bap bap-powerpc "BAP PowerPC lifter" +bap bap-primus-dictionary "BAP Primus Lisp library that provides dictionaries" +bap bap-primus-exploring-scheduler "Evaluates all machines, prioritizing the least visited" +bap bap-primus-greedy-scheduler "Evaluates all machines in the DFS order" +bap bap-primus-limit "Ensures termination by limiting Primus machines" +bap bap-primus-lisp "BAP Primus Lisp Runtime" +bap bap-primus-loader "Generic program loader for Primus" +bap bap-primus-mark-visited "Registers the bap:mark-visited component" +bap bap-primus-powerpc "Performs the PowerPC target specific setup" +bap bap-primus-print "Prints Primus states and observations" +bap bap-primus-promiscuous "Enables the promiscuous mode of execution" +bap bap-primus-propagate-taint "A compatibility layer between different taint analysis frameworks" +bap bap-primus-random "Provides components for Primus state randomization" +bap bap-primus-region +bap bap-primus-round-robin-scheduler "Evaluates all machines in the BFS order" +bap bap-primus-support "Provides supporting components for Primus" +bap bap-primus-symbolic-executor "Primus Symbolic Executor" +bap bap-primus-systems "Loads Primus systems and registers them in the system repository" +bap bap-primus-taint "A taint analysis control interface" +bap bap-primus-test "BAP Primus Testing and Program Verification module" +bap bap-primus "The BAP Microexecution Framework" +bap bap-primus-track-visited "Tracks basic blocks visited by Primus" +bap bap-primus-wandering-scheduler "Evaluates all machines while" +bap bap-primus-x86 "The x86 CPU support package for BAP Primus CPU emulator" +bap bap-print "Print plugin - print project in various formats" +bap bap-radare2 "Extract symbols from binary using radare2" +bap bap-raw "Provides a loader for raw binaries" +bap bap-recipe-command "Provides commands to manipulate the recipe subsystem" +bap bap-recipe "Stores command line parameters and resources in a single file" +bap bap-relation "A set of relations (bimap)" +bap bap-relocatable "Extracts symbolic information from the program relocations" +bap bap-report "A BAP plugin that reports program status" +bap bap-riscv "BAP RISCV lifter and disassembler" +bap bap-run "A BAP plugin that executes a binary" +bap bap-saluki +bap bap-server "BAP RPC server" +bap bap-signatures "A data package with binary signatures for BAP" +bap bap-specification "Implements the specification command" +bap bap-ssa "A BAP plugin, that translates a program into the SSA form" +bap bap-std "The Binary Analysis Platform Standard Library" +bap bap-strings "Text utilities useful in Binary Analysis and Reverse Engineering" +bap bap-stub-resolver "Identifies and manages stub functions in a binary" +bap bap-symbol-reader "BAP plugin that reads symbol information from files" +bap bap-systemz "A target support package for the Systemz (Z9) ISA" +bap bap-taint "BAP Taint Analysis Framework" +bap bap-taint-propagator "BAP Taint propagation engine using based on microexecution" +bap bap-term-mapper "A BAP DSL for mapping program terms" +bap bap-thumb "A target support package for the Thumb instruction set" +bap bap-toplevel "BAP toplevel, baptop" +bap bap-trace "A plugin to load and run program execution traces" +bap bap-traces "BAP Library for loading and parsing execution traces" +bap bap-trivial-condition-form "Eliminates complex conditionals in branches" +bap bap-veri "BAP verification tool" +bap bap-warn-unused +bap bap-x86 "BAP x86 lifter" +bap bare "BAP Rule Engine Library" +bap cbat-explicit-edge "VSA-based CFG edge reconstruction made in bap ecosystem" +bap cbat-tools "Program analysis tools developed at Draper on the CBAT project" +bap cbat-vsa "Value set analysis made in bap ecosystem" +bap cwe_checker "BAP plugin collection to detect common bug classes" +bap unisim_archisec "UNISIM-VP DBA decoder" +bench bechamel-js "HTML generator for bechamel's output" +bench bechamel-notty "CLI generator for bechamel's output" +bench bechamel-perf "Linux perf's metrics for bechamel" +bench bechamel "Yet Another Benchmark in OCaml" +bench bench "A benchmarking tool for statistically valid benchmarks" +bench benchmark "Benchmark running times of code" +bench core_bench "Benchmarking library" +bench core_profiler "Profiling library" +bench operf-macro "Macro benchmarking tool" +bench operf-micro "Simple tool for benchmarking the OCaml compiler" +bench orun "Run benchmarks and measure performance" +bench pa_bench "Syntax extension for inline benchmarks" +bench rungen "Generates dune files to run benchmarks from centralised config" +bindings fontforge-of-ocaml "OCaml binding of FontForge" +bindings fzf "A library for running the fzf command line tool" +bindings gemini "OCaml bindings for Gemini Trading Exchange API" +bindings geoip "Bindings to GeoIP database library." +bindings github-data "GitHub APIv3 data library" +bindings github "GitHub APIv3 OCaml library" +bindings github-hooks "GitHub API web hook listener library" +bindings github-hooks-unix "GitHub API web hook listener library using unix functions" +bindings github-jsoo "GitHub APIv3 JavaScript library" +bindings github-unix "GitHub APIv3 Unix library" +bindings gitlab "GitLab APIv4 OCaml library" +bindings gitlab-jsoo "Gitlab APIv4 OCaml library" +bindings gitlab_pipeline_notifier +bindings gitlab-unix "GitLab APIv4 OCaml library" +bindings hockmd "A library to access hackmd's api" +bindings mmdb "Binding to the MaxMind DB library for GeoIP lookups" +bindings moss "A client for the MOSS plagiarism detection service." +bindings otoggl "Bindings for Toggl API in OCaml" +bindings reddit_api_async "Async connection and utility functions for Reddit's API" +bindings reddit_api_kernel "OCaml types for Reddit's API" +bindings slack-backup "Small tool to backup IM and channels from slack." +bindings slacko "Access the Slack API" +bindings socialpeek "OCaml library to extract social information such as Twitter cards or OpenGraph data from webpages and HTML." +bindings sociaml-facebook-api "Facebook Graph API Client Library for OCaml" +bindings sociaml-oauth-client "OAuth Client Library for Ocaml" +bindings sociaml-tumblr-api "Tumblr API Client Library for OCaml" +bindings sociaml-vcard "vCard library for OCaml" +bindings spotify-cli "CLI program for controlling the Spotify client on Linux and OSX" +bindings spotify-web-api "OCaml bindings to the Spotify web API" +bindings sturgeon "A toolkit for communicating with Emacs" +bindings telegraml "Telegram Bot API for OCaml" +bindings themoviedb "API for TheMovieDb.org website" +bindings wcs-api "SDK for Watson Conversation Service" +bindings wcs "Command line interface for Watson Conversation Service" +bindings wcs-lib "SDK for Watson Conversation Service" +bio biocaml "The OCaml Bioinformatics Library" +bio bio_io +bio biotk "Bioinformatics toolkit" +bio bistro-bio "Bistro workflows for computational biology" +build base-ocamlbuild +build bsdowl "This collection of BSD Make directives aims at providing a highly" +build conjury "Conjury library for OMake" +build dune-action-plugin "[experimental] API for writing dynamic Dune actions" +build dune-build-info "Embed build informations inside executable" +build dune-configurator "Helper library for gathering system configuration" +build dune-deps "Show dependency graph of a multi-component dune project" +build dune-expand "Tool to view ppx-expanded OCaml source files" +build dune "Fast, portable, and opinionated build system" +build dune-glob "Glob string matching language supported by dune" +build dune-private-libs "Private libraries of Dune" +build dune-release "Release dune packages in opam" +build dune-rpc "Communicate with dune using rpc" +build dune-rpc-lwt "Communicate with dune using rpc and Lwt" +build dune-site "Embed locations informations inside executable and libraries" +build dune_watch +build jbuilder +build jenga "Industrial strength, full-featured build system" +build js-build-tools "Collection of tools to help building Jane Street Packages" +build jst-config "Compile-time configuration for Jane Street libraries" +build mybuild "Collection of ocamlbuild plugins (extprot, atdgen, ragel, etc) and utility to generate version from VCS" +build obi "interface to OCaml Build Infrastructure" +build ocamlbuild +build ocamlbuild-atdgen "Atdgen plugin for OCamlbuild" +build ocamlbuild-pkg "An ocamlbuild plugin that helps packaging softwares." +build ocamlbuild-protoc "ocaml-protoc plugin for Ocamlbuild" +build ocaml-makefile "Generic Makefile for building OCaml projects" +build ocb-stubblr "OCamlbuild plugin for C stubs" +build omake "Build system designed for scalability and portability." +build pds "A tool to build Makefiles for Ocaml projects" +build rmlbuild "rmlbuild is a fork of ocamlbuild that handles ReactiveML projets" +build solvuu_build "DEPRECATED. Please use solvuu-build." +build solvuu-build "Solvuu's build system." +chemistry acpc "Chemoinformatics tool for ligand-based virtual screening" +cloud aws "Amazon Web Services SDK" +cloud aws-async "Amazon Web Services SDK bindings for async" +cloud aws-autoscaling "Amazon Web Services SDK bindings to Auto Scaling" +cloud aws-cloudformation "Amazon Web Services SDK bindings to AWS CloudFormation" +cloud aws-cloudtrail "Amazon Web Services SDK bindings to AWS CloudTrail" +cloud aws-cloudwatch "Amazon Web Services SDK bindings to Amazon CloudWatch" +cloud aws-config "Read AWS configuration in OCaml" +cloud aws-ec2 "Amazon Web Services SDK bindings to Amazon Elastic Compute Cloud" +cloud aws-elasticache "Amazon Web Services SDK bindings to Amazon ElastiCache" +cloud aws-elasticloadbalancing "Amazon Web Services SDK bindings to Elastic Load Balancing" +cloud aws-lwt "Amazon Web Services SDK bindings for lwt" +cloud aws-rds "Amazon Web Services SDK bindings to Amazon Relational Database Service" +cloud aws-route53 "Amazon Web Services SDK bindings to Amazon Route 53" +cloud aws-s3-async "Ocaml library for accessing Amazon S3 - Async version" +cloud aws-s3-lwt "Ocaml library for accessing Amazon S3 - Lwt version" +cloud aws-s3 "Ocaml library for accessing Amazon S3" +cloud aws-sdb "Amazon Web Services SDK bindings to Amazon SimpleDB" +cloud aws-sqs "Amazon Web Services SDK bindings to Amazon Simple Queue Service" +cloud aws-ssm "Amazon Web Services SDK bindings to Amazon Simple Systems Management Service" +cloud aws-sts "Amazon Web Services SDK bindings to AWS Security Token Service" +cloud azblob-async "A trivial Azure Blob Storage interface for OCaml" +cloud azblocloud "A trivial Azure Blob Storage interface for OCaml" +cloud azure-cosmos-db "Azure cosmos db interface" +cloud cloudi "OCaml CloudI API" +cloud coclobas "Coclobas is a scheduler for HPC-like jobs accessible through HTTP" +cloud distributed "Library to provide Erlang style distributed computations. This library is inspired by Cloud Haskell" +cloud distributed-lwt "A library to probide a lwt based implementation of Distributed" +cloud distributed-uwt "A library to probide a uwt based implementation of Distributed" +cloud equinoxe "An OCaml wrapper for the Equinix API" +cloud equinoxe-cohttp "Equinoxe with the cohttp-lwt-unix request handler" +cloud equinoxe-hlc "Equinoxe with the http-lwt-client request handler" +cloud gapi-ocaml "A simple OCaml client for Google Services" +cloud google-drive-ocamlfuse "A FUSE filesystem over Google Drive" +cloud libres3 "Amazon S3 compatible server" +cloud vercel "A custom runtime for Vercel.com (Now v2) written in OCaml" +cloud vrt "A setup command line tools to help with development on remote AWS desktops" +color color-brewery "Offer colors palettes and functions to brew colors" +color color "Converts between different color formats" +color spectrum "Library for colour and formatting in the terminal" +compression brotli "Bindings to Google's Brotli compresion algorithm" +compression brozip +compression camlbz2 "Bindings for bzip2" +compression camlzip "Accessing compressed files in ZIP, GZIP and JAR format" +compression clz "Compression support for cohttp-lwt client using decompress" +compression decompress "Implementation of Zlib and GZip in OCaml" +compression ezgzip "Simple gzip (de)compression library" +compression js-lz4 "Barebones bindings for the LZ4 C api" +compression lz4 "Bindings to the LZ4 compression algorithm" +compression lz4_chans "LZ4-compressed binary channels" +compression lzo "Bindings to LZO - a portable lossless data compression library" +compression rfc1951 "Implementation of RFC1951 in OCaml" +compression snappy "Bindings to snappy - fast compression/decompression library" +compression tar "Decode and encode tar format files in pure OCaml" +compression tar-format "Decode and encode tar files" +compression tar-mirage "Read and write tar format files via MirageOS interfaces" +compression tar-unix "Decode and encode tar format files from Unix" +compression zlib "Bindings to the zlib compression library" +compression zstandard "OCaml bindings to Zstandard" +compression zstd "Bindings to zstd compression library" +conf conf-aclocal "Virtual package relying on aclocal" +conf conf-adwaita-icon-theme "Virtual package relying on adwaita-icon-theme" +conf conf-alsa "Virtual package relying on alsa" +conf conf-ao "Virtual package relying on libao" +conf conf-asciidoc "Virtual package relying on asciidoc" +conf conf-autoconf "Virtual package relying on autoconf installation" +conf conf-automake "Virtual package relying on GNU automake" +conf conf-bap-llvm "Virtual package relying on llvm library installation for BAP" +conf conf-binutils "Checks that binutils are installed" +conf conf-bison "Virtual package relying on GNU bison" +conf conf-blas "Virtual package for BLAS configuration" +conf conf-bluetooth "Virtual package for Bluetooth library" +conf conf-bmake "Virtual package relying on a BSD Make compatible program" +conf conf-boost "Virtual package relying on boost" +conf conf-brotli "Virtual package relying on a brotli system installation" +conf conf-cairo "Virtual package relying on a Cairo system installation" +conf conf-capnproto "Virtual package relying on captnproto installation" +conf conf-clang "Virtual package relying on clang" +conf conf-cmake "Virtual package relying on cmake" +conf conf-cosmopolitan "Virtual package relying on APE/Cosmopolitan" +conf conf-cpio "Virtual package relying on cpio" +conf conf-csdp "Virtual package relying on a CSDP binary system installation" +conf conf-c++ "Virtual package relying on the c++ compiler" +conf conf-dbm "Virtual package relying on gdbm" +conf conf-diffutils "Virtual package relying on diffutils" +conf conf-dkml-cross-toolchain "Add findlib toolchains for all installed DKML cross-compilers" +conf conf-dpkg "Virtual package relying on dpkg" +conf conf-dssi "Virtual package relying on dssi" +conf conf-efl "Virtual package relying on the EFL system installation" +conf conf-emacs "Virtual package to install the Emacs editor" +conf conf-env-travis "Detect Travis CI and lift its environment to opam" +conf conf-expat "Virtual package relying on an expat system installation" +conf conf-faad "Virtual package relying on libfaad" +conf conf-ffmpeg "Virtual package relying on FFmpeg" +conf conf-fftw3 "Virtual package relying on a FFTW3 lib system installation" +conf conf-findutils "Virtual package relying on findutils" +conf conf-flex "Virtual package relying on GNU flex" +conf conf-freetype "Virtual package relying on a freetype lib system installation" +conf conf-frei0r "Virtual package relying on frei0r" +conf conf-fswatch "Virtual package relying on libfswatch installation" +conf conf-ftgl "Virtual package relying on an ftgl system installation" +conf conf-fts "Virtual package relying on the fts.h header" +conf conf-gcc "Virtual package relying on the gcc compiler (for C)" +conf conf-gd "Virtual package relying on a libgd system installation" +conf conf-gfortran "Virtual package relying on a gfortran system installation" +conf conf-ghostscript "Virtual package relying on ghostscript" +conf conf-git "Virtual package relying on git" +conf conf-glade "Virtual package relying on a libglade system installation" +conf conf-gles2 "Virtual package relying on a OpenGL ES 2 system installation" +conf conf-glew "Virtual package relying on a GLEW system installation" +conf conf-glfw3 "Virtual package relying on a GLFW3 system installation" +conf conf-glib-2 "Virtual package relying on a system GLib 2 installation" +conf conf-glpk "Virtual package for GLPK (GNU Linear Programming Kit)" +conf conf-gmp-powm-sec +conf conf-gmp "Virtual package relying on a GMP lib system installation" +conf conf-gnomecanvas "Virtual package relying on a Gnomecanvas system installation" +conf conf-gnome-icon-theme3 "Virtual package relying on gnome-icon-theme" +conf conf-gnuplot "Virtual package relying on gnuplot installation" +conf conf-gnutls "Virtual package relying on a gnutls system installation" +conf conf-gobject-introspection "Virtual package relying on a system gobject-introspection installation" +conf conf-goocanvas2 "Virtual package relying on a Goocanvas-2 system installation" +conf conf-gpiod "C libgpiod library for GPIO on recent (>4.8) Linux kernels" +conf conf-graphviz "Virtual package relying on graphviz installation" +conf conf-gsl "Virtual package relying on a GSL lib system installation" +conf conf-gssapi "Virtual package relying on a krb5-gssapi system installation" +conf conf-gstreamer "Virtual package relying on libgstreamer" +conf conf-gtk2 "Virtual package relying on gtk2" +conf conf-gtk3 "Virtual package relying on GTK+ 3" +conf conf-gtksourceview3 "Virtual package relying on a GtkSourceView-3 system installation" +conf conf-gtksourceview "Virtual package relying on a GtkSourceView system installation" +conf conf-guile "Virtual package relying on an GNU Guile system installation" +conf conf-g++ "Virtual package relying on the g++ compiler (for C++)" +conf conf-haveged "Check if havaged is installed on the system" +conf conf-hidapi "Virtual package relying on a hidapi system installation" +conf conf-ida "Checks that IDA Pro is installed" +conf config-file "Small library to define, load and save options files." +conf configuration "Analyse configuration files" +conf configurator "Helper library for gathering system configuration" +conf conf-jack "Virtual package relying on jack" +conf conf-jq "Virtual package relying on jq" +conf conf-ladspa "Virtual package relying on ladspa" +conf conf-lame "Virtual package relying on lame" +conf conf-lapack "Virtual package for LAPACK configuration" +conf conf-leveldb "Virtual package relying on a LevelDB lib system installation" +conf conf-libargon2 "Virtual package relying on libargon2" +conf conf-libbz2 "Virtual package relying on libbz2" +conf conf-libclang "Virtual package relying on the installation of llvm and clang libraries (<= 15.0.x)" +conf conf-libcurl "Virtual package relying on a libcurl system installation" +conf conf-libdw "Virtual package relying on libdw" +conf conf-libevent "Virtual package relying on libevent" +conf conf-libev "High-performance event loop/event model with lots of features" +conf conf-libffi "Virtual package relying on libffi system installation" +conf conf-libflac "Virtual package relying on libFLAC" +conf conf-libfontconfig "Virtual package relying on fontconfig" +conf conf-libfuse "Virtual package relying on FUSE" +conf conf-libgif "Virtual package relying on a libgif system installation" +conf conf-libgsasl "Virtual package relying on a GSASL lib system installation" +conf conf-libjpeg "Virtual package relying on a libjpeg system installation" +conf conf-liblinear-tools "Virtual package relying on liblinear-{train|predict} installation" +conf conf-liblo "Virtual package relying on liblo" +conf conf-liblz4 "Virtual package relying on liblz4 system installation" +conf conf-liblzma "Virtual package relying on liblzma" +conf conf-libMagickCore "Virtual package relying on an ImageMagick system installation" +conf conf-libmagic "Virtual package relying on a libmagic system installation" +conf conf-libmaxminddb "Virtual package relying on a libmaxminddb system installation" +conf conf-libmosquitto "Virtual package relying on a libmosquitto system installation" +conf conf-libmpg123 "Virtual package relying on libmpg123" +conf conf-libnl3 "Virtual package relying on a libnl system installation" +conf conf-libogg "Virtual package relying on libogg" +conf conf-libopus "Virtual package relying on libopus" +conf conf-libpcre2-8 "Virtual package relying on a libpcre2 system installation" +conf conf-libpcre "Virtual package relying on a libpcre system installation" +conf conf-libpng "Virtual package relying on a libpng system installation" +conf conf-libportmidi "Virtual package relying on libportmidi" +conf conf-librsvg2 "Virtual package relying on Librsvg2 system installation" +conf conf-libsamplerate "Virtual package relying on libsamplerate" +conf conf-libseccomp "Virtual package relying on a libseccomp system installation" +conf conf-libsodium "Virtual package relying on a libsodium system installation" +conf conf-libspeex "Virtual package relying on libspeex" +conf conf-libssl "Virtual package relying on an OpenSSL library system installation" +conf conf-libsvm-tools "Virtual package relying on libsvm-tools installation" +conf conf-libsvm "Virtual package relying on libsvm library installation" +conf conf-libtheora "Virtual package relying on libtheora" +conf conf-libtool "Virtual package relying on libtool installation" +conf conf-libudev "Virtual package relying on a libudev system installation" +conf conf-libuv "Virtual package relying on a libuv system installation" +conf conf-libvorbis "Virtual package relying on libvorbis" +conf conf-libwayland "Virtual package relying on libwayland" +conf conf-libX11 "Virtual package relying on an Xlib system installation" +conf conf-libxcb-image "Virtual package relying on xcb-image" +conf conf-libxcb-keysyms "Virtual package relying on xcb-shm" +conf conf-libxcb-shm "Virtual package relying on xcb-shm" +conf conf-libxcb "Virtual package relying on xcb" +conf conf-libxcb-xkb "Virtual package relying on xcb-xkb" +conf conf-libxcursor "Virtual package relying on an libXcursor system installation" +conf conf-libxinerama "Virtual package relying on an libXinerama system installation" +conf conf-libxi "Virtual package relying on an libXi system installation" +conf conf-libxrandr "Virtual package relying on an libXRandR system installation" +conf conf-lilv "Virtual package relying on lilv" +conf conf-linux-libc-dev +conf conf-lldb +conf conf-llvm "Virtual package relying on llvm library installation" +conf conf-lua "Virtual package relying on a Lua system installation" +conf conf-lz4 "Virtual package requiring the lz4 command to be available" +conf conf-m4 "Virtual package relying on m4" +conf conf-mad "Virtual package relying on mad" +conf conf-mariadb +conf conf-mbedtls "Virtual package relying on an mbedtls system installation" +conf conf-mecab "Virtual package relying on MeCab library installation" +conf conf-mesa "Virtual package relying on an mesa system installation" +conf conf-mpfr "Virtual package relying on library MPFR installation" +conf conf-mpi "Virtual package relying on a mpi system installation" +conf conf-mysql "Virtual package relying on a libmysqlclient system installation" +conf conf-nanomsg "Virtual package relying on a nanomsg system installation" +conf conf-nauty "Virtual package relying on nauty" +conf conf-ncurses "Virtual package relying on ncurses" +conf conf-neko "Virtual package relying on a Neko system installation" +conf conf-netsnmp "Package relying on net-snmp libs" +conf conf-nlopt "Virtual package relying on nlopt" +conf conf-nmap "Virtual package relying on nmap installation" +conf conf-npm "Virtual package relying on npm installation" +conf conf-numa "Package relying on libnuma" +conf conf-ode "Virtual package relying on a ODE system installation" +conf conf-oniguruma "Virtual package relying on an Oniguruma system installation" +conf conf-openbabel "Virtual package relying on openbabel library installation" +conf conf-openblas "Virtual package to install OpenBLAS and LAPACKE" +conf conf-opencc0 "Virtual package relying on opencc v0 (libopencc.so.1) installation" +conf conf-opencc1_1 "Virtual package relying on opencc v1.1 (libopencc.so.1.1) installation" +conf conf-opencc1 "Virtual package relying on opencc v1 (libopencc.so.2) installation" +conf conf-openimageio "Virtual package relying on OpenImageIO development package installation" +conf conf-openjdk "Virtual package relying on OpenJDK / Javac" +conf conf-openssl "Virtual package relying on an OpenSSL binary system installation" +conf conformist +conf conf-pam "Virtual package relying on a system installation of PAM" +conf conf-pandoc "Virtual package relying on pandoc installation" +conf conf-pango "Virtual package relying on a Pango system installation" +conf conf-perl-ipc-system-simple "Virtual package relying on perl's IPC::System::Simple" +conf conf-perl-string-shellquote "Virtual package relying on perl's String::ShellQuote" +conf conf-perl "Virtual package relying on perl" +conf conf-pic-switch +conf conf-pixz "Virtual package relying on pixz" +conf conf-pkg-config "Check if pkg-config is installed and create an opam switch local pkgconfig folder" +conf conf-plplot "Virtual package relying on plplot" +conf conf-portaudio "Virtual package relying on portaudio" +conf conf-postgresql "Virtual package relying on a PostgreSQL system installation" +conf conf-ppl +conf conf-protoc "Virtual package to install protoc compiler" +conf conf-pulseaudio "Virtual package relying on pulseaudio" +conf conf-python-2-7-dev +conf conf-python-2-7 "Virtual package relying on Python-2.7 installation" +conf conf-python-3-7 "Virtual package relying on Python >=3.7 installation" +conf conf-python-3-dev "Virtual package relying on Python 3 development package installation" +conf conf-python-3 "Virtual package relying on Python-3 installation" +conf conf-python3-yaml "Virtual package relying on PyYAML" +conf conf-qt "Installation of Qt5 using APT packages or from source" +conf conf-radare2 "Checks that radare2 is installed" +conf conf-rdkit "Virtual package relying on rdkit library installation" +conf conf-r-mathlib +conf conf-rocksdb "Virtual package relying on a system installation of RocksDB" +conf conf-ruby "Virtual package relying on Ruby" +conf conf-rust-2018 "Virtual package relying on cargo (rust build system)" +conf conf-rust-2021 "Virtual package relying on cargo (rust build system)" +conf conf-rust "Virtual package relying on cargo (rust build system)" +conf conf-r "Virtual package relying on the R interpreter" +conf conf-samplerate "Virtual package relying on samplerate" +conf conf-sdl2-image "Virtual package relying on a sdl2-image system installation" +conf conf-sdl2-mixer "Virtual package relying on a sdl2-mixer system installation" +conf conf-sdl2-net "Virtual package relying on a sdl2-net system installation" +conf conf-sdl2-ttf "Virtual package relying on a sdl2-ttf system installation" +conf conf-sdl2 "Virtual package relying on a SDL2 system installation" +conf conf-sdl-gfx "Virtual package relying on a sdl-gfx system installation" +conf conf-sdl-image "Virtual package relying on a sdl-image system installation" +conf conf-sdl-mixer "Virtual package relying on a sdl-mixer system installation" +conf conf-sdl-net "Virtual package relying on a sdl-net system installation" +conf conf-sdl-ttf "Virtual package relying on a sdl-ttf system installation" +conf conf-sdpa "Virtual package relying on a SDPA binary system installation" +conf conf-secp256k1 "Virtual package relying on a secp256k1 lib system installation" +conf conf-sfml2 "Virtual package relying on a SFML2 system installation" +conf conf-shine "Virtual package relying on libshine" +conf conf-snappy "Virtual package relying on snappy" +conf conf-soundtouch "Virtual package relying on soundtouch" +conf conf-sqlite3 "Virtual package relying on an SQLite3 system installation" +conf conf-srt-gnutls "Virtual package relying on srt build with gnutls" +conf conf-srt-openssl "Virtual package relying on srt compiled with openssl" +conf conf-srt "Virtual package relying on srt" +conf conf-sundials "Virtual package relying on sundials" +conf conf-swi-prolog "Virtual package to install the swi-prolog interpreter" +conf conf-taglib "Virtual package relying on taglib" +conf conf-tcl "Virtual package relying on tcl" +conf conf-texlive "Virtual package relying on texlive / pdflatex" +conf conf-tidy "Virtual package relying on libtidy installation" +conf conf-timeout "Virtual package relying on the \"timeout\" command" +conf conf-time "Virtual package relying on the \"time\" command" +conf conf-tk "Virtual package relying on tk" +conf conf-tree-sitter "Check if tree-sitter is installed" +conf conf-trexio "Virtual package relying on trexio library installation" +conf conf-tzdata "Virtual package relying on tzdata" +conf conf-vim "Virtual package to install the Vim editor" +conf conf-wayland-protocols "Virtual package relying on wayland-protocols" +conf conf-wget "Virtual package relying on wget" +conf conf-which "Virtual package relying on which" +conf conf-wxwidgets +conf conf-xen +conf conf-xkbcommon "Virtual package relying on xkbcommon" +conf conf-xxhash "Virtual package relying on a xxhash system installation" +conf conf-zig "Virtual package relying on zig" +conf conf-zlib "Virtual package relying on zlib" +conf conf-zmq "Virtual package relying on zmq library installation" +conf conf-zstd "Virtual package relying on zstd" +cordova cordova "Binding OCaml to cordova Javascript object." +cordova cordova-plugin-activity-indicator +cordova cordova-plugin-background-mode "Binding to cordova-plugin-background-mode using gen_js_api." +cordova cordova-plugin-barcode-scanner "Binding OCaml to cordova-plugin-barcode-scanner using gen_js_api." +cordova cordova-plugin-battery-status "Binding OCaml to cordova-plugin-battery-status using gen_js_api." +cordova cordova-plugin-camera "Binding OCaml to cordova-plugin-camera using gen_js_api." +cordova cordova-plugin-clipboard "Binding OCaml to cordova-plugin-clipboard using gen_js_api." +cordova cordova-plugin-datepicker "Binding OCaml to cordova-plugin-datepicker using gen_js_api." +cordova cordova-plugin-device "Binding OCaml to cordova-plugin-device using gen_js_api." +cordova cordova-plugin-device-motion "Binding OCaml to cordova-plugin-device-motion using gen_js_api." +cordova cordova-plugin-device-orientation +cordova cordova-plugin-dialogs "Binding OCaml to cordova-plugin-dialogs using gen_js_api." +cordova cordova-plugin-email-composer "Binding OCaml to cordova-plugin-email-composer using gen_js_api." +cordova cordova-plugin-fcm "Binding OCaml to cordova-plugin-fcm using gen_js_api." +cordova cordova-plugin-file "Binding OCaml to cordova-plugin-file using gen_js_api." +cordova cordova-plugin-file-opener "Binding OCaml to cordova-plugin-file-opener using gen_js_api." +cordova cordova-plugin-file-transfer "Binding OCaml to cordova-plugin-file-transfer using gen_js_api." +cordova cordova-plugin-geolocation "Binding OCaml to cordova-plugin-geolocation using gen_js_api." +cordova cordova-plugin-globalization "Binding OCaml to cordova-plugin-globalization using gen_js_api." +cordova cordova-plugin-image-picker "Binding OCaml to cordova-plugin-image-picker using gen_js_api." +cordova cordova-plugin-inappbrowser "Binding OCaml to cordova-plugin-inappbrowser using gen_js_api." +cordova cordova-plugin-insomnia "Binding OCaml to cordova-plugin-insomnia using gen_js_api." +cordova cordova-plugin-keyboard "Binding OCaml to cordova-plugin-keyboard using gen_js_api." +cordova cordova-plugin-loading-spinner "Binding OCaml to cordova-plugin-loading-spinner using gen_js_api." +cordova cordova-plugin-local-notifications "Binding to cordova-plugin-local-notifications using gen_js_api." +cordova cordova-plugin-media "Binding OCaml to cordova-plugin-media using gen_js_api." +cordova cordova-plugin-media-capture "Binding OCaml to cordova-plugin-media-capture using gen_js_api." +cordova cordova-plugin-network-information +cordova cordova-plugin-progress "Binding OCaml to cordova-plugin-progress using gen_js_api." +cordova cordova-plugin-push-notifications "Binding OCaml to phonegap-plugin-push using gen_js_api." +cordova cordova-plugin-qrscanner "Binding OCaml to cordova-plugin-qrscanner using gen_js_api." +cordova cordova-plugin-screen-orientation +cordova cordova-plugin-sim-card "Binding OCaml to cordova-plugin-sim-card using gen_js_api." +cordova cordova-plugin-sms "Binding OCaml to cordova-plugin-sms using gen_js_api." +cordova cordova-plugin-social-sharing "Binding OCaml to cordova-plugin-x-socialsharing using gen_js_api." +cordova cordova-plugin-statusbar "Binding OCaml to cordova-plugin-statusbar using gen_js_api." +cordova cordova-plugin-toast "Binding OCaml to cordova-plugin-toast using gen_js_api." +cordova cordova-plugin-touch-id "Binding OCaml to cordova-plugin-touch-id using gen_js_api." +cordova cordova-plugin-vibration "Binding OCaml to cordova-plugin-vibration using gen_js_api." +cordova cordova-plugin-videoplayer "Binding OCaml to cordova-plugin-videoplayer using gen_js_api." +crypto eqaf "Constant-time equal function on string" +crypto ez_hash "Ez hash & crypto utilities" +crypto farmhash "Bindings for Google's farmhash library" +crypto fiat-p256 "Primitives for Elliptic Curve Cryptography taken from Fiat" +crypto gmp-ecm "GMP-ECM library for the Elliptic Curve Method (ECM) for integer factorization" +crypto gsasl "Bindings ot the GNU SASL library using Ctypes" +crypto hacl-star "OCaml API for EverCrypt/HACL*" +crypto hacl-star-raw "Auto-generated low-level OCaml bindings for EverCrypt/HACL*" +crypto hacl "Tezos binding for Hacl*" +crypto hacl_x25519 +crypto hkdf "HMAC-based Extract-and-Expand Key Derivation Function (RFC 5869)" +crypto ibx "OCaml implementation of the Interactive Brokers TWS API" +crypto jwt "Implementation of JWT in OCaml." +crypto jwto "JWT encoding, decoding and verification" +crypto key-parsers "Parsers for multiple key formats" +crypto ledgerwallet "Ledger wallet library for OCaml" +crypto ledgerwallet-tezos "Ledger wallet library for OCaml: Tezos app" +crypto letsencrypt "ACME implementation in OCaml" +crypto letsencrypt-app "ACME implementation in OCaml" +crypto letsencrypt-dns "DNS solver for ACME implementation in OCaml" +crypto lt-code "OCaml implementation of a Luby Transform code" +crypto mec "Mec - Mini Elliptic Curve library" +crypto monocypher "OCaml bindings to the Monocypher cryptographic library" +crypto murmur3 "bindings for murmur3 hash implementation" +crypto nocoiner "A Commitment Scheme library for Coin Flipping/Tossing algorithms and sort" +crypto nocrypto "Simpler crypto" +crypto noise "The Noise Protocol Framework" +crypto otr "Off the record implementation purely in OCaml" +crypto passmaker "Library for generating memorable passphrases" +crypto pbkdf "Password based key derivation functions (PBKDF) from PKCS#5" +crypto pkcs11-cli "Cmdliner arguments to initialize a PKCS#11 session" +crypto pkcs11-driver "Bindings to the PKCS#11 cryptographic API" +crypto pkcs11 "PKCS#11 OCaml types" +crypto pkcs11-rev "Reverse bindings to pkcs11" +crypto proverifdoc "Documentation for ProVerif, a cryptographic protocol verifier in the symbolic model" +crypto proverif "ProVerif: Cryptographic protocol verifier in the symbolic model" +crypto randoml "Generating cryptographically-secure random numbers" +crypto rfc6287 "OCRA (OATH Challenge-Response Algorithm) implementation in OCaml" +crypto rfc7748 "Edwards Curves X25519 and X448 from RFC 7748" +crypto safepass "Facilities for the safe storage of user passwords" +crypto salsa20-core "The Salsa20 core functions, in OCaml" +crypto salsa20 "Salsa20 family of encryption functions, in pure OCaml" +crypto scrypt +crypto scrypt-kdf "The scrypt Password-Based Key Derivation Function" +crypto secp256k1 "Elliptic curve library secp256k1 wrapper for Ocaml" +crypto secp256k1-internal +crypto sha "Binding to the SHA cryptographic functions" +crypto sid "Handle security identfiers" +crypto sodium "Binding to libsodium UNAUDITED" +crypto sodium-fmt "Fmt formatters for Sodium" +crypto spoke "SPAKE+EE implementation in OCaml" +crypto statverif "StatVerif: automated verifier for cryptographic protocols with state, based on ProVerif" +crypto ttweetnacl "Thin bindings to TweetNaCl cryptography for OCaml" +crypto twostep "HOTP and TOTP algorithms for 2-step verification (for OCaml)" +crypto u2f "Universal Second Factor (U2F) implementation in OCaml" +crypto uecc "Bindings for ECDH and ECDSA for 8-bit, 32-bit, and 64-bit processors" +crypto webauthn "WebAuthn - authenticating users to services using public key cryptography" +crypto x509 "Public Key Infrastructure (RFC 5280, PKCS) purely in OCaml" +crypto xoshiro "Xoshiro PRNGs as drop-in replacements for Stdlib.Random" +crypto xxhash "Bindings for xxHash, an extremely fast hash algorithm" +crypto zxcvbn "Bindings for the zxcvbn password strength estimation library" +data aches "Cache (bounded-size stores) for in-memory values and for resources" +data aches-lwt "Cache (bounded-size stores) for Lwt promises" +data agrep "String searching with errors" +data agrid "Adjustable grid (two dimensional array) library" +data aliases "In memory indexes" +data anthill "Word search library and utility" +data anycache-async "Scan-resistant LRU/2Q cache" +data anycache-lwt "Scan-resistant LRU/2Q cache" +data anycache "Scan-resistant LRU/2Q cache" +data art "Adaptive Radix Tree" +data asetmap "Alternative, compatible, OCaml standard library Sets and Maps" +data astring """Alternative String module for OCaml""" +data bag "Bags (aka multisets)" +data balancer "A collection of load balancing algorithms implemented in pure Ocaml" +databases ahrocksdb "A binding to RocksDB" +databases ancient "Use data structures larger than available memory" +databases arakoon +databases baardskeerder "Baardskeerder is an append-only B-ish tree." +databases cache "Implements a caching service for storing arbitrary strings that can be located by string keys" +databases camltc "OCaml bindings for tokyo cabinet" +databases caqti-async "Async support for Caqti" +databases caqti-driver-mariadb "MariaDB driver for Caqti using C bindings" +databases caqti-driver-postgresql "PostgreSQL driver for Caqti based on C bindings" +databases caqti-driver-sqlite3 "Sqlite3 driver for Caqti using C bindings" +databases caqti-dynload "Dynamic linking of Caqti drivers using findlib.dynload" +databases caqti-lwt "Lwt support for Caqti" +databases caqti-type-calendar "Date and time field types using the calendar library" +databases caqti "Unified interface to relational database libraries" +databases dbforge "A tool to describe database schemas and generate OCaml code to access these databases." +databases dbm "Binding to the NDBM/GDBM Unix \"databases\"" +databases dokeysto_camltc "The dumb OCaml key-value store w/ tokyocabinet backend" +databases dokeysto_lz4 "The dumb OCaml key-value store w/ LZ4 compression" +databases dokeysto "The dumb OCaml key-value store" +databases esgg "Elasticsearch guided (code) generator" +databases ez_pgocaml "A simple library to work with pgocaml" +databases ezsqlite "Simplified SQLite3 bindings for OCaml" +databases freetds "Binding to the FreeTDS library" +databases gensqlite "A ppx preprocessor to generate SQLite3 prepared statements and query functions." +databases git "Git format and protocol in pure OCaml" +databases git-http "Client implementation of the \"Smart\" HTTP Git protocol in pure OCaml" +databases graphql-async "Build GraphQL schemas with Async support" +databases graphql "Build GraphQL schemas and execute queries against them" +databases graphql-cohttp "Run GraphQL servers with `cohttp`" +databases graphql-lwt "Build GraphQL schemas with Lwt support" +databases graphql_parser "Library for parsing GraphQL queries" +databases graphql_ppx "GraphQL PPX rewriter for ReScript/ReasonML" +databases gremlin "Gremlin Client Library" +databases hg_lib "A library that wraps the Mercurial command line interface" +databases hiredis "Redis tools based on the Hiredis C library" +databases hiredis-value "Hiredis Value type" +databases influxdb-async "InfluxDB client library using async for concurrency" +databases influxdb "InfluxDB client library" +databases influxdb-lwt "InfluxDB client library using lwt for concurrency" +databases kafka_async "OCaml bindings for Kafka, Async bindings" +databases kafka_lwt "OCaml bindings for Kafka, Lwt bindings" +databases kafka "OCaml bindings for Kafka" +databases kyotocabinet "OCaml bindings for Kyoto Cabinet DBM" +databases lemonade-sqlite "A monadic interface to sqlite" +databases leveldb "OCaml bindings for Google's LevelDB library" +databases lmdb "Bindings for LMDB, a fast in-file database with ACID transactions" +databases macaque "DSL for SQL Queries in Caml" +databases macaque_lwt "Utils for MaCaQue with Lwt" +databases mariadb "OCaml bindings for MariaDB" +databases metadb "A database for storing and managing file metadata in JSON format" +databases mongo "OCaml driver for MongoDB" +databases mssql "Async SQL Server client using FreeTDS" +databases mysql +databases mysql8 "OCaml interface for mysql-connector-c" +databases mysql_protocol +databases obigstore "Client/server + embeddable semi-structured database." +databases ocamldbi "Database independent layer patterned upon Perl DBI" +databases ocaml_db_model "An Ocaml library and utility for creating modules out of thin air that describe database tables and types, with functions for running queries and commands. Aka database modelling" +databases ocaml_pgsql_model +databases ocp-search "The ocp-search tool to index/search source packages" +databases ocsipersist-dbm "Persistent key/value storage (for Ocsigen) using DBM" +databases ocsipersist-lib "Persistent key/value storage (for Ocsigen) - support library" +databases ocsipersist "Persistent key/value storage (for Ocsigen) using multiple backends" +databases ocsipersist-pgsql "Persistent key/value storage (for Ocsigen) using PostgreSQL" +databases ocsipersist-sqlite "Persistent key/value storage (for Ocsigen) using SQLite" +databases odbc "Interface to various ODBC drivers" +databases ogre "Open Generic REpresentation NoSQL Database" +databases omigrate "Database migrations for Reason and OCaml" +databases orewa "Async-friendly Redis client" +databases orm "The ORM library provides a storage backend to persist ML values." +databases orocksdb "ctypes based bindings for rocksdb" +databases pa_sqlexpr +databases pgocaml "Native OCaml interface to PostgreSQL databases" +databases pgocaml_ppx "PPX extension for PGOCaml" +databases pg_query "Bindings to libpg_query for parsing PostgreSQL" +databases pgx_async "Pgx using Async for IO" +databases pgx_lwt_mirage "Pgx using Lwt on Mirage for IO" +databases pgx_lwt "Pgx using Lwt for IO" +databases pgx_lwt_unix "Pgx using Lwt and Unix libraries for IO" +databases pgx "Pure-OCaml PostgreSQL client library" +databases pgx_unix "PGX using the standard library's Unix module for IO (synchronous)" +databases pgx_value_core "Pgx_value converters for Core types like Date and Time" +databases pgx_value_ptime "Pgx_value converters for Ptime types" +databases phashtbl "Persistent hash table library using dbm under the carpet." +databases plebeia "Functional storage using Merkle Patricia tree" +databases postgres_async "OCaml/async implementation of the postgres protocol (i.e., does not use C-bindings to libpq)" +databases postgresql "Bindings to the PostgreSQL library" +databases prob-cache "Polymorphic probability cache API, including a distributed riak backed cache." +databases rdf_lwt "Sparql HTTP with Lwt" +databases rdf_mysql "Mysql backend for rdf" +databases rdf "Native OCaml implementation of RDF Graphs and Sparql 1.1 Query." +databases rdf_postgresql "Postgresql backend for rdf" +databases rdf_ppx "Syntax extension for rdf" +databases redis-async "Redis client for Async applications" +databases redis-lwt "Redis client (lwt interface)" +databases redis "Redis client" +databases redis-sync "Redis client (blocking)" +databases resp-client """ +databases resp-mirage """ +databases resp "Redis serialization protocol library" +databases resp-server """ +databases resp-unix """ +databases riak "A Riak OCaml client" +databases riakc_ppx "An OCaml riak client with ppx extensions" +databases riakc "Protobuf based Riak client" +databases riak-pb "Riak OCaml Protobuffs library" +databases sanddb "A simple immutable database for the masses" +databases sequoia "Type-safe query builder for OCaml" +databases sqlexpr "Type-safe, convenient SQLite database access." +databases sqlgg "SQL Guided (code) Generator" +databases sqlite3EZ "Thin wrapper for sqlite3-ocaml with a simplified interface" +databases sqlite3 "SQLite3 bindings for OCaml" +databases sqlite3_utils "High-level wrapper around ocaml-sqlite3" +databases traildb "OCaml bindings for TrailDB." +databases trakeva "Transactions, Keys, and Values; with Postgresql and/or Sqlite." +data batch_jaro_winkler "Fast batch jaro winkler distance implementation in C99" +data bentov "1D histogram sketching" +data bheap "Priority queues" +data bimap "An OCaml library implementing bi-directional maps and multi-maps" +data binning "A datastructure to accumulate values in bins" +data bitmasks "BitMasks over int and int64 exposed as sets" +data bitv "A bit vector library for OCaml" +data bitvec "Fixed-size bitvectors and modular arithmetic, based on Zarith" +data bitvec-order "Base style comparators and orders for Bitvec" +data bloomf "Efficient Bloom filters for OCaml" +data bst "Bisector tree implementation in OCaml" +data buffer-pool "A pool of buffers which automatically increases in size as required" +data bwd "Backward lists" +data cactus "A B-Tree based index implementation" +data Camldiets "A highly efficient OCaml set implementation for fat sets, i.e. densely populated sets over a discrete linear order." +data carray "Contiguous arrays in OCaml" +data combinat "Fast combinatorics for OCaml" +data cpm "The Classification and Regression Performance Metrics library" +data crdt-ml "CRDTs - Conflict-Free Replicated Data Types for OCaml" +data DAGaml "DAGaml : Abstract DAG manipulation in OCaml" +data dataframe "A simple and type-safe dataframe api in pure ocaml" +data datalog "An in-memory datalog implementation for OCaml" +data diet "Discrete Interval Encoding Trees" +data dlist "A purely functional list-like data structure supporting O(1) concatenation" +data dmap "A library that implements dependent (heterogeneous) maps" +data enumerators "Finite lazy enumerators" +data fix "Algorithmic building blocks for memoization, recursion, and more" +data flex-array "Flexible arrays" +data fm-simplex-plugin +data fsml "A library for describing and describing synchronous finite state machines" +data fstreams "Functional, lazy, infinite streams." +data funfields "Functional bit field library" +data glicko2 "Implementation of the Glicko2 algorithm" +data gmap "Heterogenous maps over a GADT" +data graphlib "Generic Graph library" +data grenier "A collection of various algorithms in OCaml" +data GuaCaml "GuaCaml : Generic Unspecific Algorithmic in OCaml" +data hamt "Hash Array Mapped Tries" +data hashcons "OCaml hash-consing library" +data hashset "Sets as hash tables" +data hc "Hashconsing library" +data hdr_histogram "OCaml bindings to Hdr Histogram" +data hmap "Heterogeneous value maps for OCaml" +data huffman "An OCaml library to manipulate Huffman trees" +data hweak "An hastable with weak pointer enabling the GC to collect things that are in the hashtable" +data idd "Identity-suppressed decision diagrams (IDDs)" +data idds "Identity-suppressed decision diagrams (IDDs)" +data immutable "Pure Reason implementation of persistent immutable data structures." +data indexmap "Generic indexed data for OCaml" +data interval-map "An immutable interval map data structure" +data ke "Queue implementation" +data knights_tour "Solves the 'Knights Tour' and various 'Poyomino' puzzles" +data lacc "fat-free list accumulators" +data lascar "A library for manipulating Labeled Transition Systems in OCaml" +data lazy-trie "Implementation of lazy prefix trees" +data lockfree "Lock-free data structures for multicore OCaml" +data lru-cache "A simple implementation of a LRU cache." +data lru "Scalable LRU Cache" +data memcpy "Safe and efficient copying between blocks of memory." +data memo "Memoïzation library" +data minivpt "Minimalist vantage point tree implementation in OCaml." +data m_tree "An implementation of M-trees" +data mula "ML's Universal Levenshtein Automata library" +data mvar "Threadsafe mutable variables for Unix threads" +data non_empty_list "A non empty list library for OCaml" +data nullable-array +data ocamlgraph "A generic graph library for OCaml" +data ocamlgraph_gtk "Displaying graphs using OCamlGraph and GTK" +data ocplib-simplex +data odds "Dice roller" +data olinq "LINQ inspired queries on in-memory data" +data ordering "Element ordering" +data oseq "Simple list of suspensions, as a composable lazy iterator that behaves like a value" +data partition_map "Partition maps" +data pomap "Partially Ordered Maps for OCaml" +data prbnmcn-dagger-gsl "Probabilistic programming library: GSL-based samplers" +data prbnmcn-dagger "Probabilistic programming library" +data prbnmcn-dagger-stats "Probabilistic programming library: prbnmcn-stats-based samplers" +data prbnmcn-dagger-test "Probabilistic programming library: tests" +data prbnmcn-mcts "Monte-Carlo tree search based on UCB1 bandits" +data prbnmcn-ucb1 "UCB1 algorithm for multi-armed bandits" +data psq "Functional Priority Search Queues" +data ptmap "Maps of integers implemented as Patricia trees" +data ptset "Sets of integers implemented as Patricia trees" +data radis "Radix tree implementation" +data range "Fold on integer range" +data ranger "A consecutive range slice library for strings, arrays, etc." +data reed-solomon-erasure "OCaml implementation of Reed-Solomon erasure coding" +data reedsolomon "Reed-Solomon Error Correction CODEC" +data res "RES - Library for resizable, contiguous datastructures" +data rfsm "A toolset for describing and simulating StateChart-like state diagrams" +data rhythm "Data Structures and Algorithms implemented in Reason" +data ringo "Bounded-length collections" +data ringo-lwt "Lwt-wrappers for Ringo Cache" +data roman "Manipulate roman numerals (ocaml.org dune/opam tutorial)" +data rope "Ropes (\"heavyweight strings\")" +data safa "Symbolic Algorithms for Finite Automata" +data sd_logic "Functionality for time-based finite state machine" +data searchTree "A module to easily implement search trees" +data sek "An efficient implementation of ephemeral and persistent sequences" +data sequence "Simple and lightweight sequence abstract data type." +data setr "Abstract domain library for sets" +data Snowflake "Snowflake : A Generic Symbolic Dynamic Programming framework" +data sortedseq_intersect "A divide-and-conquer algorithm to intersect sorted sequences" +data spatial_index "Implementation of several spatial indexes (R-tree, etc.)" +data splay_tree "A splay tree implementation" +data splittable_random "PRNG that can be split into independent streams" +data streaming "Fast, safe and composable streaming abstractions" +data string_dict "Efficient static string dictionaries" +data symkat "Symbolic Algorithms for Kleene algebra with Tests (KAT)" +data tdigest "OCaml implementation of the T-Digest algorithm" +data tdk "The Decision Kit is a collection of data structures that are useful for representing functions, relations, and other combinatorial objects" +data topological_sort "Topological sort algorithm" +data topology "A library for working with network topologies." +data tree_layout "Algorithms to layout trees in a pretty manner" +data treeprint "Printing combinator library with automatic parenthese" +data trie "Strict impure trie tree" +data tsort "Easy to use and user-friendly topological sort" +data unionFind "Implementations of the union-find data structure" +data varint +data varray "Resizable arrays with fast insertion/deletion" +data vec "Fast, safe mutable dynamic arrays" +data vector "Resizable Arrays" +data vocal "VOCaL -- The Verified OCaml Library" +data vpt "Vantage point tree implementation in OCaml" +data zlist "Lazy lists for OCaml" +dns dns "An opinionated Domain Name System (DNS) library" +dns dns-async "DNS implementation using the Async concurrency framework" +dns dns-certify "MirageOS let's encrypt certificate retrieval" +dns dns-client "DNS resolver API" +dns dns-cli "Unix command line utilities using uDNS" +dns dns-forward "Library and tools for creating forwarding DNS servers" +dns dns-forward-lwt-unix "Lwt implementation for the `dns-forward` library" +dns dns-lwt "DNS implementation in portable Lwt" +dns dns-lwt-unix "DNS implementation for Unix and Windows using Lwt_unix" +dns dns-mirage "An opinionated Domain Name System (DNS) library" +dns dns-resolver "DNS resolver business logic" +dns dnssec "DNSSec support for OCaml-DNS" +dns dns-server "DNS server, primary and secondary" +dns dns-stub "DNS stub resolver" +dns dns-tsig "TSIG support for DNS" +dns domain-name "RFC 1035 Internet domain names" +documentation argot "An enhanced HTML generator for the ocamldoc tool of the OCaml language" +documentation doc-ock "Extract documentation from OCaml files" +documentation doc-ock-html "From doc-ock to HTML" +documentation doc-ock-xml "XML printer and parser for Doc-Ock" +documentation md2mld "Little cli tool to convert md files into mld files" +documentation mdx "Executable code blocks inside markdown files" +documentation ocamlbrowser "OCamlBrowser Library Explorer" +documentation ocaml-manual "The OCaml system manual" +documentation ocamlspot "OCamlSpotter - OCaml source browsing" +documentation ocamlweb "A literate programming tool for OCaml" +documentation ocp-browser "Console browser for the documentation of installed OCaml libraries" +documentation ocp-index +documentation ocp-index-top "Documentation in the OCaml toplevel" +documentation odig "Lookup documentation of installed OCaml packages" +documentation odoc "OCaml documentation generator" +documentation odoc-parser "Parser for ocaml documentation comments" +documentation qocamlbrowser "OCamlBrowser clone written with OCaml and QtQuick 2" +documentation sphinxcontrib-ocaml "Sphinx extension to document OCaml libraries" +documentation swagger "Swagger 2.0 code generator for OCaml" +documentation swdogen "SWagger DOcumentation GENerator" +document blahcaml "Blahcaml provides basic OCaml bindings to the Blahtex library." +document camlpdf "Read, write and modify PDF files" +document caradoc "Parser and validator of PDF files" +document cmarker "Bindings for a local installation of CMark" +document cmark "OCaml bindings for the CMark Common Markdown parsing and rendering library." +document cpdf "High-level PDF tools based on CamlPDF" +document hevea "A quite complete and fast LATEX to HTML translator" +document htmlfromtexbooks "From TeX To Human-Readable HTML" +document jekyll-format "Jekyll post parsing library" +document kdl "An implementation of the KDL document laguage" +document lambdasoup "Easy functional HTML scraping and manipulation with CSS selectors" +document markdown "Markdown processor for Ocsigen" +document markup "Error-recovering functional HTML5 and XML parsers and writers" +document markup-lwt "Adapter between Markup.ml and Lwt" +document melt "Program LaTeX documents using OCaml" +document ocaml-markdown "This is a transition package, ocaml-markdown is now named markdown." +document octavius "Ocamldoc comment syntax parser" +document omd "A Markdown frontend in pure OCaml" +document polyglot "Filters to convert XHTML into polyglot HTML5" +document stog +document stog_all "Virtual package to install all Stog libraries, tools and plugins" +document stog_asy "Stog plugin to include Asymptote results in documents" +document stog_dot "Stog plugin to generate and include graphviz graphs in documents" +document stog_extern "Stog plugin to pipe documents in external commands" +document stog_markdown "Stog plugin to use markdown syntax" +document tidy "Bindings for libtidy5 -- HTML/XML syntax checker and reformatter" +document wikitext "Wikitext parser" +email colombe "SMTP protocol in OCaml" +email dkim "Implementation of DKIM in OCaml" +email dkim-mirage "Implementation of DKIM in OCaml for MirageOS" +email email_message "E-mail message parser" +email emile "Parser of email address according RFC822" +email facteur "Tool to send an email" +email imaplet-lwt "IMAP server prototype, supports IMAPv4rev1" +email imap "Non-blocking client library for the IMAP4rev1 protocol" +email letters "Client library for sending emails over SMTP" +email maildir "This is a preliminary release of an OCaml library to access directories in the Maildir format." +email milter "OCaml libmilter bindings" +email received "Received field according RFC5321" +email receive-mail "A simple SMTP server for OCaml" +email sendmail "Implementation of the sendmail command" +email sendmail-lwt "Implementation of the sendmail command over LWT" +email smtp "SMTP library with Unix and Lwt backends" +email spf "OCaml bindings for libspf2" +email srs "OCaml bindings for libsrs2" +email tidy_email "An OCaml library that simplifies connecting to email services" +email tidy_email_mailgun "An OCaml library that simplifies connecting to Mailgun's REST API" +email tidy_email_sendgrid +email tidy_email_smtp "An OCaml library that simplifies connecting to SMTP servers" +email uspf "SPF implementation in OCaml" +format amf "Parser/serializer for Adobe's Action Message Format" +format asn1-combinators "Embed typed ASN.1 grammars in OCaml" +format assimp "OCaml bindings to Assimp, Open Asset Import Library" +format atd2cconv +format atdgen +format atdgen-codec-runtime "Runtime for atdgen generated bucklescript converters" +format atdgen-runtime "Runtime library for code generated by atdgen" +format atdj "Java code generation for ATD" +format atd "Parser for the ATD data format description language" +format atdpy "Python/mypy code generation for ATD APIs" +format atds "ATD Code generator for Scala" +format atdts "TypeScript code generation for ATD APIs" +format augeas "Bindings to the Augeas configuration editing tool" +format avro-compiler "Schema compiler for Avro" +format avroc "Read and write Apache Avro files" +format avro "Runtime library for encoding/decoding Avro" +format bare_encoding "BARE encoding, see https://baremessages.org/" +format bech32 "Bech32 addresses for OCaml" +format bencode "Bencode (`.torrent` file format) reader/writer in OCaml" +format binaryen_dsl "Writing Webassembly text format in DSL" +format binaryen "OCaml bindings for Binaryen" +format binbin "Convenient and human-readable bitmap manipulation" +format biniou +format bin_prot "A binary protocol generator" +format bip32 "Hierarchical Deterministic Wallets" +format bitlib "A library for writing binary files" +format bitpack_serializer "This library provides functions for encoding efficiently simple OCaml data" +format bitvec-binprot "Janestreet's Binprot serialization for Bitvec" +format bitvec-sexp "Sexp serializers for Bitvec" +format bookaml "Library for retrieving information about published books" +format bson2 "Bson format encoding/decoding for Ocaml" +format bson "A bson data structure, including encoding/decoding" +format bulletml "Library to manipulate shmup patterns" +format carton-git "Implementation of PACK file in OCaml" +format carton "Implementation of PACKv2 file in OCaml" +format carton-lwt "Implementation of PACK file in OCaml" +format cbor "CBOR encoder/decoder (RFC 7049) - native OCaml implementation" +format cborl "CBOR library" +format cconv "Combinators for Type Conversion in OCaml" +format cconv-ppx "Combinators for Type Conversion in OCaml" +format conan-cli "Identify type of your file (such as the MIME type)" +format conan-database "A database of decision trees to recognize MIME type" +format conan "Identify type of your file (such as the MIME type)" +format conan-lwt "Identify type of your file (such as the MIME type)" +format conan-unix "Identify type of your file (such as the MIME type)" +format cosovo "An OCaml library parsing CSV files" +format csv "A pure OCaml library to read and write CSV files" +format csvfields "Runtime support for ppx_xml_conv and ppx_csv_conv" +format csv-lwt "A pure OCaml library to read and write CSV files, LWT version" +format csvprovider "CSV Type Provider for OCaml" +format cudf "CUDF library (part of the Mancoosi tools)" +format cuid "CUID generator for OCaml" +format data-encoding "Library of JSON and binary encoding combinators" +format dbf "DBF format parsing" +format debian-formats "Parse debian files" +format decoders-bencode "Bencode backend for decoders" +format decoders-cbor "CBOR backend for decoders" +format decoders "Elm-inspired decoders for Ocaml" +format decoders-msgpck "Msgpck backend for decoders" +format depyt "Yet-an-other type combinator library" +format distwit "Distribute/marshal exceptions and extensible variants" +format dose3 "Dose library (part of Mancoosi tools)" +format dose3-extra "Dose-extra libraries and tools (part of Mancoosi tools)" +format dose "Dose library (part of Mancoosi tools)" +format easy_xlsx "A library to easily read XLSX files into a simpler format" +format encore "Library to generate encoder/decoder which ensure isomorphism" +format eris "Encoding for Robust Immutable Storage (ERIS)" +format eris-lwt "Lwt bindings to eris" +format erm_xmpp "XMPP protocol implementation" +format erssical "Converting RSS event feeds to ical" +format extprot "Extensible binary protocols for cross-language communication and long-term serialization" +format faraday "A library for writing fast and memory-efficient serializers" +format faraday-async "Async support for Faraday" +format faraday-lwt "Lwt support for Faraday" +format faraday-lwt-unix "Lwt_unix support for Faraday" +format farfadet "A printf-like for Faraday library" +format fit "A parser for Garmin FIT data files" +format gedcom "GEDCOM parsing." +format gpx "Conversions between XML and GPX (1.1) types." +format gxl-light "Gxl parser and in-place destructive update library" +format hashids "Generate short, unique, non-sequential ids from numbers, that you can also decode" +format hdf5 "Manages HDF5 files used for storing large amounts of data" +format hdf "Bindings for the HDF4 library" +format hdfs "Bindings to libhdfs" +format iso639 "Language Codes for OCaml" +format libbinaryen "Libbinaryen packaged for OCaml" +format lilac "Get the value of any field in a YAML file as a string" +format magic "Bindings for libmagic (to determine the type of files)" +format magic-mime "Map filenames to common MIME types" +format mastodon-archive-viewer "View your Mastodon archive offline" +format mbr-format "A simple library for manipulating Master Boot Records" +format meta_conv "Meta conv, type_conv for various tree data formats" +format mlt_parser "Parsing of top-expect files" +format mrmime "Mr. MIME" +format mrt-format "MRT parsing library and CLI" +format msgpack "Msgpack library for OCaml" +format msgpck "Fast MessagePack (http://msgpack.org) library" +format msgpck-repr "Fast MessagePack (http://msgpack.org) library -- ocplib-json-typed interface" +format multibase "Self-describing base encodings" +format multicodec "Canonical codec of values and types used by various multiformats" +format multicont "Multi-shot continuations in OCaml" +format multihash-digestif "Self-describing Hash Functions using Digestif" +format multihash "Self-describing Hash Functions" +format multipart-form-data "Parser for multipart/form-data (RFC2388)" +format multipart_form-lwt "Multipart-form: RFC2183, RFC2388 & RFC7578" +format multipart_form "Multipart-form: RFC2183, RFC2388 & RFC7578" +format nanoid "Nano ID implementation for OCaml" +format nanomsg "Ctypes based bindings to nanomsg" +format nmea "Nmea parser" +format obeam "A utility library for parsing BEAM format" +format ocaml-data-notation "Store data using OCaml notation (deprecated)" +format ocaml-inifiles "An ini file parser" +format ocaml-protoc-plugin "Plugin for protoc protobuf compiler to generate ocaml definitions from a .proto file" +format ocaml-protoc "Protobuf compiler for OCaml" +format ocamlrss "Library providing functions to parse and print RSS 2.0 files" +format ocf "OCaml library to read and write configuration files in JSON syntax" +format ocf_ppx "Preprocessor for Ocf library" +format ockt "OCaml library for parsing ckt files into hashtables" +format ocplib-config "A simple library to manage configuration files" +format ofx "OCaml parser for OFX files" +format opazl "Library to parse ZNC logs" +format openflow "Serialization and protocol implementation for OpenFlow 1.{0,3}" +format open_packaging "A library for parsing Microsoft's Open Packaging Specification (most commonly used for Microsoft" +format orsetto "A library of assorted structured data interchange languages" +format osm_xml "Library for parsing OpenStreetMap XML dumps." +format otoml "TOML parsing, manipulation, and pretty-printing library (1.0.0-compliant)" +format pa_bin_prot "A binary protocol generator" +format packet "A serialization library for several common packet formats" +format packstream "Packstream parses and serializes Packstream binary format" +format pa_fields_conv +format pcap-format "Decode and encode PCAP (packet capture) files" +format pecu "Encoder/Decoder of Quoted-Printable (RFC2045 & RFC2047)" +format piqilib "The Piqi library -- runtime support for multi-format Protobuf/JSON/XML/Piq data serialization and conversion" +format piqi "Protocol Buffers, JSON and XML serialization system for OCaml" +format plotkicadsch "Utilities to print and compare version of Kicad schematics" +format prettym "An memory-bounded encoder according to RFC 822" +format radare2 "OCaml interface to r2" +format rlp "RLP: Recursive Length Prefix Encoding" +format rss "Library to read and write RSS files" +format scfg "OCaml library and executable to work with the scfg configuration file format" +format semver2 "Semantic version handling for OCaml" +format semver "Semantic versioning module" +format serial "Serial communication module" +format sgf "Parser and pretty printer for SGF files." +format shapefile "A small library to read ESRI shapefiles" +format spdx_licenses "A library providing a strict SPDX License Expression parser" +format spreadsheet "Functor for parsing and building spreadsheets." +format spreadsheetml "A library to parsing SpreadsheetML (used in Microsoft Excel files)" +format stog_multi_doc "Stog plugin to define various documents in one file" +format stog_nocaml "Stog plugin to block commands executing ocaml code" +format stog_noexec "Stog plugin to prevent running command with " +format stog_plugins "Virtual package to install all Stog plugins" +format stog-rdf +format stog-rdf "Plugin for Stog. Define and query RDF graphs in rewrite rules." +format stog_rdf "Stog plugin to generate rdf triples and execute sparql queries" +format stog_rel_href "Stog plugin to generate relative urls" +format stog_server_multi "Stog multi server library" +format stog_server "Stog server library" +format stog_sitemap "Stog plugin to generate a sitemap file" +format stog_writing "Stog plugin to generate table of contents and bibliographies" +format swhid_compute +format swhid_core "OCaml library to work with swhids" +format swhid "OCaml library to work with Software Heritage identifiers" +format swhid_types +format syguslib-utils "SyGuS Lib parser and utils" +format syndic "RSS1, RSS2, Atom and OPML1 parsing" +format syslog-message "Syslog message parser" +format syslog-rfc5424 "Syslog Protocol (RFC5424) parser and pretty-printer" +format SZXX "Streaming ZIP XML XLSX parser" +format taglib "Bindings for the taglib library" +format tcx "OCaml library for parsing and formatting Training Center XML files." +format tip-parser "Parser for https://tip-org.github.io/format.html" +format toml-cconv "Interface between cconv and toml" +format toml_cconv "Interface between cconv and toml" +format toml "Library for TOML with a parser, a serializer and a printer" +format tptp "Library for reading and writing FOF and CNF formulas in TPTP format" +format tracing "Tracing library" +format typebeat "Agnostic parser of the `Content-Type` in OCaml" +format type-beat "A parser for the Content-Type value" +format ulid "ULIDs for OCaml" +format validator "Create a record validator via composable sub-validators" +format vcardgen "Simple OCaml library for generating VCards per RFC-6350" +format vlq "A simple library for encoding variable-length quantities" +format webidl "Web IDL parser" +format yaml "Parse and generate YAML 1.1/1.2 files" +format yaml-sexp "Parse and generate YAML 1.1 files" +format zbar "Binding to ZBar (QR-code scanning library)" +frp cumulus "Differential FRP based on the React library" +frp current_ansi "ANSI escape sequence parser" +frp current_docker "OCurrent Docker plugin" +frp current_examples "Example pipelines for OCurrent" +frp current_git "Git plugin for OCurrent" +frp current_github "GitHub plugin for OCurrent" +frp current_gitlab "GitLab plugin for OCurrent" +frp current_incr "Self-adjusting computations" +frp current_ocluster "OCurrent plugin for OCluster builds" +frp current "Pipeline language for keeping things up-to-date" +frp current_rpc "Cap'n Proto RPC plugin for OCurrent" +frp current_slack "Slack plugin for OCurrent" +frp current_web "Test web UI for OCurrent" +frp froc "Jake Donham's Froc library for functional reactive programming in OCaml." +frp incremental_kernel +frp incremental "Library for incremental computations" +frp incr_map "Helpers for incremental operations on map like data structures." +frp incr_select "Handling of large set of incremental outputs from a single input" +frp note "Declarative events and signals for OCaml" +frp prbnmcn-cgrph "Incremental computation" +frp react "Declarative events and signals for OCaml" +frp reactiveData "Declarative events and signals for OCaml" +frp rml "ReactiveML: a programming language for implementing interactive systems" +frp rtime "Module implementing timelines for React" +graphics2d archimedes "Extensible 2D plotting library" +graphics2d async_graphics "Async wrapper for the OCaml Graphics library" +graphics2d bimage """ +graphics2d bimage-display """ +graphics2d bimage-gtk """ +graphics2d bimage-io """ +graphics2d bimage-lwt """ +graphics2d bimage-sdl """ +graphics2d bimage-unix """ +graphics2d cairo2 "Binding to Cairo, a 2D Vector Graphics Library" +graphics2d cairo2-gtk "Rendering Cairo on Gtk canvas" +graphics2d cairo2-pango "Interface between Cairo and Pango" +graphics2d cairo "Binding to Cairo, a 2D Vector Graphics Library" +graphics2d camlimages "Image processing library" +graphics2d gd "OCaml interface to the GD graphics library." +graphics2d gnuplot "Simple interface to Gnuplot +graphics2d graphicspdf "Version of OCaml's Graphics library which outputs PDFs." +graphics2d graphics "The OCaml graphics library" +graphics2d graphv_core "Functor for creating a new Graphv library based on a font render and backend renderer" +graphics2d graphv_core_lib "Primitives for the Graphv vector graphics library" +graphics2d graphv_font "Functor for generating the Graphv font library" +graphics2d graphv_font_stb_truetype "STB truetype implementation of the font interface for Graphv" +graphics2d graphv_gles2 "Functor for creating a Graphv renderer based on GLES2" +graphics2d graphv_gles2_native "Full version of the Graphv library based on native GLES2" +graphics2d graphv_gles2_native_impl +graphics2d graphv "Top_level graphv package, includes all dependencies" +graphics2d gr "OCaml bindings to the GR plotting library" +graphics2d lilis "Library to Interpret Lindenmayer Systems" +graphics2d matplotlib "Plotting using Matplotlib through python" +graphics2d mlpost-lablgtk "Library for adding mlpost graphics in lablgtk" +graphics2d mlpost "OCaml library on top of Metapost" +graphics2d ocamldot "Parsing and printing graphviz files in OCaml" +graphics2d ocamlsdl2 "Interface to the SDL2 library" +graphics2d ocamlsdl2-ttf "Interface to the SDL2_ttf library" +graphics2d ocamlsdl "Interface between OCaml and SDL" +graphics2d ocb "SVG badge generator" +graphics2d ocsfml "Binding to the C++ SFML gaming library." +graphics2d oplot "Mathematical plotter library for ocaml" +graphics2d osh "OCaml web API to generate SVG shields" +graphics2d otfm "OpenType font decoder for OCaml" +graphics2d patoline "Patoline typesetting system and libraries" +graphics2d pcf-format "parse PCF format X11 bitmap font files" +graphics2d picasso "Abstract elements drawing library" +graphics2d plplot "Bindings for the PLplot library" +graphics2d prbnmcn-gnuplot "Declarative generation of gnuplot scripts" +graphics2d qrc "QR code encoder for OCaml" +graphics2d qrencode "Binding to libqrencode (QR-code encoding library)" +graphics2d raylib "OCaml bindings for raylib" +graphics2d tsdl-image "SDL2_Image bindings to go with Tsdl" +graphics2d tsdl-mixer "SDL2_Mixer bindings to go with Tsdl" +graphics2d tsdl "Thin bindings to SDL for OCaml" +graphics2d tsdl-ttf "SDL2_Ttf bindings to go with Tsdl" +graphics2d vg """Declarative 2D vector graphics for OCaml""" +graphics2d wall "Realtime Vector Graphics with OpenGL" +graphics3d gles3 "OCaml GLES 3.0 bindings" +graphics3d glfw-ocaml "A GLFW binding for OCaml" +graphics3d glMLite "OpenGL bindings for OCaml" +graphics3d glsurf "GlSurf, implicit curves and surfaces drawing and discretization" +graphics3d irrlicht "An OCaml binding for the Irrlicht Engine" +graphics3d lablgl "Interface to OpenGL" +graphics3d mesh-display "Triangular mesh representation using the graphics module" +graphics3d mesh-easymesh "Triangular mesh generation with EasyMesh" +graphics3d mesh-graphics "Triangular mesh representation using the graphics module" +graphics3d mesh-triangle "Binding to the triangle mesh generator" +graphics3d mesh "Triangular mesh generation and manipulation" +graphics3d minilight "Minimal global illumination renderer." +graphics3d OSCADml "OCaml DSL for 3D solid modelling in OpenSCAD" +graphics3d sarek "GPGPU kernel DSL for OCaml" +graphics3d scad_ml "OCaml DSL for 3D solid modelling in OpenSCAD" +graphics3d spoc "High-level GPGPU programming library for OCaml" +graphics3d spoc_ppx "PPX to declare external GPGPU kernels written in CUDA or OpenCL" +graphics3d tgls "Thin bindings to OpenGL {3,4} and OpenGL ES {2,3} for OCaml" +gui bogue "GUI library for ocaml, with animations, based on SDL2" +gui bonsai "A library for building dynamic webapps, using Js_of_ocaml" +gui gtk-light "Light wrapper around lablgtk2" +gui gtktop "A small library to ease the creation of graphical toplevels." +gui lablgtk3-extras +gui lablgtk3-goocanvas2 "OCaml interface to GTK+ GooCanvas library" +gui lablgtk3-gtkspell3 "OCaml interface to GTK+3" +gui lablgtk3 "OCaml interface to GTK+3" +gui lablgtk3-sourceview3 "OCaml interface to GTK+ gtksourceview library" +gui lablgtk-extras +gui lablgtk "OCaml interface to GTK+" +gui lablgtkosx "Lablgtkosx binds gOSX_application on top of lablgtk" +gui lablqml +gui lablqt "Tool for interfacing QtQuick with OCaml" +gui labltk "OCaml interface to Tcl/Tk" +gui lwd "Lightweight reactive documents" +gui raygui "OCaml bindings for raygui" +gui wxOCaml "OCaml bindings to the wxWidgets graphical library" +hardcaml hardcaml-affirm "Verification tools for HardCaml" +hardcaml hardcaml-bloop "Boolean logic tools for HardCaml" +hardcaml hardcaml_c "Hardcaml C Simulation Backend" +hardcaml hardcaml_circuits "Hardcaml Circuits" +hardcaml hardcaml-examples "HardCaml examples designs build using hardcaml-framework" +hardcaml hardcaml_fixed_point "Hardcaml fixed point arithmetic" +hardcaml hardcaml-framework "Framework for generating and simulating HardCaml cores" +hardcaml hardcaml-llvmsim "HardCaml simulation backend using LLVM" +hardcaml hardcaml_of_verilog "Convert Verilog to a Hardcaml design" +hardcaml hardcaml-reedsolomon "HardCaml implementation of Reed-Solomon error correction coding" +hardcaml hardcaml "RTL Hardware Design in OCaml" +hardcaml hardcaml_step_testbench "Hardcaml Testbench Monad" +hardcaml hardcaml_verify "Hardcaml Verification Tools" +hardcaml hardcaml_verilator "Hardcaml Verilator Simulation Backend" +hardcaml hardcaml-vpi "HardCaml Icarus Verilog cosimulation module" +hardcaml hardcaml_waveterm "A terminal based digital waveform viewer for Hardcaml" +hardcaml hardcaml-waveterm "Terminal based digital waveform viewer" +hardcaml hardcaml_xilinx_components "Hardcaml Xilinx component definitions" +hardcaml hardcaml_xilinx "Hardcaml wrappers for Xilinx memory primitives" +hardcaml hardcaml-yosys "Import Verilog designs into HardCaml" +http cohttp "An OCaml library for HTTP clients and servers" +http cohttp-async "CoHTTP implementation for the Async concurrency library" +http cohttp_async_websocket "Websocket library for use with cohttp and async" +http cohttp-lwt "CoHTTP implementation using the Lwt concurrency library" +http cohttp-lwt-jsoo "CoHTTP implementation for the Js_of_ocaml JavaScript compiler" +http cohttp-lwt-unix "CoHTTP implementation for Unix and Windows using Lwt" +http cohttp-lwt-unix-nossl "CoHTTP implementation for Unix and Windows using Lwt" +http cohttp-lwt-unix-ssl "CoHTTP implementation for Unix and Windows using Lwt" +http cohttp-mirage "CoHTTP implementation for the MirageOS unikernel" +http cohttp_static_handler "A library for easily creating a cohttp handler for static files" +http cohttp-top "CoHTTP toplevel pretty printers for HTTP types" +http curly "Curly is a brain dead wrapper around the curl command line utility" +http ezcurl "Friendly wrapper around OCurl" +http ezcurl-lwt "Friendly wrapper around OCurl, Lwt version" +http ezresto "A minimal OCaml library for type-safe HTTP/JSON RPCs" +http ezresto-directory "A minimal OCaml library for type-safe HTTP/JSON RPCs" +http h1_parser "Parser for HTTP 1.1" +http h2 "A high-performance, memory-efficient, and scalable HTTP/2 library for OCaml" +http h2-async "Async support for h2" +http h2-lwt "Lwt support for h2" +http h2-lwt-unix "Lwt + UNIX support for h2" +http h2-mirage "Mirage support for h2" +http hpack "An HPACK (Header Compression for HTTP/2) implementation in OCaml" +http http2https "HTTP to HTTPS redirector daemon" +http httpaf +http httpaf-async "Async support for http/af" +http httpaf_caged "A higher-level httpaf-async server interface" +http httpaf-lwt-unix "Lwt support for http/af" +http http_async "Async library for HTTP/1.1 servers" +http http-cookie "HTTP cookie library for OCaml" +http httph "Minimal OCaml to the httpserver.h http server toolkit" +http http-lwt-client "A simple HTTP client using http/af, h2, and lwt" +http http-multipart-formdata "Http multipart/formdata parser" +http http_router "Simple http router for cohttp and async." +http hyper "Web client with HTTP/1, HTTP/2, TLS, and WebSocket support" +http ocaml-http "Library freely inspired from Perl's HTTP::Daemon module" +http ocurl "Bindings to libcurl" +http openapi "Openapi documentation generation for Opium" +http paf-cohttp "A CoHTTP client with its HTTP/AF implementation" +http paf-le "A CoHTTP client with its HTTP/AF implementation" +http piaf "An HTTP library with HTTP/2 support written entirely in OCaml" +http quests "HTTP/1.1 client library like Python requests" +http session "A session manager for your everyday needs" +http session-cohttp "A session manager for your everyday needs - Cohttp-specific support" +http session-cohttp-async "A session manager for your everyday needs - Cohttp-specific support for Async" +http session-cohttp-lwt "A session manager for your everyday needs - Cohttp-specific support for Lwt" +http session-cookie-async "Session handling for OCaml and ReasonML" +http session-cookie-lwt "Session handling for OCaml and ReasonML" +http session-cookie "Session handling for OCaml and ReasonML" +http session-postgresql "A session manager for your everyday needs - Postgresql-specific support" +http session-postgresql-async "A session manager for your everyday needs - Postgresql-specific support for Async" +http session-postgresql-lwt "A session manager for your everyday needs - Postgresql-specific support" +http session-redis-lwt "A session manager for your everyday needs - Redis-specific support for Lwt" +http sessions +http session-webmachine "A session manager for your everyday needs - Webmachine-specific support" +http terminus "A generic client to interact with Rest API" +http terminus-cohttp "Terminus with the cohttp-lwt-unix request handler" +http terminus-hlc "Terminus with the http-lwt-client request handler" +http uri "An RFC3986 URI/URL parsing library" +http uri-re "An RFC3986 URI/URL parsing library" +http uri-sexp "An RFC3986 URI/URL parsing library" +http uritemplate "OCaml implementation of URI templates (RFC6570)" +http websocketaf +http websocket-async "Websocket library (Async)" +http websocket-lwt-unix "Websocket library (Lwt)" +http websocket-lwt "Websocket library (Lwt)" +http websocketml "A simple websocket library for OCaml with no dependency" +http websocket "Websocket library" +http wget "Basic wget-like client, based on the Citrix' HTTP library." +http ws "Generic websocket implementation for OCaml" +http ws-server "WebSocket server" +ide annot "annotation parser for external editors and IDEs" +ide caml-mode "Caml mode for GNU Emacs" +ide dot-merlin-reader "Reads config files for merlin" +ide gopcaml-mode +ide gopcaml-mode-merlin +ide merlin +ide merlin-acme "Merlin interface for acme." +ide merlin-extend "A protocol to provide custom frontend to Merlin" +ide merlin-lib +ide merlin-of-pds "Simple script that turns a pds.conf into a .merlin file" +ide ocamleditor "OCamlEditor is a GTK+ source code editor and build tool for OCaml" +ide ocaml-lsp-server "LSP Server for OCaml" +ide otags "Tag file generation of OCaml sources (for vi and emacs)" +ide tuareg "OCaml mode for GNU Emacs" +images gavl "Bindings for the gavl library which provides functions for converting images formats, colorspaces, etc." +images imagelib "Library implementing parsing of image formats such as PNG, BMP, PPM" +images imagemagick "Bindings for ImageMagick" +images ocamlsdl2-image "Interface to the SDL2_image library" +images qcow-format "Read and write images in Qcow2 format" +images qcow "Support for Qcow2 images" +images qcow-tool "A command-line tool for manipulating qcow2-formatted data" +images stb_image "OCaml bindings to stb_image, a public domain image loader" +images stb_image_write "OCaml bindings to stb_image_write, a public domain image writer" +images stb_truetype "OCaml bindings to stb_truetype, a public domain font rasterizer" +interoperability alberto "OCaml interface to Erlang ports" +interoperability cppffigen "A C++ foreign-function-interface generator for Ocaml based on C++ STL Containers" +interoperability cstruct "Access C-like structures directly from OCaml" +interoperability cstruct-async "Access C-like structures directly from OCaml" +interoperability cstruct-lwt "Access C-like structures directly from OCaml" +interoperability cstruct-sexp "S-expression serialisers for C-like structures" +interoperability cstruct-unix "Access C-like structures directly from OCaml" +interoperability ctypes-build "Support for building Ctypes bindings." +interoperability ctypes "Combinators for binding to C libraries without writing any C" +interoperability ctypes-foreign "Virtual package for enabling the ctypes.foreign subpackage" +interoperability ctypes_stubs_js "Js_of_ocaml Javascript stubs for the OCaml ctypes library" +interoperability gobject-introspection "OCaml bindings for the GObject-Introspection library (https://gi.readthedocs.io/en/latest/)" +interoperability gperftools "Bindings to gperftools" +interoperability guile "Bindings to GNU Guile Scheme for OCaml" +interoperability jemalloc "Bindings to jemalloc mallctl api" +interoperability lymp "Use Python functions and objects from OCaml" +interoperability mstruct "A mutable interface to Cstruct buffers" +interoperability ocaml-in-python "Effortless Python bindings for OCaml modules" +interoperability ocaml-lua "Lua bindings" +interoperability ocaml-r "Objective Caml bindings for the R interpreter" +interoperability py "Ctypes bindings to Python 3.5 or greater" +interoperability pyml_bindgen "Generate pyml bindings from OCaml value specifications" +interoperability pyml "OCaml bindings for Python" +interoperability pythonlib "A library to help writing wrappers around ocaml code for python" +interoperability randomconv "Convert from random byte vectors (Cstruct.t) to random native numbers" +interoperability swipl "Bindings to SWI-Prolog for OCaml" +interoperability thrift "OCaml bindings for the Apache Thrift RPC system" +io async_core "Monadic concurrency library" +io async_extended "Additional utilities for async" +io async_extra "Monadic concurrency library" +io async_find "Directory traversal with Async" +io async_inotify "Async wrapper for inotify" +io async_kernel "Monadic concurrency library" +io async "Monadic concurrency library" +io async-mvar "Async-mvar is a port of Lwt's Lwt_mvar" +io async_parallel "Distributed computing library" +io async_sendfile "Thin wrapper around [Linux_ext.sendfile] to send full files" +io builder "Scheduling and executing shell jobs" +io builder-web "Web interface for builder" +io command_rpc "Utilities for Versioned RPC communication with a child process over stdin and stdout" +io core-lwt "Lwt library wrapper in the Janestreet core style" +io core_unix "Unix-specific portions of Core" +io datakit-bridge-github "A bidirectional bridge between the GitHub API and Datakit" +io datakit-bridge-local-git "DataKit Local-Git bridge" +io datakit-ci "Continuous Integration service using DataKit" +io datakit-client-9p "A library for Datakit clients over 9P" +io datakit-client "A library to construct Datakit clients" +io datakit-client-git "A library for connecting Datakit client using Git" +io datakit-github "Abstraction of the GitHub API, suitable for DataKit clients" +io datakit "Orchestrate applications using a Git-like dataflow" +io datakit-server-9p "Build Datakit servers using the 9P filesystem protocol" +io datakit-server "A library to write Datakit servers" +io eio "Effect-based direct-style IO API for OCaml" +io eio_linux "Eio implementation for Linux using io-uring" +io eio_luv "Eio implementation using luv (libuv)" +io eio_main "Effect-based direct-style IO mainloop for OCaml" +io eio-ssl "OpenSSL binding to EIO" +io fiber "Structured concurrency library" +io future "Abstraction over Stdlib, Lwt, Async, and more." +io gen_server "An Erlang-like gen_server framework written for Async." +io io-page "Support for efficient handling of I/O memory pages" +io io-page-unix "Support for efficient handling of I/O memory pages on Unix" +io io-page-xen "Support for efficient handling of I/O memory pages on Xen" +io io "Simple, secure and composable abstraction for efficient component" +io lambda_streams_async "Async helpers for lambda_streams" +io lambda_streams "Lambda-based streaming library" +io lambda_streams_lwt "Lwt helpers for lambda_streams" +io lwt-binio "Asynchronous random access IO for numbers" +io lwt_camlp4 "Camlp4 syntax extension for Lwt (deprecated)" +io lwt-canceler "Cancellation synchronization object" +io lwt-dllist "Mutable doubly-linked list with Lwt iterators" +io lwt_domain "Helpers for using Domainslib with Lwt" +io lwt_eio "Run Lwt code within Eio" +io lwt-exit "An opinionated clean-exit and signal-handling library for Lwt programs" +io lwt_glib "GLib integration for Lwt" +io lwt_log "Lwt logging library (deprecated)" +io lwt_named_threads +io lwt-parallel "Lwt-enabled multiprocessing library" +io lwt-pipe "An alternative to `Lwt_stream` with interfaces for producers and consumers and a bounded internal buffer" +io lwt-pipeline "Pipeline library for Lwt" +io lwt_ppx_let "Dummy package context for ppx_let tests" +io lwt_ppx "PPX syntax for Lwt, providing something similar to async/await from JavaScript" +io lwt "Promises and event-driven I/O" +io lwt_react "Helpers for using React with Lwt" +io lwt_ssl "OpenSSL binding with concurrent I/O" +io lwt-watcher "One-to-many broadcast in Lwt" +io lwt-zmq "Lwt-friendly interface to ZeroMQ" +io ocplib-concur "Concurrent wrapper on top of Lwt and Async" +io pipebang "Part of Jane Street’s Core library" +io poll "Portable OCaml interface to macOS/Linux/Windows native IO event notification mechanisms" +io polly "Bindings for the Linux epoll system call" +io release "Release is a multi-process Lwt-enabled daemon framework for OCaml." +io resource_cache "General resource cache" +io resource-pooling "Library for pooling resources like connections, threads, or similar" +io sequencer_table "A table of [Async.Sequencer]'s, indexed by key" +io shared-block-ring "A single-consumer single-producer queue on a block device" +io shuttle_http "HTTP codec for shuttle" +io shuttle "Reasonably performant non-blocking channels for async" +io shuttle_ssl "Async_ssl support for shuttle" +io socket-daemon "Create daemons listening to a socket for stop, restart, ..., orders" +io tube "Typesafe abstraction on top of Lwt_io channels" +io uwt "libuv bindings" +irc calculon "Library for writing IRC bots in OCaml and a collection of plugins" +irc calculon-redis "A redis plugin for Calculon" +irc calculon-redis-lib "A library to interact with Calculon via Redis" +irc calculon-web "A collection of web plugins for Calculon" +irc irc-client "IRC client library - core functionality" +irc irc-client-lwt "IRC client library - Lwt implementation" +irc irc-client-lwt-ssl "IRC client library - Lwt SSL implementation" +irc irc-client-tls "IRC client library - TLS implementation" +irc irc-client-unix "IRC client library - Unix implementation" +irmin ezirmin "An easy interface on top of the Irmin library." +irmin index "A platform-agnostic multi-level index for OCaml" +irmin irmin """ +irmin irmin-chunk "Irmin backend which allow to store values into chunks" +irmin irmin-cli "CLI for Irmin" +irmin irmin-containers "Mergeable Irmin data structures" +irmin irmin-fs "Generic file-system backend for Irmin" +irmin irmin-git "Git backend for Irmin" +irmin irmin-graphql "GraphQL server for Irmin" +irmin irmin-http "HTTP client and server for Irmin" +irmin irmin-indexeddb "Irmin backend using the web-browser's IndexedDB store" +irmin irmin-layers "Combine different Irmin stores into a single, layered store" +irmin irmin-mem "Generic in-memory Irmin stores" +irmin irmin-mirage-git "MirageOS-compatible Irmin stores" +irmin irmin-mirage-graphql "MirageOS-compatible Irmin stores" +irmin irmin-mirage "MirageOS-compatible Irmin stores" +irmin irmin-pack "Irmin backend which stores values in a pack file" +irmin irmin-test "Irmin test suite" +irmin irmin-tezos "Irmin implementation of the Tezos context hash specification" +irmin irmin-tezos-utils "Utils for Irmin tezos" +irmin irmin-unix "Unix backends for Irmin" +irmin irmin-watcher "Portable Irmin watch backends using FSevents or Inotify" +irmin libirmin "C bindings for irmin" +irmin mergeable-vector "Mergeable vector based on operational transformation" +irmin merge-queues "Mergeable queues" +irmin merge-ropes "Mergeable ropes" +js async_js +js atable "Basic spreadsheet tool with HTML tables" +js brr "Browser programming toolkit for OCaml" +js brr-lwd "Make reactive webpages in Js_of_ocaml using Brr and Lwd" +js c3 "OCaml bindings for the Javascript c3 charting library." +js chartjs-annotation "OCaml bindigns for Chart.js annotation plugin" +js chartjs-colorschemes "OCaml bindigns for Chart.js colorschemes plugin" +js chartjs-datalabels "OCaml bindigns for Chart.js datalabels plugin" +js chartjs "OCaml bindings for Chart.js" +js chartjs-streaming "OCaml bindings for Chart.js streaming plugin" +js commonjs_of_ocaml "Import and export CommonJS modules in js_of_ocaml" +js cookie-js "Simple library for setting/getting cookies in js_of_ocaml" +js d3 "OCaml bindings for D3.js" +js dispatch-js "Path-based dispatch: js_of_ocaml-specific support" +js ezjs_ace "Bindings for the Ace editor" +js ezjs_blockies "Bindings for Blockies" +js ezjs_cleave "Bindings for Cleave" +js ezjs_crypto "Bindings for SubtleCrypto" +js ezjs_cytoscape "Bindings for Cytoscape" +js ezjs_d3pie "Bindings for d3pie" +js ezjs_extension "Binding for Chrome and Firefox extension API" +js ezjs_fetch "Bindings for Fetch" +js ezjs_idb "Bindings for IndexedDB" +js ezjs_jquery "Bindings for JQuery" +js ezjs_min "A bunch of js_of_ocaml shortcuts" +js ezjs_odometer "Bindings for odometer" +js ezjsonm-lwt "Simple Lwt-based interface to the Jsonm JSON library" +js ezjsonm "Simple interface on top of the Jsonm JSON library" +js ezjs_push "Bindings for Push Notification" +js ezjs_qrcode "Bindings for QRCode.js" +js ezjs_recaptcha "Bindings for reCAPTCHA" +js ezjs_timeline "Bindings for TimelineJS" +js fmlib_js "Library for easy compilation from ocaml to javascript" +js gamepad "Bindings for the JS Gamepad API" +js gen-bs "generate bucklescript code from Javascript type specifications" +js gen_js_api "Easy OCaml bindings for JavaScript libraries" +js graphv_font_js "Javascript implementation of the font interface for Graphv" +js graphv_webgl "Full version of the Graphv library based on WebGL" +js graphv_webgl_impl +js incr_dom "A library for building dynamic webapps, using Js_of_ocaml." +js incr_dom_interactive "A monad for composing chains of interactive UI elements" +js incr_dom_keyboard "A library for Incr_dom keybinding and keyboard shortcut helpers" +js incr_dom_partial_render "A library for simplifying rendering of large amounts of data" +js incr_dom_sexp_form "A library for building forms that allow the user to edit complicated types" +js incr_dom_widgets "Utilities for Incr_dom" +js integers_stubs_js "Javascript stubs for the integers library in js_of_ocaml" +js javascriptcore "OCaml bindings to JavaScriptCore" +js jose "JOSE implementation for OCaml and ReasonML" +js JsOfOCairo "Library to reuse Cairo-based drawing code in web browsers" +js js_of_ocaml-camlp4 "Compiler from OCaml bytecode to Javascript" +js js_of_ocaml-compiler "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-lwt "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-ocamlbuild "Compiler from OCaml bytecode to Javascript" +js js_of_ocaml-ppx "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-ppx_deriving_json "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-toplevel "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-tyxml "Compiler from OCaml bytecode to JavaScript" +js js_of_ocaml-webgpu "Js_of_ocaml bindings for webgpu" +js js_of_ocaml-webidl "Generate js_of_ocaml bindings from webidl definitions" +js jsonoo "JSON library for Js_of_ocaml" +js jsoo_broadcastchannel "A wrapper in Js_of_ocaml to deal with BroadcastChannel" +js jsoo_router +js jsoo_storage "A wrapper in Js_of_ocaml for the WebStorage API" +js leaflet "Bindings for the Leaflet JavaScript library" +js melange-compiler-libs +js melange "Toolchain to produce JS from Reason/OCaml" +js monaco_jsoo "JSOO interface for Monaco-editor" +js obrowser "OCaml virtual machine written in Javascript" +js ocaml-js-stdlib "Binding OCaml to JavaScript standard library" +js ocaml-vdom "DOM and VDOM for OCaml" +js ocaml-webworker +js ocp_reveal "OCaml bindings for Reveal.js, an HTML presentation framework" +js odash "Odash: Lodash for Ocaml" +js ojquery "JQuery binding for OCaml" +js ojs-base +js ojs_base +js ojs_base_all "Virtual package to install all ojs_base packages" +js ojs_base_ppx "PPx extension for the Ojs_base library" +js ojs_ed "Using file editor in ojs_base applications, common part" +js ojs_filetree "Using filetrees in ojs_base applications, common part" +js ojs_list "Using lists in ojs_base applications, common part" +js ojs "Runtime Library for gen_js_api generated libraries" +js ojwidgets "Browser widgets in OCaml with js_of_ocaml." +json decoders-ezjsonm "Ezjsonm backend for decoders" +json decoders-jsonaf "Jsonaf backend for decoders" +json decoders-jsonm "Jsonm backend for decoders" +json decoders-yojson "Yojson backend for decoders" +json jsonaf "A library for parsing, manipulating, and serializing data structured as JSON" +json json-data-encoding-browser "Type-safe encoding to and decoding from JSON (browser support)" +json json-data-encoding-bson "Type-safe encoding to and decoding from JSON (bson support)" +json json-data-encoding "Type-safe encoding to and decoding from JSON" +json json-derivers "Common Derivers for Jsonm/Yjson" +json jsondiff "JSON sensitive diffing" +json jsonm "Non-blocking streaming JSON codec for OCaml" +json json_of_jsonm +json json-pointer "JSON pointer" +json json-predicate "JSON predicate" +json json-rpc "JSON RPC" +json jsonrpc "Jsonrpc protocol implemenation" +json json-static "JSON camlp4 syntax extension using json-wheel" +json json-wheel_jane_street_overlay "Jane Street overlay of the json-wheel library" +json json-wheel "JSON parser and writer, with optional C-style comments" +json jsonxt "Jsonxt - JSON parsers for files, strings and more" +json ocaml-protoc-yojson +json ocplib-json-typed-browser "Json_repr interface over JavaScript's objects" +json ocplib-json-typed-bson "A Json_repr compatible implementation of the JSON compatible subset of BSON" +json ocplib-json-typed "Type-aware JSON and JSON schema utilities" +json tiny_json "A small Json library from OCAMLTTER" +json tiny_json_conv "Meta conv for Tiny Json" +json yajl "Bindings to the YAJL streaming JSON library" +json yajl-extra +json yojson +json yojson-bench "Run Yojson benchmarks" +js promise_jsoo "Js_of_ocaml bindings to JS Promises with supplemental functions" +js promise "Native implementation of a JS promise binding" +js relit_helper "A helper library for those wishing to write TLMs using Relit" +js relit-reason "Hygienic typed literal macros (TLMs) for Reason" +js spotlib_js "Useful functions for OCaml programming used by @camlspotter" +js subscriptions-transport-ws +js user-agent-parser "OCaml implementation of the user agent parse rules of uap-core" +js virtual_dom "OCaml bindings for the virtual-dom library" +js vue-jsoo "Binding of Vue_js" +language alba "Alba compiler" +language archetype "Archetype language compiler" +language asli "Interpreter for Arm's Architecture Specification Language (ASL)" +language baguette_sharp "The Baguette# Interpreter REPL" +language bamboo "A compiler targeting Ethereum Virtual Machine" +language batsh "A (C-like syntax) programming language that compiles to Bash and Windows Batch." +language beluga "Implementation of contextual modal logic for reasoning with higher-order abstract syntax" +language boomerang "The Boomerang Language" +language catala "Compiler and library for the literate programming language for tax code specification" +language cduce "Modern XML-oriented functional language with innovative features" +language cduce_ws "Library fo Web Services creation" +language clarity-lang "Clarity smart contract parser and AST" +language dedukti "An implementation of The Lambda-Pi Modulo Theory" +language elpi "ELPI - Embeddable λProlog Interpreter" +language elpi-option-legacy-parser "ELPI - option for legacy parser" +language frenetic "The Frenetic Programming Language and Runtime System" +language fstar "Verification system for effectful programs" +language gobba "A simple, didactical, purely functional programming language" +language gufo "A fonctionnal shell" +language haxe "Multi-target universal programming language" +language heptagon "Compiler for the Heptagon/BZR synchronous programming language" +language jasmin "Compiler for High-Assurance and High-Speed Cryptography" +language kappa-agents "Backends for an interactive use of the Kappa tool suite" +language kappa-binaries "Command line interfaces of the Kappa tool suite" +language kappa-library "Public internals of the Kappa tool suite" +language kappa-server "HTTP server delivering the Kappa tool suite capabilities" +language KaSim "Software suite for the Kappa language" +language kremlin "A compiler from Low*, a low-level subset of F*, to C" +language labrys "A toy language based on LLVM that implements the System Fω type-system" +language lem "Lem is a tool for lightweight executable mathematics" +language links-mysql "MySQL database driver for the Links Programming Language" +language links-postgresql "Postgresql database driver for the Links Programming Language" +language links-sqlite3 "SQLite database driver for the Links Programming Language" +language links "The Links Programming Language" +language lua-ml "An embeddable Lua 2.5 interpreter implemented in OCaml" +language lua_parser "A Lua 5.2 Parser" +language lua_pattern "Implementation of Lua patterns" +language lustre-v6 "The Lustre V6 Verimag compiler" +language lutils "Tools and libs shared by Verimag/synchronous tools (lustre, lutin, rdbg)" +language mezzo +language minicaml "A simple, didactical, purely functional programming language" +language minimal "Minima.l, a minimal Lisp" +language ocs "OCS: OCaml Scheme interpreter" +language opa-base "Extended standard library developped along the OPA language" +language optal "A new language for optimization" +language ordinal "A language interpreter based on the Forth language" +language oxylc "The compiler for the Oxyl language" +language p4pp "P4PP: Preprocessor for P4 Language" +language p5scm "Scheme via camlp5" +language portia "Literate Programming Preprocessor" +language psyche "A WASM-friendly lightweight programming language implemented in OCaml" +language reason-parser "Reason Parser: Meta Language Toolchain" +language reason "Reason: Syntax & Toolchain for OCaml" +language reason-standard "A portable standard library enhancement for Reason and OCaml." +language sail "Sail is a language for describing the instruction semantics of processors" +language scaml "SCaml, Smart Contract Abstract Machine Language" +language schoca "Implementation of the Scheme language in OCaml" +language sifun "Interpreter for SiFun (Simple Functional) Language with three different type systems (supports Higher Rank Polymorphism)" +language solidity-alcotest "The ocaml-solidity project" +language solidity-common "The ocaml-solidity project" +language solidity-parser "The ocaml-solidity project" +language solidity-test "The ocaml-solidity project" +language solidity-typechecker "The ocaml-solidity project" +language ucaml "Translate OCaml code into C code" +language universo "A tool for Dedukti to play with universes" +language zelus "A synchronous language with ODEs" +language zelus-gtk "Zelus GTK library" +linux aio "Linux kernel AIO access library for ocaml" +linux camldm "Bindings for Linux libdevicemapper" +linux cdrom "Query the state and contents of CDROM devices under Linux" +linux cgroups "An OCaml interface for the Linux control groups" +linux cpuid "Detect CPU features" +linux cpu "Pin current process to given core number" +linux crontab "Interacting with cron from OCaml" +linux dlm "Libdlm bindings" +linux efl "An OCaml interface to the Enlightenment Foundation Libraries (EFL) and Elementary." +linux flock "Ctypes bindings to flock for OCaml" +linux gpiod "A wrapper around the C libgpiod library for GPIO on recent (>4.8) Linux kernels" +linux i2c "i2c" +linux i3ipc "A pure OCaml implementation of the i3 IPC protocol" +linux inotify "Inotify bindings for OCaml" +linux mperf "Bindings to Linux perf's metrics" +linux numalib "Interface to Linux NUMA API" +linux ocaml-systemd "OCaml module for native access to the systemd facilities" +linux pam "OCaml bindings for the Linux-PAM library" +linux socketcan "socketcan" +linux ubpf "OCaml bindings for userspace eBPF VM" +linux uring "OCaml bindings for Linux io_uring" +linux wayland "Pure OCaml Wayland protocol library" +linux waylaunch "Waylaunch is a program launcher for Wayland" +log bolt "Bolt is an OCaml Logging Tool" +log docout "Functor to create (text) output functions" +log dolog "The dumb OCaml logging library" +log easy_logging "Module to log messages. Aimed at being both powerful and easy to use" +log easy_logging_yojson "Configuration loader for easy_logging with yojson backend" +log fluent-logger "Structured logger for Fluentd (OCaml)" +log joolog "Logger for js_of_ocaml" +log little_logger "A tiny, little logger <3" +log loga "Logging library for OCaml" +log logger-p5 "Camlp5 syntax extension for logging" +log logs-async "Jane Street Async logging with Logs" +log logs-async-reporter "Logs reporter compatible with Async's threads" +log logs """Logging infrastructure for OCaml""" +log logs-ppx "PPX to cut down on boilerplate when using Logs" +log logs-syslog "Logs reporter to syslog (UDP/TCP/TLS)" +log lucid "Super simple logging library for OCaml" +log ocamlog "Simple Logger for OCaml" +log taglog "Logging library using levels and tags to determine what to log." +log volt "Volt is a variant of Bolt OCaml Logging Tool" +macos asl "Bindings for the Apple System Log API" +macos cf-lwt "Lwt interface to macOS CoreFoundation" +macos cf "OCaml bindings to macOS CoreFoundation" +macos dnssd "DNS Service Discovery for macOS" +macos fsevents-lwt "Lwt interface to macOS FSEvents" +macos fsevents "OCaml bindings to macOS FSEvents" +macos launchd "Bindings for the launchd socket activation API" +macos osx-acl "OS X POSIX.1e file system access control list (ACL) bindings" +macos osx-attr "OS X generic file system attribute system call bindings" +macos osx-cf "OS X CoreFoundation bindings" +macos osx-fsevents "OS X FSevents bindings" +macos osx-membership "OS X membership.h bindings for user, group, and UUID translation" +macos osx-mount "Bindings to OS X mount system calls" +macos osx-plutil "OS X plutil plist manipulation" +macos osx-secure-transport "macos/ios SecureTransport TLS OSX implementation API for OCaml" +macos osx-xattr "OS X extended attribute system call bindings" +macos plist "Native OCaml Plist manipulation" +macos plist-xml +macos plist-xml-lwt "Reading of plist files in the XML format with Lwt" +macos tallgeese "Enhanced SSH on OS X" +macos vmnet "MacOS X `vmnet` NAT networking" +macos vpnkit "VPN-friendly networking devices for HyperKit" +maths abstract_algebra "A small library describing abstract algebra concepts" +maths antic "Stub of the C library Antic. Algebraic number" +maths apron "APRON numerical abstract domain library" +maths apronext "Apron extension" +maths arb "Stub of the C library Arb. Ball approximation" +maths base-num "Num library distributed with the OCaml compiler" +maths bigdecimal "Arbitrary-precision decimal based on Zarith" +maths bignum +maths calcium "Stub of the C library Antic. For exact computation with real and complex numbers, presently in early development" +maths camlgpc "Interface to Alan Murta's General Polygon Clipper" +maths camlprime "Primality testing with lazy lists of prime numbers" +maths chase "Model finder for geometric theories using the chase" +maths clp_operations "A Clp domain" +maths colibrilib "A library of domains and propagators proved in Why3" +maths crlibm "Binding to CRlibm, a correctly rounded math lib" +maths ctypes-zarith "Ctypes wrapper for zarith" +maths cviode "Contact variational integrators - native ocaml version" +maths decimal "Arbitrary-precision floating-point decimal library" +maths dual "Dual numbers library" +maths eigen "Owl's OCaml interface to Eigen3 C++ library" +maths elina "ETH LIBRARY FOR NUMERICAL ANALYSIS" +maths fadbadml "FADBAD++ for OCaml" +maths farith "Floating point numbers library extracted from the Flocq Coq Library" +maths ff-bench "Benchmark library for finite fields over the package ff-sig" +maths ff "OCaml implementation of Finite Field operations" +maths ff-pbt "Property based testing library for finite fields over the package ff-sig" +maths ff-sig "Minimal finite field signatures" +maths fftw3 "Binding to the famous Fast Fourier Transform library FFTW" +maths flint "Stub of the C library Flint2" +maths genspir "Generate almost uniformly points on a sphere" +maths geoml "Geoml: 2D Geometry library for OCaml" +maths gg "Basic types for computer graphics in OCaml" +maths glpk "Bindings for glpk" +maths gmp-freestanding "The GNU Multiple Precision Arithmetic Library" +maths gmp "The GNU Multiple Precision Arithmetic Library" +maths gmp-xen "The GNU Multiple Precision Arithmetic Library" +maths gpr "GPR - Library and Application for Gaussian Process Regression" +maths gsl "GSL - Bindings to the GNU Scientific Library" +maths integers "Various signed and unsigned integer types for OCaml" +maths integration1d "Integration of functions of one variable" +maths interval "An interval arithmetic library for OCaml (meta package)" +maths interval_base "An interval library for OCaml (base package)" +maths interval_crlibm "An interval library for OCaml (crlibm version)" +maths interval_intel "An interval library for OCaml" +maths int_repr "Integers of various widths" +maths itv-tree "float intervals tree library" +maths lacaml "OCaml-bindings to BLAS and LAPACK" +maths lbfgs "Bound-constrainted optimization in many variables" +maths lp-glpk-js "LP and MIP modeling in OCaml (glpk.js interface)" +maths lp-glpk "LP and MIP modeling in OCaml (GLPK interface)" +maths lp-gurobi "LP and MIP modeling in OCaml (Gurobi interface)" +maths lpi "A REPL and library for a small dependently-typed language." +maths lp "LP and MIP modeling in OCaml" +maths mlgmpidl "OCaml interface to the GMP library" +maths mlgmp "Interface of GNU MP and MPFR" +maths mlmpfr "OCaml C bindings for MPFR-4.1.0" +maths modular-arithmetic +maths nlopt "OCaml bindings to the NLOpt optimization library" +maths num +maths numerix "Big integer library, written by Michel Quercia. Compares well to GMP." +maths ocephes "Bindings to special math functions from the Cephes library." +maths odepack "Binding to ODEPACK" +maths oml "Math Library" +maths omlr "Multiple Linear Regression model" +maths oplsr "OCaml wrapper for the R 'pls' package" +maths opti "DSL to generate fast incremental C code from declarative specifications" +maths optimization1d "Find extrema of 1D functions" +maths optiml-transport +maths owl-base "OCaml Scientific and Engineering Computing - Base" +maths owl-jupyter "Owl - Jupyter Wrappter" +maths owl "OCaml Scientific and Engineering Computing" +maths owl-ode-base "Owl's ODE solvers" +maths owl-ode-odepack "Owl's ODE solvers, interface with ODEPACK" +maths owl-ode "Owl's ODE solvers" +maths owl-ode-sundials "Owl's ODE solvers, interface with SundialsML" +maths owl-opt-lbfgs "Owl's Lbfgs Optimisation Module" +maths owl-opt "Owl's Optimisation Module" +maths owl-plplot "OCaml Scientific and Engineering Computing" +maths owl-symbolic "Owl's Symbolic Library" +maths owl-top "OCaml Scientific and Engineering Computing - Top" +maths owl-zoo "OCaml Scientific and Engineering Computing - Zoo" +maths pareto "GSL powered OCaml statistics library." +maths phantom-algebra "A strongly-typed tensor library à la GLSL" +maths pilat "Polynomial invariant generator" +maths polka "Polka: convex polyhedron library by Bertrand Jeannet (now part of apron)" +maths polynomial "Polynomials over finite fields" +maths prbnmcn-linalg "Functional vector and matrix manipulation" +maths prc "Utilities for precision-recall curves" +maths primes "A small library for dealing with primes." +maths root1d "Find roots of 1D functions" +maths slap "A linear algebra library with static size checking for matrix operations" +maths smol-helpers "Test helpers for smol" +maths smol "Small Math Ocaml Library" +maths tofn "Typed ordered fuzzy numbers" +maths tplib "TPLib: Tropical Polyhedra Library" +maths vector3 "Module for 3D vectors (implemented as records of x, y and z floats)" +maths zarith +maths zarith-freestanding +maths zarith-ppx "Literals for Zarith's arbitrary-precision integers and rationals" +maths zarith_stubs_js "Javascripts stubs for the Zarith library" +maths zarith-xen +mirage albatross "Albatross - orchestrate and manage MirageOS unikernels with Solo5" +mirage arp-mirage "Address Resolution Protocol for MirageOS" +mirage chamelon "Subset of littlefs filesystem fulfilling MirageOS KV" +mirage chamelon-unix "Command-line Unix utilities for chamelon filesystems" +mirage channel "MirageOS channels" +mirage docteur "A simple read-only Key/Value from Git to MirageOS" +mirage docteur-solo5 "A simple read-only Key/Value from Git to MirageOS" +mirage docteur-unix "A simple read-only Key/Value from Git to MirageOS" +mirage dyntype "syntax extension which makes OCaml types and values easier to manipulate programmatically" +mirage ethernet "OCaml Ethernet (IEEE 802.3) layer, used in MirageOS" +mirage fat-filesystem "FAT filesystem implementation" +mirage functoria "A DSL to organize functor applications" +mirage functoria-runtime "Runtime support library for functoria-generated code" +mirage git-cohttp "A package to use HTTP-based ocaml-git with Unix backend" +mirage git-cohttp-mirage "A package to use HTTP-based ocaml-git with MirageOS backend" +mirage git-cohttp-unix "A package to use HTTP-based ocaml-git with Unix backend" +mirage git-mirage "A package to use ocaml-git with MirageOS backend" +mirage git-paf "A package to use HTTP-based ocaml-git with MirageOS backend" +mirage git-unix "Virtual package to install and configure ocaml-git's Unix backend" +mirage iso-filesystem "ISO9660 filesystem library" +mirage jitsu +mirage jitsu-libvirt "Virtual package for installing Jitsu with a libvirt backend." +mirage jitsu-libxl +mirage jitsu-xapi +mirage mirage-block "Block signatures and implementations for MirageOS" +mirage mirage-block-ccm "AES-CCM encrypted Mirage Mirage_types.BLOCK storage" +mirage mirage-block-combinators "Block signatures and implementations for MirageOS using Lwt" +mirage mirage-block-lwt "Block signatures and implementations for MirageOS using Lwt" +mirage mirage-block-partition "Mirage block device partitioning" +mirage mirage-block-ramdisk "In-memory BLOCK device for MirageOS" +mirage mirage-block-solo5 "Solo5 implementation of MirageOS block interface" +mirage mirage-block-unix "MirageOS disk block driver for Unix" +mirage mirage-block-xen "MirageOS block driver for Xen that implements the blkfront/back protocol" +mirage mirage-bootvar-solo5 "Solo5 implementation of MirageOS Bootvar interface" +mirage mirage-bootvar-unix "Unix implementation of MirageOS Bootvar interface" +mirage mirage-bootvar-xen "Handle boot-time arguments for Xen platform" +mirage mirage-btrees +mirage mirage-channel "Buffered channels for MirageOS FLOW types" +mirage mirage-channel-lwt "Buffered Lwt channels for MirageOS FLOW types" +mirage mirage-clock-freestanding "Paravirtual implementation of the MirageOS Clock interface" +mirage mirage-clock "Libraries and module types for portable clocks" +mirage mirage-clock-lwt "Lwt-based implementation of the MirageOS Clock interface" +mirage mirage-clock-solo5 "Paravirtual implementation of the MirageOS Clock interface" +mirage mirage-clock-unix "Unix-based implementation for the MirageOS Clock interface" +mirage mirage-clock-xen "A Mirage-compatible Clock library for Xen" +mirage mirage-conduit "MirageOS interface to network connections" +mirage mirage-console "Implementations of Mirage console devices" +mirage mirage-console-lwt "Implementation of Mirage consoles using Lwt" +mirage mirage-console-solo5 "Solo5 implementation of MirageOS console interface" +mirage mirage-console-unix "Implementation of Mirage consoles for Unix" +mirage mirage-console-xen-backend "Implementation of Mirage console backend for Xen" +mirage mirage-console-xen-cli +mirage mirage-console-xen "Implementation of Mirage console for Xen" +mirage mirage-console-xen-proto "Implementation of Mirage console protocol for Xen" +mirage mirage-crypto-ec "Elliptic Curve Cryptography with primitives taken from Fiat" +mirage mirage-crypto-entropy "Entropy source for MirageOS unikernels" +mirage mirage-crypto-pk "Simple public-key cryptography for the modern age" +mirage mirage-crypto-rng "A cryptographically secure PRNG" +mirage mirage-crypto-rng-async "Feed the entropy source in an Async-friendly way" +mirage mirage-crypto-rng-eio "Feed the entropy source in an eio-friendly way" +mirage mirage-crypto-rng-mirage "Entropy collection for a cryptographically secure PRNG" +mirage mirage-crypto "Simple symmetric cryptography for the modern age" +mirage mirage-device "Abstract devices for MirageOS" +mirage mirage-dns "DNS implementation for the MirageOS unikernel framework" +mirage mirage-entropy "Entropy source for MirageOS unikernels" +mirage mirage-entropy-unix "MirageOS entropy device" +mirage mirage-entropy-xen "MirageOS entropy device" +mirage mirage-flow-combinators "Flow implementations and combinators for MirageOS specialized to lwt" +mirage mirage-flow "Flow implementations and combinators for MirageOS" +mirage mirage-flow-lwt "Flow implementations and combinators for MirageOS specialized to lwt" +mirage mirage-flow-rawlink "Expose rawlink interfaces as MirageOS flows" +mirage mirage-flow-unix "Flow implementations and combinators for MirageOS on Unix" +mirage mirage-fs-lwt "MirageOS signatures for filesystem devices using Lwt" +mirage mirage-fs-mem "In-memory file system for for MirageOS" +mirage mirage-fs "MirageOS signatures for filesystem devices" +mirage mirage-fs-unix "Passthrough filesystem for MirageOS on Unix" +mirage mirage-git "Virtual package to install the `git.mirage` libary" +mirage mirage-http "MirageOS-compatible implementation of the Cohttp interfaces" +mirage mirage-http-unix "MirageOS HTTP client and server driver for Unix" +mirage mirage-http-xen "MirageOS HTTP client and server driver for Xen" +mirage mirage-irmin "Virtual package to install Irmin with mirage support" +mirage mirage-kv-lwt "MirageOS signatures for key/value devices" +mirage mirage-kv-mem "In-memory key value store for MirageOS" +mirage mirage-kv "MirageOS signatures for key/value devices" +mirage mirage-kv-unix "Key-value store for MirageOS backed by Unix filesystem" +mirage mirage-logs "A reporter for the Logs library that writes log messages to stderr, using a Mirage `CLOCK` to add timestamps" +mirage mirage-monitoring "Monitoring of MirageOS unikernels" +mirage mirage-nat "Mirage-nat is a library for network address translation to be used with MirageOS" +mirage mirage-net-direct "TCP/IP networking stack in pure OCaml" +mirage mirage-net-fd "MirageOS network interfaces using raw sockets" +mirage mirage-net-flow "Build MirageOS network interfaces on top of MirageOS flows" +mirage mirage-net-lwt "Network signatures for MirageOS" +mirage mirage-net-macosx "MacOS implementation of the Mirage_net_lwt interface" +mirage mirage-net "Network signatures for MirageOS" +mirage mirage-net-socket "Socket-based networking stack compatible with Mirage" +mirage mirage-net-solo5 "Solo5 implementation of MirageOS network interface" +mirage mirage-net-unix "Unix implementation of the Mirage_net_lwt interface" +mirage mirage-net-xen "Network device for reading and writing Ethernet frames via then Xen netfront/netback protocol" +mirage mirage-no-solo5 "Virtual package conflicting with mirage-solo5" +mirage mirage-no-xen "Virtual package conflicting with mirage-xen" +mirage mirage-os-shim "Portable shim for MirageOS OS API" +mirage mirage-profile "Collect runtime profiling information in CTF format" +mirage mirage-profile-unix "Collect runtime profiling information in CTF format" +mirage mirage-profile-xen "Collect runtime profiling information in CTF format" +mirage mirage-protocols-lwt "MirageOS signatures for network protocols" +mirage mirage-protocols "MirageOS signatures for network protocols" +mirage mirage-qubes "Implementations of various Qubes protocols for MirageOS" +mirage mirage-qubes-ipv4 "Implementations of IPv4 stack which reads configuration from QubesDB for MirageOS" +mirage mirage-random "Random-related devices for MirageOS" +mirage mirage-random-stdlib "Random device implementation using the OCaml stdlib" +mirage mirage-random-test "Stub random device implementation for testing" +mirage mirage-runtime "The base MirageOS runtime library, part of every MirageOS unikernel" +mirage mirage-seal "Serve static files over HTTPS, using Mirage+ocaml-TLS." +mirage mirage-solo5 "Solo5 core platform libraries for MirageOS" +mirage mirage-stack-lwt "MirageOS signatures for network stacks" +mirage mirage-stack "MirageOS signatures for network stacks" +mirage mirage-tc "MirageOS type-classes" +mirage mirage-tcpip-unix "Userlevel TCP/IP stack" +mirage mirage-tcpip-xen "Userlevel TCP/IP stack" +mirage mirage "The MirageOS library operating system" +mirage mirage-time-lwt "Time operations for MirageOS with Lwt" +mirage mirage-time "Time operations for MirageOS" +mirage mirage-time-unix "Time operations for MirageOS on Unix" +mirage mirage-types-lwt "Lwt module type definitions for MirageOS applications" +mirage mirage-types "Module type definitions for MirageOS applications" +mirage mirage-unix "Unix core platform libraries for MirageOS" +mirage mirage-vnetif-stack "Vnetif implementation of mirage-stack for Mirage TCP/IP" +mirage mirage-vnetif "Virtual network interface and software switch for Mirage" +mirage mirage-www "MirageOS website (written with MirageOS)" +mirage mirage-xen-minios "Xen MiniOS guest operating system library" +mirage mirage-xen-ocaml "OCaml runtime compiled for the MirageOS Xen backend" +mirage mirage-xen-posix "MirageOS library for posix headers" +mirage mirage-xen "Xen core platform libraries for MirageOS" +mirage mirari "MirageOS application builder" +mirage oneffs "One-file filesystem is a filesystem for storing a single unnamed file" +mirage paf "HTTP/AF and MirageOS" +mirage solo5-bindings-genode "Solo5 sandboxed execution environment (genode target)" +mirage solo5-bindings-hvt "Solo5 sandboxed execution environment (hvt target)" +mirage solo5-bindings-muen "Solo5 sandboxed execution environment (muen target)" +mirage solo5-bindings-spt "Solo5 sandboxed execution environment (spt target)" +mirage solo5-bindings-virtio "Solo5 sandboxed execution environment (virtio target)" +mirage solo5-bindings-xen "Solo5 sandboxed execution environment (xen target)" +mirage solo5-cross-aarch64 "Solo5 sandboxed execution environment" +mirage solo5-elftool "OCaml Solo5 elftool for querying solo5 manifests" +mirage solo5-kernel-muen "Solo5 sandboxed execution environment (muen target)" +mirage solo5-kernel-ukvm "Solo5 sandboxed execution environment (ukvm target)" +mirage solo5-kernel-virtio "Solo5 sandboxed execution environment (virtio target)" +mirage solo5 "Solo5 sandboxed execution environment" +mirage tcpip "OCaml TCP/IP networking stack, used in MirageOS" +mirage tftp "A TFTP library and Mirage unikernel" +monads algaeff "Reusable Effects-Based Components" +monads alg_structs "Interfaces and module combinators for algebraic structures" +monads bastet "An OCaml library for category theory and abstract algebra" +monads bastet_async "Async implementations for bastet" +monads bastet_lwt "Lwt implementations for bastet" +monads choice "Choice monad, for easy backtracking" +monads duppy "Library providing monadic threads" +monads interface-prime "Interfaces for common design patterns" +monads interface-prime-lwt "Interfaces for common design patterns (LWT implementation)" +monads lemonade "A monad library with bubbles" +monads mnd "A small monads library" +monads monadlib "A starter library for monads, with transformers and applicatives." +monads monads "A missing monad library" +monads mtl "A Monad Transformers Library for OCaml" +monads olmi "Olmi provide functor to generate monadic combinators with a minimal interface" +monads omonad "Monad programming using ppx preprocessor" +monads profunctor "A library providing a signature for simple profunctors and traversal of a record" +monads pvem "Polymorphic-Variants-based Error Monad" +monads rea "Effectful OCaml with Objects and Variants" +monads sugar "Monadic library for error aware expressions" +monads traverse "Traversable data structures with applicative functors" +monads travesty "Traversable containers, monad extensions, and more" +monitor catapult-client "Network client for catapult, to be paired with catapult-daemon" +monitor catapult-daemon "Daemon for reliable multi-process logging with catapult" +monitor catapult-file "File logger for catapult" +monitor catapult-sqlite "Sqlite-based backend for Catapult tracing" +monitor catapult "Tracing system based on the Catapult/TEF format" +monitor chrome-trace "Chrome trace event generation library" +monitor gdbprofiler "A profiler for native OCaml and other executables" +monitor genet "Genet is tool to build a continuous integration platform." +monitor landmarks "A simple profiling library" +monitor landmarks-ppx "Preprocessor instrumenting code using the landmarks library" +monitor magic-trace "Collects and displays high-resolution traces of what a process is doing" +monitor memprof-limits "Memory limits, allocation limits, and thread cancellation" +monitor memtrace-mirage "Streaming client for Memprof using MirageOS API" +monitor memtrace "Streaming client for Memprof" +monitor memtrace_viewer "Interactive memory profiler based on Memtrace" +monitor mem_usage "Cross-platform stats about memory usage" +monitor metrics-influx "Influx reporter for the Metrics library" +monitor metrics-lwt "Lwt backend for the Metrics library" +monitor metrics "Metrics infrastructure for OCaml" +monitor metrics-mirage "Mirage backend for the Metrics library" +monitor metrics-rusage "Resource usage (getrusage) sources for the Metrics library" +monitor metrics-unix "Unix backend for the Metrics library" +monitor ocamlviz "real-time profiling tool" +monitor oci "OCI is a framework for continuous integrations and benchmarks." +monitor ocveralls +monitor ometrics "OCaml analysis in a merge request changes" +monitor opentelemetry-client-ocurl "Collector client for opentelemetry, using http + ocurl" +monitor opentelemetry-cohttp-lwt "Opentelemetry tracing for Cohttp HTTP servers" +monitor opentelemetry "Instrumentation for https://opentelemetry.io" +monitor opentelemetry-lwt "Lwt-compatible instrumentation for https://opentelemetry.io" +monitor opsian "Low overhead profiling" +monitor papi "Performance Application Programming Interface (PAPI) bindings" +monitor perf "Binding to perf_event_open" +monitor profiler-plugin +monitor prof_spacetime "A viewer for OCaml spacetime profiles" +monitor prometheus-app "Client library for Prometheus monitoring" +monitor prometheus "Client library for Prometheus monitoring" +monitor prometheus-liquidsoap "Virtual package installing liquidsoap's prometheus dependencies" +monitor prom "Types and pretty printer for Prometheus text-based exposition format" +monitor raw_spacetime "Raw_spacetime_lib library distributed with the OCaml compiler" +monitor raygun4ocaml "Client for the Raygun error reporting API" +monitor runtime_events_tools "Tools for the runtime events tracing system in OCaml" +monitor sentry "Unofficial Async Sentry error monitoring client" +monitor spacetime_lib "Library for decoding OCaml spacetime profiles" +monitor statmemprof-emacs "Emacs client for statistical memory profiler" +monitor statsd-client "StatsD client library" +monitor travis-opam "Scripts for OCaml projects" +monitor travis-senv "Utility to manipulate Travis CI secure environment variables" +multimedia gstreamer +multimedia liquidsoap-daemon "Daemonization scripts for liquidsoap" +multimedia liquidsoap "Swiss-army knife for multimedia streaming" +multimedia mm "The mm library contains high-level to create and manipulate multimedia streams (audio, video, MIDI)" +multimedia mpris "Client library for the MPRIS D-Bus media player interface" +multimedia mpris-clients "Client implementations of the MPRIS D-Bus media player interface" +multimedia sfml "Bindings to the SFML multimedia library" +network amqp-client "Amqp client base library" +network amqp-client-async "Amqp client library, async version" +network amqp-client-lwt "Amqp client library, lwt version" +network apero-net "OCaml Networking Library" +network arp "Address Resolution Protocol purely in OCaml" +network async_durable "Durable connections for use with async" +network async_rpc_kernel "Platform-independent core of Async RPC library" +network async_rpc_websocket "Library to serve and dispatch Async RPCs over websockets" +network async_smtp "SMTP client and server" +network async_ssl "An Async-pipe-based interface with OpenSSL." +network async_udp "Monadic concurrency library" +network async-uri "Open Async (TLS) TCP connections with Uri.t" +network async_websocket "A library that implements the websocket protocol on top of Async" +network async-zmq "Async wrapper for OCaml's zeromq bindings" +network bitcoin +network bitcoinml "Bitcoin data-structures library for OCaml" +network bt "BitTorrent library and client using Lwt" +network ca-certs "Detect root CA certificates from the operating system" +network ca-certs-nss "X.509 trust anchors extracted from Mozilla's NSS" +network capnp "OCaml code generation plugin for the Cap'n Proto serialization framework" +network capnp-rpc +network capnp-rpc-lwt +network capnp-rpc-mirage +network capnp-rpc-net +network capnp-rpc-unix +network charrua-client "DHCP client implementation" +network charrua-client-lwt "A DHCP client using lwt as effectful layer" +network charrua-client-mirage "A DHCP client for MirageOS" +network charrua-core "DHCP - a DHCP client, server and wire frame encoder and decoder" +network charrua "DHCP wire frame encoder and decoder" +network charrua-server "DHCP server" +network charrua-unix "Unix DHCP daemon" +network conduit "A network connection establishment library" +network conduit-async "A network connection establishment library for Async" +network conduit-async-ssl "A network connection establishment library using Async and OpenSSL" +network conduit-async-tls "A network connection establishment library using Async and ocaml-tls" +network conduit-lwt "A portable network connection establishment library using Lwt" +network conduit-lwt-ssl "A portable network connection establishment library using Lwt and OpenSSL" +network conduit-lwt-tls "A portable network connection establishment library using Lwt and ocaml-tls" +network conduit-lwt-unix "A network connection establishment library for Lwt_unix" +network conduit-mirage "A network connection establishment library for MirageOS" +network conduit-tls "A network connection establishment library" +network cry "OCaml client for the various icecast & shoutcast source protocols" +network daft "DAFT Allows File Transfers" +network dht "OCaml bindings for Juliusz Chroboczek's dht C library" +network disml "An OCaml library for interfacing with the Discord API" +network dropbox "Binding to the Dropbox Remote API" +network dropbox_lwt_unix "Binding to the Dropbox Remote API (Unix)" +network facebook-sdk "Facebook Graph API SDK for OCaml" +network ftp "Functions for accessing files via FTP" +network functory "Distributed computing library." +network gammu "Cell phone and SIM card access" +network gluten "A reusable runtime library for network protocols" +network gluten-async "Async runtime for gluten" +network gluten-lwt "Lwt-specific runtime for gluten" +network gluten-lwt-unix "Lwt + Unix support for gluten" +network gluten-mirage "Mirage support for gluten" +network grpc "A modular gRPC library" +network grpc-async "An Async implementation of gRPC" +network grpc-lwt "An Lwt implementation of gRPC" +network happy-eyeballs "Connecting to a remote host via IP version 4 or 6" +network happy-eyeballs-lwt "Connecting to a remote host via IP version 4 or 6 using Lwt_unix" +network happy-eyeballs-mirage "Connecting to a remote host via IP version 4 or 6 using Mirage" +network hydro "An independent implementation of ICE, the object-oriented RPC protocol by ZeroC" +network ip2location "IP2Location OCaml module to get geolocation data" +network ipaddr "A library for manipulation of IP (and MAC) address representations" +network ipaddr-cstruct "A library for manipulation of IP address representations using Cstructs" +network ipaddr-sexp "A library for manipulation of IP address representations using sexp" +network ipv6-multicast-lwt "UNIX bindings for IPv6 multicast — Lwt" +network ipv6-multicast "UNIX bindings for IPv6 multicast" +network iri "Implementation of Internationalized Resource Identifiers (IRIs)" +network krb5 "Kerberos 5 bindings" +network krb "A library for using Kerberos for both Rpc and Tcp communication" +network ldap "Implementation of the Light Weight Directory Access Protocol" +network lpd "A Line Printer Daemon (LPD) server library written entirely in OCaml." +network macaddr "A library for manipulation of MAC address representations" +network macaddr-cstruct "A library for manipulation of MAC address representations using Cstructs" +network macaddr-sexp "A library for manipulation of MAC address representations using sexp" +network macaroons "Macaroons for OCaml" +network maxminddb "Bindings to Maxmind.com's libmaxminddb library, like geoip2" +network mechaml "A functional web scraping library" +network message-switch "A simple store-and-forward message switch." +network mimic "A simple protocol dispatcher" +network mimic-happy-eyeballs "A happy-eyeballs integration into mimic" +network mindstorm "Drive Lego Mindstorms bricks from OCaml" +network mindstorm-lwt "Drive Lego Mindstorms bricks from OCaml (LWT version)" +network mldonkey "Cross-platform multi-network peer-to-peer daemon" +network monorobot "Notification bot for monorepos" +network mosquitto "mosquitto" +network mpi "OCaml binding to the Message Passing Interface (MPI)" +network mqtt_client "MQTT pub/sub transport protocol client written in OCaml" +network mqtt "MQTT message parser in OCaml" +network nbd "Network Block Device (NBD) protocol implementation" +network nbd-tool "Network Block Device (NBD) protocol implementation" +network nbd-unix "Network Block Device (NBD) protocol implementation" +network netamqp "Implements an AMQP client for accessing a message broker" +network netkat "A clean slate implementation of NetKAT" +network netlink "Bindings to the Netlink Protocol Library Suite (libnl)" +network netml "Network packets authoring and parsing toolkit." +network netsnmp "An interface to the Net-SNMP client library" +network nsq "A client library for the NSQ messaging platform" +network nuscr "A tool to manipulate and validate Scribble-style multiparty protocols" +network obandit "Ocaml Multi-Armed Bandits" +network obeanstalk "Async based client for the beanstalk work queue" +network obus "Pure Ocaml implementation of the D-Bus protocol" +network ocaml-gist "A tool to create online OCaml gist experiences for the web" +network ocamlnet +network ocamltter "The OCAMLTTER OAuth1 library and twitter, flickr clients" +network ocaml-zmq "OCaml bindings for ZMQ 2.1" +network ocluster-api "Cap'n Proto API for OCluster" +network ocluster "Distribute build jobs to workers" +network ocplib-resto "Minimal OCaml library for type-safe HTTP/JSON RPCs." +network odisco "OCaml library for Disco workers." +network oidc "Base package for working with OIDC" +network oni "Oni - assorted components for low-level networking." +network openstellina "A http client for Stellina smart telescope by Vaonis" +network oraft "Raft consensus algorithm implemented in OCaml" +network ordma "Ordma provides OCaml bindings to librdmacm (rsocket)" +network ox "A platform for writing OpenFlow controllers" +network pb "Library for describing Protobuf messages" +network pb-plugin "Plugin for generating pb protobuf message descriptions" +network pbrt "Runtime library for Protobuf tooling" +network pbs "Helper library around PBS/Torque" +network plasma "Distributed filesystem for large files, implemented in user space" +network protobuf "Protobuf implementation for Ocaml" +network protocell "A Protobuf plugin for OCaml" +network protocol_version_header "Protocol versioning" +network rawlink-eio "Portable library to read and write raw packets with EIO bindings" +network rawlink-lwt "Portable library to read and write raw packets with Lwt bindings" +network rawlink "Portable library to read and write raw packets" +network resto-acl "Access Control Lists for Resto" +network resto "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network resto-cohttp "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network resto-cohttp-client "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network resto-cohttp-self-serving-client "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network resto-cohttp-server "A minimal OCaml library for type-safe HTTP/JSON RPCs - server library" +network resto-directory "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network resto-json "A minimal OCaml library for type-safe HTTP/JSON RPCs" +network river "RSS2 and Atom feed aggregator for OCaml" +network rpc "A library to deal with RPCs in OCaml - meta-package" +network rpclib "A library to deal with RPCs in OCaml" +network rpclib-async "A library to deal with RPCs in OCaml - Async interface" +network rpclib-html +network rpclib-js "A library to deal with RPCs in OCaml - Bindings for js_of_ocaml" +network rpclib-lwt "A library to deal with RPCs in OCaml - Lwt interface" +network rpc_parallel "Type-safe parallel library built on top of Async_rpc" +network simple_pam "Tiny binding around PAM" +network sonet "Collection of modules for asynchronous network applications" +network srt "Binding for the Secure, Reliable, Transport protocol library" +network ssl "Bindings for OpenSSL" +network sslconf "An OCaml version of Openssl's NCONF library" +network tls-async "Transport Layer Security purely in OCaml, Async layer" +network tls-eio "Transport Layer Security purely in OCaml - Eio" +network tls-mirage "Transport Layer Security purely in OCaml, MirageOS layer" +network tls "Transport Layer Security purely in OCaml" +network tlstunnel "Tunnel -- a TLS reverse proxy" +network transmission-rpc "A client library for the Transmission Bittorrent client RPC" +network tuntap "OCaml library for handling TUN/TAP devices" +network unison "File-synchronization tool for Unix and Windows" +network utp "OCaml bindings for libutp" +network wamp-msgpck +network wamp "Web Application Messaging Protocol (WAMP) library — Core library" +network wamp-yojson "Web Application Messaging Protocol (WAMP) library — Yojson support" +network webdav "Implements the client side of the WebDAV protocol (RFC 4918)" +network zmq-async "Async-aware bindings to ZMQ" +network zmq-lwt "Lwt-aware bindings to ZMQ" +network zmq "OCaml bindings for ZeroMQ 4.x" +notebook down "An OCaml toplevel (REPL) upgrade" +notebook iocaml "A webserver for iocaml-kernel and iocamljs-kernel." +notebook iocamljs-kernel "An OCaml javascript kernel for the IPython notebook." +notebook iocaml-kernel "An OCaml kernel for the IPython notebook." +notebook jupyter "An OCaml kernel for Jupyter notebook" +notebook jupyter-archimedes "A Jupyter-friendly 2D plotting library (Archimedes backend)" +notebook jupyter-kernel "Library to write jupyter kernels (interactive notebooks)" +notebook nosetup "An `.ocamlinit` helper to `#require` packages in an OCaml toplevels" +notebook ocaml-top "The OCaml interactive editor for education" +notebook oloop "Evaluate code through the OCaml toploop for inclusion in educational material." +notebook rtop "Reason toplevel" +notebook tophide "Hides toplevel values whose name starts with an underscore" +notebook toplevel_backend "Shared backend for setting up toplevels" +notebook utop "Universal toplevel for OCaml" +opam ez_opam_file +opam hll "Create opam package files from a repository" +opam mirror "Mirror upstream OPAM package distribution files" +opam opam-0install-cudf "Opam solver using 0install backend using the CUDF interface" +opam opam-0install "Opam solver using 0install backend" +opam opam2web "Tool to generate the opam.ocaml.org website" +opam opam-bin +opam opam_bin_lib +opam opam-build "An opam plugin to build projects" +opam opam-build-revdeps "Build reverse dependencies of a package in OPAM" +opam opam-bundle "A tool that creates stand-alone source bundles from opam packages" +opam opam-ci "Query the opam package build status" +opam opam-client "Client library for opam 2.1" +opam opam-compiler "Plugin to create switches using custom compilers" +opam opamconfig "Virtual package owning parameters of opam installation." +opam opam-core "Core library for opam 2.1" +opam opam-custom-install "An opam plugin to install a package using a custom command" +opam opam-depext "Install OS distribution packages" +opam opam-devel "Bootstrapped development binary for opam 2.1" +opam opam-doc "Produce documentation for OPAM packages" +opam opam-dune-lint "Ensure dune and opam dependencies are consistent" +opam opam-ed "Command-line edition tool for handling the opam file syntax" +opam opam-file-format "Parser and printer for the opam file syntax" +opam opamfind +opam opam-format "Format library for opam 2.1" +opam opamfu "Functions over OPAM Universes" +opam opam-grep +opam opam-installer "Installation of files to a prefix, following opam conventions" +opam opam-installext "OPAM plugin to install external system dependencies" +opam opam-lib "The OPAM library" +opam opam-lock "Locking of development package definition dependency versions" +opam opam-monorepo "Assemble and manage fully vendored Dune repositories" +opam opam_of_packagejson "Simple tool to generate META, opam and .install files." +opam opam-package-upgrade "Upgrades opam package definition files to the latest format" +opam opam-publish "A tool to ease contributions to opam repositories" +opam opam-query "A tool to query opam files from shell scripts" +opam opam-repository "Repository library for opam 2.1" +opam opam-solver "Solver library for opam 2.1" +opam opam-spin "Opam plugin for Spin, the OCaml project generator" +opam opam-state "State library for opam 2.1" +opam opam-sync-github-prs "Sync OCaml GitHub issues with OPAM" +opam opam-test "An opam plugin to test projects" +packaging oasis2debian "Create and maintain Debian package for an OASIS package" +packaging oasis2opam "Tool to convert OASIS metadata to OPAM package descriptions" +packaging oasis-mirage "This is a fork of OASIS with support for native output-obj." +packaging oasis "Tooling for building OCaml libraries and applications" +packaging publish "opam-publish transition package" +packaging topkg-care """The transitory OCaml software packager""" +packaging topkg-jbuilder "Helpers for using topkg with jbuilder" +packaging topkg """The transitory OCaml software packager""" +parser acgtk "Abstract Categorial Grammar development toolkit" +parser angstrom-async "Angstrom - Async-specific support" +parser angstrom-lwt-unix "Angstrom - Lwt- and Unix-specific support" +parser angstrom "Parser combinators built for speed and memory-efficiency" +parser angstrom-unix "Angstrom - Unix-specific support" +parser bark "Unofficial OCaml port of elm/parser (v1.1.0)" +parser camlp4 "Camlp4 is a system for writing extensible parsers for programming languages" +parser cfg "CFG - Context-Free Grammars" +parser delimited_parsing "Parsing of character (e.g., comma) separated and fixed-width values" +parser dypgen "Self-extensible parsers and lexers for OCaml" +parser earley-ocaml +parser earley "Parsing library based on Earley Algorithm" +parser edn "Parsing OCaml library for EDN format" +parser fmlib_parse "Parsing with combinators and indentation sensitivity" +parser grain_dypgen "Self-extensible parsers and lexers for OCaml" +parser menhir "An LR(1) parser generator" +parser menhirLib "Runtime support library for parsers generated by Menhir" +parser menhirSdk "Compile-time library for auxiliary tools related to Menhir" +parser mparser "A simple monadic parser combinator library" +parser mparser-pcre "MParser plugin: PCRE-based regular expressions" +parser mparser-re "MParser plugin: RE-based regular expressions" +parser nacc "Not Another Compiler Compiler" +parser nice_parser "Nice parsers without the boilerplate" +parser nlp "Natural Language Processing tools for OCaml" +parser opal "Self-contained monadic parser combinators for OCaml" +parser ostap "Parser-combinator library" +parser pacomb "Parsing library based on combinators and ppx extension to write languages" +parser parsley "Parsley library" +parser planck "A small monadic parser combinator library" +parser pratter "An extended Pratt parser" +parser qinap "A (very small) monadic parsing library" +parser reparse-lwt "Reparse Lwt_stream.t input support" +parser reparse-lwt-unix "Reparse lwt-unix based input support" +parser reparse "Recursive descent parsing library for ocaml" +parser reparse-unix +parser tjr_simple_earley +parser transept "Generalized parser combinator library" +parser unstrctrd "Unstructured parser" +plt abt "OCaml port of CMU's abstract binding trees" +plt alonzo "STLC type system" +plt alphaCaml +plt anders "Modal Homotopy Type System" +plt bindlib "OCaml Bindlib library for bound variables" +plt bpf "Embedded eBPF assembler" +plt calipso "Rewrites C programs to remove non-structured control-flow" +plt cca "A framework for differential source code analyses" +plt cil "A front-end for the C programming language that facilitates program analysis and transformation" +plt clangml "OCaml bindings for Clang API" +plt clangml-transforms "Code transformers for clangml" +plt dap "Debug adapter protocol" +plt deadlock "Frama-C plugin for deadlock detection" +plt dolmen "A parser library for automated deduction" +plt dolmen_bin "A linter for logic languages" +plt dolmen_loop "A tool library for automated deduction tools" +plt dolmen_lsp "A LSP server for automated deduction languages" +plt dolmen_type "A typechecker for automated deduction languages" +plt ego "Ego (EGraphs OCaml) is extensible EGraph library for OCaml" +plt electrod "Formal analysis for the Electrod formal pivot language" +plt electrumAnalyzer "A tool for the analysis of Electrum formal specifications." +plt erlang "Libraries to manipulate Erlang sources" +plt flow_parser "The Flow parser is a JavaScript parser written in OCaml" +plt flowtype "Flow is a static typechecker for JavaScript." +plt frama-c +plt frama-c-base "Platform dedicated to the analysis of source code written in C." +plt frama-c-e-acsl "This package contains the Frama-C's E-ACSL plug-in." +plt frama-c-lannotate "Lannotate plugin of Frama-C, part of the LTest suite " +plt frama-c-luncov "Luncov plugin of Frama-C, part of the LTest suite " +plt frama-c-metacsl "MetACSL plugin of Frama-C for writing pervasives properties" +plt FrontC "Parses C programs to an abstract syntax tree" +plt gdb "GDB/MI (machine interface) library and stack-sampling profiler" +plt goblint-cil "A front-end for the C programming language that facilitates program analysis and transformation" +plt goblint "Static analysis framework for C" +plt grain_wasm_spec "An OCaml library to read and write Web Assembly (wasm) files and manipulate their AST" +plt herdtools7 "The herdtools suite for simulating and studying weak memory models" +plt inferno "A library for constraint-based Hindley-Milner type inference" +plt javalib "Javalib is a library written in OCaml with the aim to provide a high level representation of Java .class files" +plt kmt "Framework for deriving Kleene Algebras with Tests (KAT)" +plt lambdapi "Implementation of the λΠ-calculus modulo rewriting" +plt lambdapi "Proof assistant for the λΠ-calculus modulo rewriting" +plt lambda-runtime +plt lambda "λ-calculus ocaml library" +plt libwasmer "The official Wasmer library" +plt libwasmtime "The libwasmtime library package" +plt linksem "A formalisation of the core ELF file format written in Lem" +plt linol "LSP server library" +plt linol-lwt "LSP server library (with Lwt for concurrency)" +plt llopt "Just a tiny LLVM-IR optimizer for testing stuff." +plt llvmgraph "Ocamlgraph overlay for llvm" +plt llvm "The OCaml bindings distributed with LLVM" +plt lsp "LSP protocol implementation in OCaml" +plt malfunction "Compiler back-end for functional languages, based on OCaml" +plt memcad "The MemCAD analyzer" +plt modelica_ml "Modelica abstract syntax and parser" +plt morbig "A trustworthy parser for POSIX shell" +plt morsmall "A concise AST for POSIX shell" +plt nit "Nit, a static analysis tool, checks whether a java bytecode program is NullPointerException free." +plt obytelib "OCaml bytecode library tools to read, write and evaluate OCaml bytecode files" +plt ocaml-logicalform "LogicalForm provides modules for efficient and intuitive manipulation of logical expressions" +plt ollvm +plt ollvm-tapir "a fork of ollvm with added LLVM-Tapir support" +plt openQASM "Parser for OpenQASM (Open Quantum Assembly Language)" +plt ott "A tool for writing definitions of programming languages and calculi" +plt owee "OCaml library to work with DWARF format" +plt pds-reachability "A PDS reachability query library." +plt petr4 "Petr4: Formal Semantics for the P4 Programming Language" +plt pfff "Tools and APIs for program analysis, code visualization, refactoring" +plt promela "Library to create, manipulate and reason about PROMELA data structures." +plt pyast "Python AST" +plt pyre-ast "Full-fidelity Python parser in OCaml" +plt quest "Generates C code for testing a C compiler's calling convention" +plt rdr "Rdr is a cross-platform binary analysis and reverse engineering library," +plt remu_ts "External type infer" +plt rubytt "rubytt is a static code analyzer for Ruby." +plt sawja "Sawja provides a high level representation of Java bytecode programs and static analysis tools" +plt sparrow "A Static Analyzer for C" +plt spdiff "tool for automatic inference of semantic patches" +plt spirv "SPIR-V Compiler Library" +plt stitch "Refactoring framework" +plt systemverilog "SystemVerilog for OCaml" +plt tyabt "Strongly typed many-sorted abstract binding trees (ABTs)" +plt typerex-attic +plt typerex-binutils "Libraries and tools to work with object files" +plt typerex-build "Project manager for OCaml" +plt typerex-clibs "A set of bindings to common C libraries" +plt typerex-lldb +plt typerex-system "System utilities written in OCaml" +plt um-abt "An OCaml library implementing unifiable abstract binding trees (UABTs)" +plt wasmer "OCaml bindings for Wasmer" +plt wasm "Library to read and write WebAssembly (Wasm) files and manipulate their AST" +plt wasmtime "Wasmtime bindings for OCaml" +plt yuujinchou "A domain-specific language for manipulating hierarchical names" +ppx deriving "Extension to OCaml for deriving functions from type declarations" +ppx deriving-ocsigen "Extension to OCaml for deriving functions from type declarations" +ppx deriving-yojson "Parse/convert ocaml value from/to yojson ast" +ppx genprint "PPX syntax extension and library package for printing values of any type" +ppx let-if "A let%if syntax inspired by Rust's if let syntax" +ppx metapp "Meta-preprocessor for OCaml" +ppx metaquot "OCaml syntax extension for quoting code" +ppx mikmatch "OCaml syntax extension for regexps" +ppx node_of_ocaml "An OCaml ppx to require node modules" +ppx ocaml-embed-file "Files contents as module constants" +ppx ocamlify "Include files in OCaml code" +ppx ocaml-monadic "A PPX extension to provide an OCaml-friendly monadic syntax" +ppx override "PPX extension for overriding modules" +ppx pa_comprehension "Syntax extension for comprehension expressions" +ppx pa_do "Syntax extension to write arithmetic expressions" +ppx pa_monad_custom "Syntactic Sugar for Monads" +ppx pa_ppx_ag "A PPX Rewriter that Generates Attribute Grammar Evaulators" +ppx pa_ppx_hashcons "A PPX Rewriter for Hashconsing" +ppx pa_ppx_migrate "A PPX Rewriter for Migrating AST types (written using Camlp5)" +ppx pa_ppx "PPX Rewriters for Ocaml, written using Camlp5" +ppx pa_ppx_q_ast "A PPX Rewriter for automating generation of data-conversion code for use with Camlp5's Q_ast" +ppx pa_ppx_unique "A PPX Rewriter for Uniqifying ASTs" +ppx pa_qualified +ppx pa_sexp_conv "Library for serializing OCaml values to and from S-expressions" +ppx pa_typerep_conv "typerep is a library for runtime types." +ppx pa_variants_conv "Part of Jane Street’s Core library" +ppx pa_where "Backward declaration syntax" +ppx ppx_accessor "[@@deriving] plugin to generate accessors for use with the Accessor libraries" +ppx ppx_assert "Assert-like extension nodes that raise useful errors on failure" +ppx ppx_ast "OCaml AST used by Jane Street ppx rewriters" +ppx ppx_bap "The set of ppx rewriters for BAP" +ppx ppx_base "Base set of ppx rewriters" +ppx ppx_bench "Syntax extension for writing in-line benchmarks in ocaml code" +ppx ppx_bigarray "A PPX extension for big array literals" +ppx ppx_bin_prot "Generation of bin_prot readers and writers from types" +ppx ppx_bitstring "Bitstrings and bitstring matching for OCaml - PPX extension" +ppx ppx_blob "Include a file as a string at compile time" +ppx ppx_bsx "ReasonReact JSX for OCaml" +ppx ppx_camlrack "PPX for matching S-Expressions" +ppx ppx_catch +ppx ppx_cold "Expands [@cold] into [@inline never][@specialise never][@local never]" +ppx ppx_compare "Generation of comparison functions from types" +ppx ppx_compose "Inlined function composition" +ppx ppx_const "Compile-time \"if\" statement for conditional inclusion of code" +ppx ppx_conv_func "Deprecated" +ppx ppx_core "Standard library for ppx rewriters" +ppx ppx_counters "Generate useful code for stats gathering from records of counters" +ppx ppx_css "A ppx that takes in css strings and produces a module for accessing the unique names defined within" +ppx ppx_cstruct "Access C-like structures directly from OCaml" +ppx ppx_cstubs "Preprocessor for easier stub generation with ctypes" +ppx ppx_csv_conv "Generate functions to read/write records in csv format" +ppx ppx_curried_constr "ppx_curried_constr: ppx extension for curried constructors" +ppx ppx_custom_printf "Printf-style format-strings for user-defined string conversion" +ppx ppx_debugger +ppx ppx_defer "Go-like [%defer later]; now syntax" +ppx ppx_derivers "Shared [@@deriving] plugin registry" +ppx ppx_deriving_argparse "Very simple ppx deriver of command line parser for Ocaml >=4.02" +ppx ppx_deriving_cad "PPX Deriver for OCADml transformation functions" +ppx ppx_deriving_cmdliner "Cmdliner.Term.t generator" +ppx ppx_deriving_crowbar "ppx_deriving plugin for crowbar generators" +ppx ppx_deriving_encoding "Ppx deriver for json-encoding" +ppx ppx_deriving_hardcaml "Rewrite OCaml records for use as Hardcaml Interfaces" +ppx ppx_deriving_hash "[@@deriving hash]" +ppx ppx_deriving_jsoo "Ppx deriver for Js_of_ocaml" +ppx ppx_deriving_madcast "Library deriving cast functions based on their types." +ppx ppx_deriving_morphism "Morphism generator for OCaml >=4.02" +ppx ppx_deriving_popper "A ppx deriving sample-functions for Popper" +ppx ppx_deriving_protobuf "A Protocol Buffers codec generator for OCaml" +ppx ppx_deriving_protocol +ppx ppx_deriving_qcheck "PPX Deriver for QCheck" +ppx ppx_deriving_rpc "Ppx deriver for ocaml-rpc, a library to deal with RPCs in OCaml" +ppx ppx_deriving_scad "PPX Deriver for Scad_ml transformation functions" +ppx ppx_deriving "Type-driven code generation for OCaml" +ppx ppx_deriving_yaml "Yaml PPX Deriver" +ppx ppx_deriving_yojson "JSON codec generator for OCaml" +ppx ppx_disable_unused_warnings "Expands [@disable_unused_warnings] into [@warning \"-20-26-32-33-34-35-36-37-38-39-60-66-67\"]" +ppx ppx_distr_guards "Extension to distribute guards over or-patterns" +ppx ppx_dotbracket +ppx ppx_driver "Feature-full driver for OCaml AST transformers" +ppx ppx_dryunit "A detection tool for traditional unit testing in OCaml" +ppx ppx_enumerate "Generate a list containing all values of a finite type" +ppx ppx_enum "PPX to derive enum-like modules from variant type definitions" +ppx ppx_expect "Cram like framework for OCaml" +ppx ppx_factory "PPX to derive factories and default values" +ppx ppx_fail "Add location to calls to failwiths" +ppx ppx_fast_pipe "Fast pipe, pipe first as a syntax transform" +ppx ppx_fields_conv "Generation of accessor and iteration functions for ocaml records" +ppx ppxfind "Tool combining ocamlfind and ppx" +ppx ppx_fixed_literal "Simpler notation for fixed point literals" +ppx ppx_fun +ppx ppx_gen_rec "A ppx rewriter that transforms a recursive module expression into a `struct`" +ppx ppx_getenv "A sample syntax extension using OCaml's new extension points API" +ppx ppx_graphql "Write type-safe GraphQL queries" +ppx ppx_hardcaml "PPX extension for HardCaml" +ppx ppx_hash +ppx ppx_here "Expands [%here] into its location" +ppx ppx_ignore_instrumentation "Ignore Jane Street specific instrumentation extensions" +ppx ppx_implicits +ppx ppx_import "A syntax extension for importing declarations from interface files" +ppx ppx_include "Include OCaml source files in each other" +ppx ppx_inline_alcotest "Inline tests backend for alcotest" +ppx ppx_inline_test "Syntax extension for writing in-line tests in ocaml code" +ppx ppx_integer +ppx ppx_irmin "PPX deriver for Irmin type representations" +ppx ppx_jane "Standard Jane Street ppx rewriters" +ppx ppx_jsobject_conv +ppx ppx_jsonaf_conv "[@@deriving] plugin to generate Jsonaf conversion functions" +ppx ppx_json_types "JSON type providers" +ppx ppx_js_style "Code style checker for Jane Street Packages" +ppx ppx_let "Monadic let-bindings" +ppx ppxlib "Base library and tools for ppx rewriters" +ppx ppx_log "Ppx_sexp_message-like extension nodes for lazily rendering log messages" +ppx ppx_make "Ppxlib based make deriver" +ppx ppx_map "A PPX rewriter to simplify the declaration of maps" +ppx ppx_matches "Small ppx to help check if a value matches a pattern" +ppx ppx_measure "Provide a Type-safe way to manage unit of measure" +ppx ppx_meta_conv "PPX for converting between OCaml values and JSON, Sexp and camlon" +ppx ppx_metaquot "Write OCaml AST fragment using OCaml syntax" +ppx ppx_module_timer "Ppx rewriter that records top-level module startup times" +ppx ppx_monad "A Syntax Extension for all Monadic Syntaxes" +ppx ppx_monadic +ppx ppx_monoid "Syntax extension for building values of monoids" +ppx ppx_mysql_identity "Convenience package for using ppx_mysql with Mysql and the identity monad for IO" +ppx ppx_mysql "Syntax extension for facilitating usage of MySQL bindings" +ppx ppx_nanocaml "Framework for writing nanopass-style compilers" +ppx ppx_netblob "type-driven generation of HTTP calling code" +ppx ppx_open "Idiomatic selective `open`s in OCaml" +ppx ppx_optcomp "Optional compilation for OCaml" +ppx ppx_optional "Pattern matching on flat options" +ppx ppx_orakuda "ORakuda, Perlish string literals in OCaml" +ppx ppx_overload "Virtual package for ppx_overload, now provided by typpx" +ppx ppx-owl-opt "Ppx tool for owl-opt" +ppx ppx_pattern_bind "A ppx for writing fast incremental bind nodes in a pattern match" +ppx ppx_pattern_guard "ppx_pattern_guard: ppx extension for pattern guard" +ppx ppx_pbt "PPX Rewriter for property based testing" +ppx ppx_pipebang +ppx ppx_poly_record "ppx for polymorphic records" +ppx ppx_protocol_conv +ppx ppx_protocol_conv_json "Json driver for Ppx_protocol_conv" +ppx ppx_protocol_conv_jsonm "Jsonm driver for Ppx_protocol_conv" +ppx ppx_protocol_conv_msgpack "MessagePack driver for Ppx_protocol_conv" +ppx ppx_protocol_conv_xml_light "Xml driver for Ppx_protocol_conv" +ppx ppx_protocol_conv_xmlm "Xmlm driver for Ppx_protocol_conv" +ppx ppx_protocol_conv_yaml "Json driver for Ppx_protocol_conv" +ppx ppx_pyformat +ppx ppx_python "[@@deriving] plugin to generate Python conversion functions" +ppx ppx_rapper_async "Async support for ppx_rapper" +ppx ppx_rapper_lwt "Lwt support for ppx_rapper" +ppx ppx_rapper "Syntax extension for Caqti/PostgreSQL queries" +ppx ppx_regexp "Matching Regular Expressions with OCaml Patterns" +ppx ppx_relit "An implementation of Typed Literal Macros for Reason" +ppx ppx_repr "PPX deriver for type representations" +ppx ppx_seq "Seq literals ppx for OCaml" +ppx ppx_sexp +ppx ppx_sexp_conv +ppx ppx_sexp_message "A ppx rewriter for easy construction of s-expressions" +ppx ppx_sexp_value +ppx ppx_show "OCaml PPX deriver for deriving show based on ppxlib" +ppx ppx_sqlexpr +ppx ppx_stable "Stable types conversions generator" +ppx ppx_string_interpolation "String interpolation PPX preprocessor" +ppx ppx_string "Ppx extension for string interpolation" +ppx ppx_system "A ppx to know host operating system at compile time" +ppx ppx_test "A ppx replacement of pa_ounit" +ppx ppx_there "PPX extension for improved __MODULE__" +ppx ppx_tools "Tools for authors of ppx rewriters and other syntactic tools" +ppx ppx_tools_versioned "A variant of ppx_tools based on ocaml-migrate-parsetree" +ppx ppx_traverse "Automatic generation of open-recursion classes" +ppx ppx_traverse_builtins "Builtins for Ppx_traverse" +ppx ppx_ts "A PPX helps binding to typescript modules" +ppx ppx_type_conv "Support Library for type-driven code generators" +ppx ppx_typed_fields "GADT-based field accessors and utilities" +ppx ppx_type_directed_value "Get [@@deriving]-style generation of type-directed values without writing a ppx" +ppx ppx_typerep_conv "Generation of runtime types from type declarations" +ppx ppx_tyre "PPX syntax for tyre regular expressions and routes" +ppx ppx_units "Generate unit types for every record field" +ppx ppx_variants_conv +ppx ppx_view +ppx ppx_viewpattern "View patterns in OCaml" +ppx ppx_where "Haskell-style `where` clauses as a PPX syntax extension" +ppx ppx_wideopen "Ppx_wideopen syntax extension" +ppx ppx_xml_conv "Generate XML conversion functions from records" +ppx ppxx "Ppxx: a small extension library for writing PPX preprocessors" +ppx ppx_yojson_conv "[@@deriving] plugin to generate Yojson conversion functions" +ppx ppx_yojson_conv_lib "Runtime lib for ppx_yojson_conv" +ppx ppx_yojson "PPX extension for Yojson literals and patterns" +ppx refl "PPX deriver for reflection" +ppx res_tailwindcss "PPX validates the tailwindcss class names" +ppx typpx "a library for PPX with types" +ppx visitors "An OCaml syntax extension for generating visitor classes" +prover abella "Interactive theorem prover based on lambda-tree syntax" +prover alt-ergo-free "The Alt-Ergo SMT prover" +prover alt-ergo-lib-free "The Alt-Ergo SMT prover library" +prover alt-ergo-lib "The Alt-Ergo SMT prover library" +prover alt-ergo-parsers-free "The Alt-Ergo SMT prover parser library" +prover alt-ergo-parsers "The Alt-Ergo SMT prover parser library" +prover alt-ergo "The Alt-Ergo SMT prover" +prover altgr-ergo "The GUI for the Alt-Ergo SMT prover" +prover archsat "A first-order theorem prover with formal proof output" +prover cfml "The CFML program verification tool" +prover coq "Formal proof management system" +prover coqide "IDE of the Coq formal proof management system" +prover coq-native "Package flag enabling coq's native-compiler flag" +prover coq-of-ocaml "Compile a subset of OCaml to Coq" +prover coq-serapi "Sexp-based serialization library and protocol for machine interaction with the Coq proof assistant" +prover coq-shell "Simplified OPAM shell for Coq" +prover eprover "E Theorem Prover" +prover libzipperposition "Library for Zipperposition" +prover phox "PhoX is an implementation of Higher Order Logic" +prover profound "Interactive proof exploration based on formula linking" +prover squirrel "The Squirrel Prover is a proof assistant for protocols, based on first-order logic and provides guarantees in the computational model" +prover why3-base "Why3 environment for deductive program verification (base)" +prover why3-coq "Why3 environment for deductive program verification" +prover why3-ide "Why3 environment for deductive program verification" +prover why3 "Why3 environment for deductive program verification" +prover why "Why is a software verification platform." +prover zenon "An Extensible Automated Theorem Prover Producing Checkable Proofs" +prover zipperposition "A fully automatic theorem prover for typed higher-order and beyond" +prover zipperposition-tools "Support tools for Zipperposition" +retrocompatibility bigarray-compat +retrocompatibility core_compat "Compatibility for core 0.14" +retrocompatibility either "Compatibility Either module" +retrocompatibility ocaml-syntax-shims "Backport new syntax to older OCaml versions" +retrocompatibility result "Compatibility Result module" +retrocompatibility rresult """Result value combinators for OCaml""" +retrocompatibility seq +retrocompatibility stdcompat "Compatibility module for OCaml standard library" +retrocompatibility stdlib-shims "Backport some of the new stdlib features to older compiler" +science bistro "A library to build and run distributed scientific workflows" +science fasmifra "Molecular Generation by Fast Assembly of SMILES Fragments" +science gdal "Bindings to the GDAL and OGR libraries" +science grib "Bindings for the ECMWF GRIB API" +science hlarp "Normalize and compare HLA typing output." +science hts_shrink "Distance-Based Boolean Applicability Domain for High Throughput Screening data" +science igvxml "Create IGV session files from the command-line" +science jhupllib "A collection of OCaml utilities used by the JHU PL lab" +science ketrew "A Workflow Engine for Computational Experiments" +science kicadsch "Library to read and convert Kicad Sch files" +science lbvs_consent "Chemoinformatics software for consensus fingerprint queries" +science libra-tk "Learning and inference with discrete probabilistic models" +science lutin "Lutin: modeling stochastic reactive systems" +science molenc "Molecular encoder/featurizer using rdkit and OCaml" +science np "Fundamental scientific computing with Numpy for OCaml" +science npy "Numpy npy file format reading/writing." +science oc45 "Pure OCaml implementation of the C4.5 algorithm." +science OCADml "Types and functions for building CAD packages in OCaml" +science oolc "An Ocaml implementation of Open Location Code." +science orandforest "A random forest classifier based on OC4.5." +science oranger "OCaml wrapper for the ranger (C++) random forests implementation" +science orf "OCaml Random Forests" +science orgeat "Ocaml Random Generation of Arbitrary Types" +science orrandomForest "Classification or regression using Random Forests" +science orsvm_e1071 "OCaml wrapper to SVM R packages e1071 and svmpath" +science orxgboost "Gradient boosting for OCaml using the R xgboost package" +science osbx "Implementation of SeqBox in OCaml" +science phylogenetics "Algorithms and datastructures for phylogenetics" +science prbnmcn-clustering "Clustering library" +science proj4 "Bindings to the PROJ.4 projection library" +science qiskit "Qiskit for OCaml" +science rankers "Vanishing Ranking Kernels (VRK)" +science scid "Sierra Chart's Intraday Data File Format library" +science scipy "SciPy scientific computing library for OCaml" +science skkserv-lite "SKK server using sqlite3 dictionaries" +science sklearn "Scikit-learn machine learning library for OCaml" +science svmwrap "Wrapper on top of libsvm-tools" +science testu01 "OCaml bindings for TestU01 1.2.3" +science trexio "Binding for the TREXIO Input/Output library" +science udunits "Bindings to the UDUNITS-2 library" +science voqc "A verified optimizer for quantum circuits (VOQC)" +security argon2 "OCaml bindings to Argon2" +security binsec "Semantic analysis of binary executables" +security blake2 "Blake2 cryptography" +security blake3 "Blake3 cryptography" +security bls12-381-gen "Functors to generate BLS12-381 primitives based on stubs" +security bls12-381-hash +security bls12-381 "Implementation of BLS12-381 and some cryptographic primitives built on top of it" +security bls12-381-js """\ +security bls12-381-js-gen +security bls12-381-legacy +security bls12-381-signature +security bls12-381-unix """\ +security bn128 +security callipyge "Pure OCaml implementation of Curve25519" +security chacha "The Chacha functions, in OCaml" +security checkseum "Adler-32, CRC32 and CRC32-C implementation in C and OCaml" +security class_group_vdf "Verifiable Delay Functions bindings to Chia's VDF" +security crc "CRC implementation supporting strings and cstructs" +security cryptgps "Cryptographic functions" +security cryptodbm "Utilities for Versioned RPC communication with a child process over stdin and stdout" +security cryptohash "hash functions for OCaml" +security cryptokit "Cryptographic primitives library." +security cryptoverif "CryptoVerif: Cryptographic protocol verifier in the computational model" +security crypt "Tiny binding for the unix crypt function" +security curve-sampling "Sampling of parametric and implicit curves" +security digestif "Hashes implementations (SHA*, RIPEMD160, BLAKE2* and MD5)" +security dirsp-exchange-kbb2017 +security dirsp-exchange "Published protocols for the authenticated message exchange" +security dirsp-proscript-mirage +security dirsp-proscript "OCaml-ified interfaces for the ProScript Cryptography Library" +security dirsp-ps2ocaml "ProScript to OCaml translator" +security dnscurve "DNSCurve protocol for DNS queries over a secure channel" +security yara "OCaml bindings for YARA matching engine" +sexp camlrack "S-Expression parsing for OCaml" +sexp csexp "Parsing and printing of S-expressions in Canonical form" +sexp decoders-sexplib "Sexplib backend for decoders" +sexp parsexp_io "S-expression parsing library (IO functions)" +sexp parsexp "S-expression parsing library" +sexp pa_structural_sexp +sexp sexp_decode "A library to decode S-expression into structured data" +sexp sexp_diff "Code for computing the diff of two sexps" +sexp sexp_diff_kernel "Code for computing the diff of two sexps" +sexp sexp_grammar "Sexp grammar helpers" +sexp sexplib0 "Library containing the definition of S-expressions and some base converters" +sexp sexplib "Library for serializing OCaml values to and from S-expressions" +sexp sexp_macro "Sexp macros" +sexp sexp_pretty "S-expression pretty-printer" +sexp sexp_select "A library to use CSS-style selectors to traverse sexp trees" +sexp sexp "S-expression swiss knife" +sexp sexp_string_quickcheck "Quickcheck helpers for strings parsing to sexps" +solver 0install-solver "Package dependency solver" +solver absolute "AbSolute solver" +solver aez "Alt-Ergo Zero is an OCaml library for an SMT solver." +solver batsat "OCaml bindings for batsat, a SAT solver in rust" +solver bdd +solver bddapron "Logico-numerical domain(s) based on BDDs and APRON" +solver bddrand "A simple front-end to the lutin Random toss machinary" +solver bes "boolean expression simplifier" +solver bitwuzla-bin "Bitwuzla SMT solver executable" +solver bitwuzla-c "SMT solver for AUFBVFP (C API)" +solver bitwuzla "SMT solver for AUFBVFP" +solver colibri2 "A CP solver for smtlib" +solver colibrics "A CP solver proved in Why3" +solver combine "Combine is a library for combinatorics problem solving." +solver cubicle "SMT based model checker for parameterized systems" +solver facile "Constraint programming library over integer finite domains" +solver gbddml "The Verimag bdd library" +solver kind2 "Multi-engine, parallel, SMT-based automatic model checker for safety properties of Lustre programs" +solver logical "Logical is a minimalistic logic programming inspired by microKanren" +solver logtk "Core types and algorithms for logic" +solver mc2 "A mcsat-based SMT solver in pure OCaml" +solver mccs "Multi Criteria CUDF Solver with OCaml bindings" +solver minisat "Bindings to Minisat-C-1.14.1, with the solver included" +solver mlbdd "An OCaml library for Binary Decision Diagrams (BDDs)" +solver mlcuddidl "OCaml interface to the CUDD BDD library" +solver msat-bin "SAT solver binary based on the msat library" +solver msat "Library containing a SAT solver that can be parametrized by a theory" +solver noCanren "Translator from subset of OCaml to OCanren" +solver nunchaku "A counter-example finder for higher-order logic, designed to be used from various proof assistants" +solver ocaml-buddy "Bindings for the Buddy BDD library." +solver ocaml-sat-solvers "An abstraction layer for integrating SAT Solvers into OCaml." +solver ocamlyices "Yices SMT solver binding" +solver OCanren "Implementation of miniKanren relational (logic) EDSL" +solver OCanren-ppx +solver osdp "OCaml Interface to SDP solvers" +solver pa_solution "A DSL for solving programming contest problems" +solver pgsolver "A collection of tools for generating, manipulating and - most of all - solving parity games." +solver psmt2-frontend "The psmt2-frontend project" +solver qbf "QBF solving in OCaml, including bindings to solvers" +solver regstab "SAT-Solver able to deal with formulae patterns" +solver satML-plugin "Alt-Ergo, an SMT Solver for Software Verification: satML Plugin" +solver sattools +solver satyrographos "A package manager for SATySFi" +solver simple-bmc "A tool to translate Hybrid automata into SMT formula which is solvable by dReal" +solver smbc "Experimental model finder/SMT solver for functional programming" +solver smtlib-utils "Parser for SMTLIB2" +solver space-search "SpaceSearch is a library that turns Coq into a solver-aided host language" +solver sundialsml "Interface to the Sundials suite of numerical solvers" +solver touist "The solver for the Touist language" +solver yices2_bindings "Ocaml bindings for yices2" +solver yices2 "Yices2 SMT solver binding" +solver z3_tptp "TPTP front end for Z3 solver" +solver z3 "Z3 solver" +ssh awa-lwt "SSH implementation in OCaml" +ssh awa-mirage "SSH implementation in OCaml" +ssh awa "SSH implementation in OCaml" +ssh libssh "Bindings to libssh" +ssh ssh-agent "Ssh-agent protocol parser and serialization implementation" +ssh ssh-agent-unix "Ssh-agent protocol parser and serialization implementation for unix platforms" +stdlib base_bigstring "String type based on [Bigarray], for use in I/O and C-bindings" +stdlib base-bytes "Bytes library distributed with the OCaml compiler" +stdlib base "Full standard library replacement for OCaml" +stdlib base-implicits "Dummy base package for compilers with modular implicits support." +stdlib base-metaocaml-ocamlfind "Findlib toolchain configuration for MetaOCaml" +stdlib base-native-int63 "Virtual package for enabling native int63 support in Base" +stdlib base-nnp "Naked pointers prohibited in the OCaml heap" +stdlib base-no-ppx "A pseudo-library to indicate lack of extension points support" +stdlib base-unsafe-string "A pseudo-library to indicate OCaml versions that equate 'string' and 'bytes' (by default)" +stdlib batteries "A community-maintained standard library extension" +stdlib containers "A modular, clean and powerful extension of the OCaml standard library" +stdlib containers-data "A set of advanced datatypes for containers" +stdlib containers-thread "An extension of containers for threading" +stdlib core-and-more "Includes core, and some more useful extensions" +stdlib core_extended +stdlib core "Industrial strength alternative to OCaml's standard library" +stdlib core_kernel "Industrial strength alternative to OCaml's standard library" +stdlib cps_toolbox "A partial OCaml standard library replacement written with continuation passing style in mind" +stdlib devkit "Development kit - general purpose library" +stdlib extlib "A complete yet small extension for OCaml standard library" +stdlib extlib-compat +stdlib faillib "Part of Jane Street’s Core library" +stdlib fmlib "Functional monadic library" +stdlib fmlib_std "Standard datatypes of Fmlib" +stdlib General "Rich functionality for built-in and basic OCaml types" +stdlib nonstd "Non-standard mini-library" +stdlib preface "An opinionated library for function programming (à La Haskell)" +stdlib stdio "Standard IO library for OCaml" +stdlib tablecloth-native "Native OCaml library implementing Tablecloth, a cross-platform standard library for OCaml and Rescript" +stdlib TCSLib "A multi-purpose library for OCaml." +system b0 "Software construction and deployment kit" +system bos "Basic OS interaction for OCaml" +system bwrap "Use Bubblewrap to sandbox executables" +system corecount "Get count of cores on machine" +system directories "An OCaml library that provides configuration, cache and data paths (and more!) following the suitable conventions on Linux, macOS and Windows" +system dirsift "Search for directories by type" +system docker-api "Binding to the Docker Remote API" +system dockerfile-cmd "Dockerfile eDSL - generation support" +system dockerfile "Dockerfile eDSL in OCaml" +system dockerfile-opam "Dockerfile eDSL -- opam support" +system docker_hub "Library aiming to provide data from hub.docker.com" +system dotenv "Javascript's dotenv port to OCaml" +system dtools "Library providing various helper functions to make daemons" +system env_config "Helper library for retrieving configuration from an environment variable" +system esperanto "An OCaml compiler with Cosmopolitan" +system esperanto-cosmopolitan "Cosmopolitan toolchain for OCaml compiler" +system exit "Get exit status as declared in `stdlib.h`" +system ez_config "Easy management of configuration files" +system ezdl "Easy dynamic linking of C functions from ocaml" +system ez_file "Easy file manipulation (read_file, write_file, etc.)" +system ezxenstore "An easy-to-use interface to xenstore" +system feather "A minimal shell interface" +system feather_async "Async interface to Feather" +system febusy "Embedded build system library" +system file_path "A library for typed manipulation of UNIX-style file paths" +system fileutils "API to manipulate files (POSIX like) and filenames" +system forkwork "Fork child processes to perform work on multiple cores" +system fpath """File system paths for OCaml""" +system frag "File fragment extraction" +system fswatch_async "JaneStreet Async extension for fswatch" +system fswatch "Bindings for libfswatch -- file change monitor" +system fswatch_lwt "Lwt extension for fswatch" +system gasoline "Unix-ish application development framework" +system genspio "Typed EDSL to generate POSIX Shell scripts" +system get_line "Robustly select lines from file; can replace the head and tail shell commands and do even more" +system globlon "A globbing library for OCaml" +system hidapi "Bindings to Signal11's hidapi library" +system hvsock "Bindings for Hyper-V AF_VSOCK" +system ivy "This OCaml-library interfaces the Ivy software bus C-library" +system kinetic-client "Client for Seagate's kinetic drives." +system kqueue "OCaml bindings for kqueue event notification interface" +system kubecaml "Kubernetes API client for OCaml" +system libevent "OCaml wrapper for the libevent API" +system libudev "Bindings to libudev for OCaml" +system libvirt +system line_oriented "Library to operate on files made of lines of text" +system lo "Bindings for the lo library which provides functions for communicating with input controls using the OSC protocol" +system luv "Binding to libuv: cross-platform asynchronous I/O" +system luv_unix "Helpers for interfacing Luv and Unix" +system mlfenv "OCaml C bindings for fenv(3)" +system mmap "File mapping functionality" +system named-pipe "Bindings for named pipes" +system obuilder "Run build scripts for CI" +system obuilder-spec "Build specification format" +system obuild "simple package build system for OCaml" +system ocaml9p "ocaml9p is a library for the 9p protocol." +system ocamlfuse "OCaml bindings for FUSE (Filesystem in UserSpacE)" +system ocaml-xdg-basedir +system ocapic "Development tools to run OCaml programs on PIC microcontrollers" +system ocplib-file "A simple library to manage accesses to files" +system opasswd +system open "Open files in their default applications" +system order-i3-xfce "Order-i3-xfce is a small utility that allow you to keep a synchronized order between i3 tabs and the xfce pannel window buttons plugin" +system path_glob "Globbing file paths" +system pci "Ctypes bindings to libpci for OCaml" +system pci-db "Library to parse and query the pci.ids database of PCI devices" +system pf-qubes "QubesOS firewall ruleset handling library" +system pixel_pusher "Control LED strips on Pixel Pusher hardware" +system posixat "Bindings to the posix *at functions" +system posix-base "Base module for the posix bindings" +system posix-bindings "POSIX bindings" +system posix-clock "POSIX clock" +system posix-getopt "Bindings for posix getopt/getopt_long" +system posix-math "POSIX math" +system posix-mqueue "POSIX message queues" +system posix-semaphore "POSIX semaphore" +system posix-signal "Bindings for the types defined in " +system posix-socket "Bindings for posix sockets" +system posix-socket-unix "Bindings for posix sockets" +system posix-time2 "Bindings for posix time functions" +system posix-time "POSIX time" +system posix-types "Bindings for the types defined in " +system posix-uname "Bindings for posix uname" +system process "Easy process control" +system processor "Processor Topology & Affinity for ocaml" +system procord "Procord: a portable library to delegate tasks to other processes." +system proc-smaps "Proc-smaps: An ocaml parser of /proc/[pid]/smaps" +system protocol-9p "An implementation of the 9p protocol in pure OCaml" +system protocol-9p-tool "An implementation of the 9p protocol in pure OCaml" +system protocol-9p-unix "A Unix implementation of the 9p protocol in pure OCaml" +system pvem_lwt_unix "Access to the Operating system with Pvem and Lwt_unix" +system qfs "Bindings to libqfs - client library to access QFS" +system qmp "OCaml implementation of a Qemu Message Protocol (QMP) client" +system rashell "A resilient and replicant shell programming library" +system redirect "Redirect channels" +system rusage "Bindings to the GETRUSAGE(2) syscall" +system sanlock "Ctypes bindings to libsanlock for OCaml" +system semaphore-compat "Compatibility Semaphore module" +system setcore "Pin current process to given core number" +system shared-memory-ring-lwt "Shared memory rings for RPC and bytestream communications using Lwt" +system shared-memory-ring "Shared memory rings for RPC and bytestream communications" +system shcaml "Library for Unix shell programming" +system shell "Yet another implementation of fork&exec and related functionality" +system shexp "Process library and s-expression based shell" +system sibylfs +system sibylfs-lem +system so "Open file depending on their extension" +system spawn "Spawning sub-processes" +system syslog "syslog(3) routines for ocaml (RFC 3164)" +system sys-socket +system sys-socket-unix +system teash "TEA for the shell" +system usbmux "Control port remapping for iOS devices" +system usb "OCaml bindings for libusb-1.0" +system username_kernel "An identifier for a user" +system vhd-format-lwt "Pure OCaml library for reading and writing .vhd format data" +system vhd-format "Pure OCaml library for reading and writing .vhd format data" +system vhdlib "Bindings to libvhd" +system vhd-tool +system wiringpi "WiringPi for OCaml, low level Raspberry Pi hardware access" +system xdg-basedir "XDG basedir location for data/cache/configuration files" +system xdg "XDG Base Directory Specification" +terminal ansi "ANSI escape sequence parser" +terminal ansicolor +terminal ansi-parse "Ansiparse is a library for converting raw terminal output, replete with escape codes, into formatted HTML" +terminal ANSITerminal "Basic control of ANSI compliant terminals and the windows shell" +terminal arg-complete "Bash completion support for Stdlib.Arg" +terminal async_interactive "Utilities for building simple command-line based user interfaces." +terminal async_shell "Shell helpers for Async" +terminal async_unix "Monadic concurrency library" +terminal box "Render boxes in the terminal" +terminal chalk "Composable and simple terminal highlighting package" +terminal charInfo_width "Determine column width for a character" +terminal clap "Command-Line Argument Parsing, imperative style with a consumption mechanism" +terminal clim "Command Line Interface Maker" +terminal clim-ppx "Derivates cmdliner terms from type definitions" +terminal cmdliner "Declarative definition of command line interfaces for OCaml" +terminal cmdtui "Interactive command completion and execution for building REPLs" +terminal cmdtui-lambda-term "Interactive command completion and execution for building REPLs" +terminal curses "Bindings to ncurses" +terminal epictetus "Elegant Printer of Insanely Complex Tables Expressing Trees with Uneven Shapes" +terminal ez_cmdliner "Easy interface to Cmdliner à la Arg.parse with sub-commands" +terminal fmlib_pretty "Pretty printing support for tree like structures" +terminal fmt """OCaml Format pretty-printer combinators""" +terminal format +terminal getopt +terminal getopts "Analyse command line arguments" +terminal inquire "Create beautiful interactive command line interface in OCaml" +terminal inuit "Make interactive text-based user-interfaces in OCaml" +terminal lambda-term "Terminal manipulation library for OCaml" +terminal libdash "Bindings to the dash shell's parser" +terminal linenoise "Lightweight readline alternative" +terminal line-up-words "Align words in an intelligent way" +terminal mew "Modal editing witch" +terminal mew_vi "Modal editing witch, VI interpreter" +terminal minicli "Minimalist library for command line parsing" +terminal nottui-lwt "Run Nottui UIs in Lwt" +terminal nottui-pretty "A pretty-printer based on PPrint rendering UIs" +terminal nottui "UI toolkit for the terminal built on top of Notty and Lwd" +terminal notty_async "An Async driver for Notty" +terminal notty "Declaring terminals" +terminal ocaml-arg "A simple library to handle subcommand arguments" +terminal ocamline "Command line interface for user input" +terminal ocolor "Print with style in your terminal using Format's semantic tags" +terminal parse-argv "Process strings into sets of command-line arguments" +terminal printbox "Allows to print nested boxes, lists, arrays, tables in several formats" +terminal printbox-html "Printbox unicode handling" +terminal printbox-text "Text renderer for printbox, using unicode edges" +terminal progress "User-definable progress bars" +terminal termbox +terminal terminal "Basic utilities for interacting with terminals" +terminal terminal_size "Get the dimensions of the terminal" +terminal tqdm "OCaml library for progress bars" +tests afl +tests afl-persistent "Use afl-fuzz in persistent mode" +tests alcotest "Alcotest is a lightweight and colourful test framework" +tests alcotest-async "Async-based helpers for Alcotest" +tests alcotest-js +tests alcotest-lwt "Lwt-based helpers for Alcotest" +tests alcotest-mirage "Mirage implementation for Alcotest" +tests alg_structs_qcheck "Provides qCheck generators for laws of alg_structs" +tests assertions "Basic assert statements" +tests base_quickcheck "Randomized testing framework, designed for compatibility with Base" +tests boltzgen "Generate test using boltzman sampling" +tests broken "The Broken package is a simple testsuite framework." +tests bun "simple management of afl-fuzz processes" +tests caravan "A framework for testing arbitrary systems, in OCaml" +tests cinaps "Trivial metaprogramming tool" +tests craml "A CRAM-testing framework for testing command line applications" +tests crowbar "Write tests, let a fuzzer find failing cases" +tests dryunit "A detection tool for traditional and popular testing frameworks" +tests exenum "Build efficient enumerations for datatypes. Inspired by Feat for Haskell." +tests expect "Simple implementation of "expect" to help building unitary testing of interactive program" +tests expect_test_helpers_async "Async helpers for writing expectation tests" +tests expect_test_helpers "Async helpers for writing expectation tests" +tests expect_test_helpers_core "Helpers for writing expectation tests" +tests expect_test_helpers_kernel "Helpers for writing expectation tests" +tests feat +tests feat-core "Facilities for enumerating and sampling algebraic data types" +tests feat-num +tests junit_alcotest "JUnit" +tests junit "JUnit" +tests junit_ounit "JUnit" +tests kaputt "Testing tool" +tests lreplay "Executes a test suite and computes test coverage" +tests mock "Configurable functions to test impure code" +tests mock-ounit "OUnit wrapper for OCaml mock" +tests monolith "A framework for testing a library using afl-fuzz" +tests ocamlcodoc "Extract test code from doc-comments" +tests ocaml-topexpect "Simulate and post-process ocaml toplevel sessions" +tests osnap "OCaml random snapshot testing" +tests ospec "Behavior-Driven Development tool for OCaml, inspired by RSpec" +tests otf "otf is a simple Output Test Framework" +tests oth "Ocaml Test Harness - Simple library for running tests" +tests otto "Otto is a testing / autograding library" +tests ounit2-lwt "OUnit testing framework (Lwt)" +tests ounit2 "OUnit testing framework" +tests ounit-lwt "This is a transition package, ounit-lwt is now ounit2-lwt" +tests ounit "This is a transition package, ounit is now ounit2" +tests pa_ounit "Syntax extension for oUnit" +tests pa_test "Quotation expander for assertions." +tests popper "Property-based testing at ease" +tests prbnmcn-proptest "Property-based test helpers for prbnmcn packages" +tests qcheck-alcotest "QuickCheck inspired property-based testing for OCaml." +tests qcheck-core "QuickCheck inspired property-based testing for OCaml." +tests qcheck-ounit "QuickCheck inspired property-based testing for OCaml." +tests qcheck "QuickCheck inspired property-based testing for OCaml." +tests qcstm "A simple state-machine framework for OCaml based on QCheck" +tests qtest "qtest : Inline (Unit) Tests for OCaml." +tests quickcheck "Translation of QuickCheck from Haskell into OCaml" +tests radamsa "Radamsa bindings for OCaml" +tests regenerate "Regenerate is a tool to generate test-cases for regular expression engines" +tests should "Literate assertions" +tests testrunner +tests testsimple "A simple unit testing framework" +tests tezt "Test framework for unit tests, integration tests, and regression tests" +tests toplevel_expect_test "Expectation tests for the OCaml toplevel" +tests webtest "An in-browser js_of_ocaml testing framework - core library" +tests webtest-js "An in-browser js_of_ocaml testing framework - js_of_ocaml integration" +text acme "A library to interact with the acme text editor." +text camelsnakekebab "A Ocaml library for word case conversion" +text camlhighlight "Camlhighlight provides syntax highlighting facilities for OCaml applications." +text camlon "Camlmix is a generic preprocessor which converts text with embedded" +text camltemplate "Library for generating text from templates" +text camomile "A Unicode library" +text charset "Fast char sets" +text coin "Mapper of KOI8-{U,R} to Unicode" +text custom_printf "Extension for printf format strings" +text duff "Rabin's fingerprint and diff algorithm in OCaml" +text ecaml "Library for writing Emacs plugin in OCaml" +text embedded_ocaml_templates "EML is a simple templating language that lets you generate text with plain OCaml" +text emoji "Use emojis by name" +text estring "Extension for string literals" +text ez_search "The ez_search library" +text ez_subst "Ez_subst is a simple module to perform string substitutions" +text fuzzy_compare "Fastest bounded Levenshtein comparator over generic structures" +text fuzzy_match "A library for fuzzy string matching" +text gettext-camomile "Internationalization library using camomile (i18n)" +text gettext "Internationalization library (i18n)" +text gettext-stub "Internationalization using C gettext library (i18n)" +text higlo "Syntax highlighting library" +text hilite "Build time syntax highlighting" +text humane-re "A human friendly interface to regular expressions in OCaml" +text jingoo "Template engine almost compatible with Jinja2(python template engine)" +text levenshtein "Levenshtein distance algorithm for general array" +text lipsum +text m17n "Multilingualization for OCaml source code" +text mecab "An OCaml binding of MeCab, a part-of-speech and morphological analyzer." +text mustache "Mustache logic-less templates in OCaml" +text mutf8 "The Modified UTF-8 encoding used by Java and related systems" +text ocamldiff "OCamldiff is a small OCaml library providing functions to parse and display diff results" +text odb-server "Text editors/IDE helper module" +text odiff-gtk "OCaml library to display and merge diffs using Lablgtk." +text omg "Generate text using Markov chains" +text oniguruma "Bindings to the Oniguruma regular expression library" +text opencc0 "Bindings for OpenCC (v0) - Open Chinese Convert" +text opencc1_1 "Bindings for OpenCC (v1.1) - Open Chinese Convert" +text opencc1 "Bindings for OpenCC (v1) - Open Chinese Convert" +text opencc "Bindings for OpenCC (v1) - Open Chinese Convert" +text orakuda "Perlish string literals in OCaml" +text pandoc-abbreviations "Pandoc filter to add non-breaking spaces after abbreviations" +text pandoc-crossref "Pandoc filter to have LaTeX cross-references" +text pandoc-include "Pandoc filter to include other files" +text pandoc-inspect "Pandoc filter to inspect pandoc's JSON" +text pandoc "Library to write pandoc filters" +text patch "Patch library purely in OCaml" +text patdiff "File Diff using the Patience Diff algorithm" +text patience_diff "Diff library using Bram Cohen's patience diff algorithm." +text pcre "Bindings to the Perl Compatibility Regular Expressions library" +text phonetic "Phonetic algorithm in OCaml" +text pla "Pla is a simple library and ppx syntax extension to create composable templates based on verbatim strings" +text pp_loc "Quote and highlight input fragments at a given source location" +text pp "Pretty-printing library" +text pprint "A pretty-printing combinator library and rendering engine" +text prettiest "Non-greedy pretty printer" +text re2 "OCaml bindings for RE2, Google's regular expression library" +text re2_stable "Re2_stable adds an incomplete but stable serialization of Re2" +text re "RE is a regular expression library for OCaml" +text rosa "String manipulation library " +text rosetta "Universal mapper to Unicode" +text sedlex "An OCaml lexer generator for Unicode" +text simple-diff "Simple_diff is a pure OCaml diffing algorithm." +text smart-print "A pretty-printing library in OCaml" +text snabela "Logic-less template system" +text sosa "Sane OCaml String API" +text spelll "Fuzzy string searching, using Levenshtein automaton" +text stdlib-diff "Symmetric Diffs for OCaml stdlib and ReasonML" +text stemmer "Porter stemming algorithm in pure OCaml" +text stemming "Collection of stemmers" +text stringext "Extra string functions for OCaml" +text text "Library for dealing with "text", i.e. sequence of unicode characters, in a convenient way" +text textmate-language "Tokenizing code with TextMate grammars for syntax highlighting" +text textrazor "An OCaml wrapper for the TextRazor API" +text text-tags "A library for rich formatting using semantics tags" +text textutils_kernel "Text output utilities" +text textutils "Text output utilities" +text textwrap "Text wrapping and filling library" +text tyre "Typed Regular Expressions" +text ubase "Remove diacritics from latin utf8 strings" +text uchar "Compatibility library for OCaml's Uchar module" +text ucorelib "A light weight Unicode library for OCaml" +text ulex-camlp5 "A lexer generator for Unicode (backported to camlp5)" +text ulex "lexer generator for Unicode and OCaml" +text unidecode "Convert unicode strings into its ASCII representation" +text uucd "Unicode character database decoder for OCaml" +text uucp "Unicode character properties for OCaml" +text uuidm "Universally unique identifiers (UUIDs) for OCaml" +text uunf "Unicode text normalization for OCaml" +text uuseg "Unicode text segmentation for OCaml" +text uutf "Non-blocking streaming Unicode codec for OCaml" +text uuuu "Mapper of ISO-8859-* to Unicode" +text vcaml "OCaml bindings for the Neovim API" +text wseg "A word identification system" +text wtf8 "Encoder and decoder for WTF-8" +text wu-manber-fuzzy-search "Wu-Manber approximate string matching" +text xstr "Functions for string searching/matching/splitting" +text xstrp4 "Brace expansion (alias 'interpolation') performed by camlp4" +text yuscii "Mapper of UTF-7 to Unicode" +text zed "Abstract engine for text edition in OCaml" +tezos tezos-008-PtEdo2Zk-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-009-PsFLoren-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-010-PtGRANAD-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-011-PtHangz2-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-012-Psithaca-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-013-PtJakart-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-014-PtKathma-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-accuser-006-PsCARTHA "Tezos/Protocol: 006_PsCARTHA accuser binary" +tezos tezos-accuser-007-PsDELPH1 "Tezos/Protocol: accuser binary" +tezos tezos-accuser-008-PtEdo2Zk "Tezos/Protocol: accuser binary" +tezos tezos-accuser-008-PtEdoTez "Tezos/Protocol: accuser binary" +tezos tezos-accuser-009-PsFLoren "Tezos/Protocol: accuser binary" +tezos tezos-accuser-010-PtGRANAD "Tezos/Protocol: accuser binary" +tezos tezos-accuser-011-PtHangz2 "Tezos/Protocol: accuser binary" +tezos tezos-accuser-012-Psithaca "Tezos/Protocol: accuser binary" +tezos tezos-accuser-013-PtJakart "Tezos/Protocol: accuser binary" +tezos tezos-accuser-014-PtKathma "Tezos/Protocol: accuser binary" +tezos tezos-accuser-alpha "Tezos/Protocol: accuser binary" +tezos tezos-alpha-test-helpers "Tezos/Protocol: protocol testing framework" +tezos tezos-baker-006-PsCARTHA "Tezos/Protocol: 006_PsCARTHA baker binary" +tezos tezos-baker-007-PsDELPH1 "Tezos/Protocol: baker binary" +tezos tezos-baker-008-PtEdo2Zk "Tezos/Protocol: baker binary" +tezos tezos-baker-008-PtEdoTez "Tezos/Protocol: baker binary" +tezos tezos-baker-009-PsFLoren "Tezos/Protocol: baker binary" +tezos tezos-baker-010-PtGRANAD "Tezos/Protocol: baker binary" +tezos tezos-baker-011-PtHangz2 "Tezos/Protocol: baker binary" +tezos tezos-baker-012-Psithaca "Tezos/Protocol: baker binary" +tezos tezos-baker-013-PtJakart "Tezos/Protocol: baker binary" +tezos tezos-baker-014-PtKathma "Tezos/Protocol: baker binary" +tezos tezos-baker-alpha "Tezos/Protocol: baker binary" +tezos tezos-baking-006-PsCARTHA-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-006-PsCARTHA "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-007-PsDELPH1-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-007-PsDELPH1 "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-008-PtEdo2Zk-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-008-PtEdo2Zk "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-008-PtEdoTez-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-008-PtEdoTez "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-009-PsFLoren-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-009-PsFLoren "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-010-PtGRANAD-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-010-PtGRANAD "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-011-PtHangz2-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-011-PtHangz2 "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-baking-012-Psithaca-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-012-Psithaca "Tezos/Protocol: base library for `tezos-baker/accuser`" +tezos tezos-baking-013-PtJakart-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-013-PtJakart "Tezos/Protocol: base library for `tezos-baker/accuser`" +tezos tezos-baking-014-PtKathma-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-014-PtKathma "Tezos/Protocol: base library for `tezos-baker/accuser`" +tezos tezos-baking-alpha-commands "Tezos/Protocol: protocol-specific commands for baking" +tezos tezos-baking-alpha "Tezos/Protocol: base library for `tezos-baker/endorser/accuser`" +tezos tezos-base58 "Base58 encoding for Tezos" +tezos tezos-base-test-helpers "Tezos: Tezos base test helpers" +tezos tezos-base "Tezos: meta-package and pervasive type definitions for Tezos" +tezos tezos-bls12-381-polynomial "Polynomials over BLS12-381 finite field" +tezos tezos-clic "Tezos: library of auto-documented command-line-parsing combinators" +tezos tezos-client-000-Ps9mPmXa "Tezos/Protocol: 000-Ps9mPmXa (protocol-specific commands for `tezos-client`)" +tezos tezos-client-001-PtCJ7pwo-commands "Tezos/Protocol: 001_PtCJ7pwo (protocol-specific commands for `tezos-client`)" +tezos tezos-client-001-PtCJ7pwo "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-002-PsYLVpVv-commands "Tezos/Protocol: 002_PsYLVpVv (protocol-specific commands for `tezos-client`)" +tezos tezos-client-002-PsYLVpVv "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-003-PsddFKi3-commands "Tezos/Protocol: 003_PsddFKi3 (protocol-specific commands for `tezos-client`)" +tezos tezos-client-003-PsddFKi3 "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-004-Pt24m4xi-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-004-Pt24m4xi "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-005-PsBabyM1-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-005-PsBabyM1 "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-006-PsCARTHA-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-006-PsCARTHA "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-007-PsDELPH1-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-007-PsDELPH1-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-007-PsDELPH1 "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-008-PtEdo2Zk-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-008-PtEdo2Zk-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-008-PtEdo2Zk "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-008-PtEdoTez-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-008-PtEdoTez-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-008-PtEdoTez "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-009-PsFLoren-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-009-PsFLoren-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-009-PsFLoren "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-010-PtGRANAD-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-010-PtGRANAD-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-010-PtGRANAD "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-011-PtHangz2-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-011-PtHangz2-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-011-PtHangz2 "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-012-Psithaca-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-012-Psithaca-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-012-Psithaca "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-013-PtJakart-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-013-PtJakart-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-013-PtJakart "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-014-PtKathma "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-alpha-commands-registration "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-alpha-commands "Tezos/Protocol: protocol-specific commands for `tezos-client`" +tezos tezos-client-alpha "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-base "Tezos: common helpers for `tezos-client`" +tezos tezos-client-base-unix "Tezos: common helpers for `tezos-client` (unix-specific fragment)" +tezos tezos-client-commands "Tezos: protocol agnostic commands for `tezos-client`" +tezos tezos-client-demo-counter "Tezos/Protocol: protocol specific library for `tezos-client`" +tezos tezos-client-genesis-carthagenet "Tezos/Protocol: genesis (protocol-specific commands for `tezos-client`)" +tezos tezos-client-genesis "Tezos/Protocol: genesis (protocol-specific commands for `tezos-client`)" +tezos tezos-client-sapling-008-PtEdo2Zk "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-008-PtEdoTez "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-009-PsFLoren "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-010-PtGRANAD "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-011-PtHangz2 "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-012-Psithaca "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-013-PtJakart "Tezos: sapling support for `tezos-client`" +tezos tezos-client-sapling-alpha "Tezos: sapling support for `tezos-client`" +tezos tezos-client "Tezos: `tezos-client` binary" +tezos tezos-codec "Tezos: `tezos-codec` binary to encode and decode values" +tezos tezos-context-hash-irmin "Irmin implementation of the Tezos context hash specification" +tezos tezos-context-hash "Specification of the Tezos context hash" +tezos tezos-context-ops "Tezos: backend-agnostic operations on contexts" +tezos tezos-context "Tezos: on-disk context abstraction for `tezos-node`" +tezos tezos-crypto "Tezos: library with all the cryptographic primitives used by Tezos" +tezos tezos-embedded-protocol-000-Ps9mPmXa "Tezos/Protocol: 000-Ps9mPmXa (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-001-PtCJ7pwo "Tezos/Protocol: 001_PtCJ7pwo (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-002-PsYLVpVv "Tezos/Protocol: 002_PsYLVpVv (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-003-PsddFKi3 "Tezos/Protocol: 003_PsddFKi3 (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-004-Pt24m4xi "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-005-PsBABY5H "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-005-PsBabyM1 "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-006-PsCARTHA "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-007-PsDELPH1 "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-008-PtEdo2Zk "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-008-PtEdoTez "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-009-PsFLoren "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-010-PtGRANAD "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-011-PtHangz2 "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-012-Psithaca "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-013-PtJakart "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-014-PtKathma "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-alpha "Tezos/Protocol: economic-protocol definition, embedded in `tezos-node`" +tezos tezos-embedded-protocol-demo-counter "Tezos/Protocol: demo_counter (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-demo-noops "Tezos/Protocol: demo_noops (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-genesis-carthagenet "Tezos/Protocol: genesis_carthagenet (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-embedded-protocol-genesis "Tezos/Protocol: genesis (economic-protocol definition, embedded in `tezos-node`)" +tezos tezos-endorser-006-PsCARTHA "Tezos/Protocol: 006_PsCARTHA endorser binary" +tezos tezos-endorser-007-PsDELPH1 "Tezos/Protocol: endorser binary" +tezos tezos-endorser-008-PtEdo2Zk "Tezos/Protocol: endorser binary" +tezos tezos-endorser-008-PtEdoTez "Tezos/Protocol: endorser binary" +tezos tezos-endorser-009-PsFLoren "Tezos/Protocol: endorser binary" +tezos tezos-endorser-010-PtGRANAD "Tezos/Protocol: endorser binary" +tezos tezos-endorser-011-PtHangz2 "Tezos/Protocol: endorser binary" +tezos tezos-endorser-alpha "Tezos/Protocol: endorser binary" +tezos tezos-error-monad "Tezos: error monad" +tezos tezos-event-logging-test-helpers "Tezos: test helpers for the event logging library" +tezos tezos-event-logging "Tezos event logging library" +tezos tezos-hacl-glue "Tezos: thin layer of glue around hacl-star (virtual package)" +tezos tezos-hacl-glue-unix "Tezos: thin layer of glue around hacl-star (unix implementation)" +tezos tezos-hacl "Tezos: thin layer around hacl-star" +tezos tezos-injector-013-PtJakart "Tezos/Protocol: protocol specific library building injectors" +tezos tezos-injector-014-PtKathma "Tezos/Protocol: protocol specific library building injectors" +tezos tezos-injector-alpha "Tezos/Protocol: protocol specific library building injectors" +tezos tezos-legacy-store "Tezos: legacy low-level key-value store for `tezos-node`" +tezos tezos-lmdb "Legacy Tezos OCaml binding to LMDB (Consider ocaml-lmdb instead)" +tezos tezos-lwt-result-stdlib "Tezos: error-aware stdlib replacement" +tezos tezos-mempool-006-PsCARTHA "Tezos/Protocol: mempool-filters for protocol 006-PsCARTHA" +tezos tezos-mempool-007-PsDELPH1 "Tezos/Protocol: mempool-filters" +tezos tezos-mempool-008-PtEdoTez "Tezos/Protocol: mempool-filters" +tezos tezos-micheline-rewriting "Tezos: library for rewriting Micheline expressions" +tezos tezos-micheline "Tezos: internal AST and parser for the Michelson language" +tezos tezos-mockup-commands "Tezos: library of auto-documented RPCs (commands)" +tezos tezos-mockup-proxy "Tezos: local RPCs" +tezos tezos-mockup-registration "Tezos: protocol registration for the mockup mode" +tezos tezos-mockup "Tezos: library of auto-documented RPCs (mockup mode)" +tezos tezos-node "Tezos: `tezos-node` binary" +tezos tezos-openapi "Tezos: a library for querying RPCs and converting into the OpenAPI format" +tezos tezos-p2p-services "Tezos: descriptions of RPCs exported by `tezos-p2p`" +tezos tezos-p2p "Tezos: library for a pool of P2P connections" +tezos tezos-plompiler "Library to write arithmetic circuits for Plonk" +tezos tezos-plonk "Plonk zero-knowledge proving system" +tezos tezos-protocol-000-Ps9mPmXa "Tezos/Protocol: 000_Ps9mPmXa (economic-protocol definition, functor version)" +tezos tezos-protocol-001-PtCJ7pwo "Tezos/Protocol: 001_PtCJ7pwo (economic-protocol definition, functor version)" +tezos tezos-protocol-002-PsYLVpVv "Tezos/Protocol: 002_PsYLVpVv (economic-protocol definition, functor version)" +tezos tezos-protocol-003-PsddFKi3 "Tezos/Protocol: 003_PsddFKi3 (economic-protocol definition, functor version)" +tezos tezos-protocol-004-Pt24m4xi "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-005-PsBABY5H "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-005-PsBabyM1 "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-006-PsCARTHA-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-006-PsCARTHA "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-007-PsDELPH1-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-007-PsDELPH1 "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-008-PtEdo2Zk-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-008-PtEdo2Zk "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-008-PtEdoTez-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-008-PtEdoTez "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-009-PsFLoren-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-009-PsFLoren "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-010-PtGRANAD-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-010-PtGRANAD "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-011-PtHangz2-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-011-PtHangz2 "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-012-Psithaca-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-012-Psithaca "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-013-PtJakart-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-013-PtJakart "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-014-PtKathma "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-alpha-parameters "Tezos/Protocol: parameters" +tezos tezos-protocol-alpha "Tezos/Protocol: economic-protocol definition" +tezos tezos-protocol-compiler "Tezos: economic-protocol compiler" +tezos tezos-protocol-demo-counter "Tezos/Protocol: demo_counter economic-protocol definition" +tezos tezos-protocol-demo-noops "Tezos/Protocol: demo_noops economic-protocol definition" +tezos tezos-protocol-environment-packer "Tezos: sigs/structs packer for economic protocol environment" +tezos tezos-protocol-environment-sigs "Tezos: restricted typing environment for the economic protocols" +tezos tezos-protocol-environment-structs "Tezos: restricted typing environment for the economic protocols" +tezos tezos-protocol-environment "Tezos: custom economic-protocols environment implementation for `tezos-client` and testing" +tezos tezos-protocol-genesis-carthagenet "Tezos/Protocol: genesis_carthagenet economic-protocol definition" +tezos tezos-protocol-genesis "Tezos/Protocol: genesis economic-protocol definition" +tezos tezos-protocol-plugin-007-PsDELPH1-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-007-PsDELPH1 "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-008-PtEdo2Zk-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-008-PtEdo2Zk "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-009-PsFLoren-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-009-PsFLoren "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-010-PtGRANAD-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-010-PtGRANAD "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-011-PtHangz2-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-011-PtHangz2 "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-012-Psithaca-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-012-Psithaca-tests "Tezos/Protocol: protocol plugin tests" +tezos tezos-protocol-plugin-012-Psithaca "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-013-PtJakart-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-013-PtJakart-tests "Tezos/Protocol: protocol plugin tests" +tezos tezos-protocol-plugin-013-PtJakart "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-014-PtKathma-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-014-PtKathma "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-plugin-alpha-registerer "Tezos/Protocol: protocol plugin registerer" +tezos tezos-protocol-plugin-alpha-tests "Tezos/Protocol: protocol plugin tests" +tezos tezos-protocol-plugin-alpha "Tezos/Protocol: protocol plugin" +tezos tezos-protocol-updater "Tezos: economic-protocol dynamic loading for `tezos-node`" +tezos tezos-proxy-server-config "Tezos: proxy server configuration" +tezos tezos-proxy-server "Tezos: `tezos-proxy-server` binary" +tezos tezos-proxy "Tezos: proxy" +tezos tezos-requester "Tezos: generic resource fetching service" +tezos tezos-rpc-http-client "Tezos: library of auto-documented RPCs (http client)" +tezos tezos-rpc-http-client-unix "Tezos: unix implementation of the RPC client" +tezos tezos-rpc-http-server "Tezos: library of auto-documented RPCs (http server)" +tezos tezos-rpc-http "Tezos: library of auto-documented RPCs (http server and client)" +tezos tezos-rpc "Tezos: library of auto-documented RPCs (service and hierarchy descriptions)" +tezos tezos-rust-libs "Tezos: all rust dependencies and their dependencies" +tezos tezos-sapling "OCaml library for the Sapling protocol, using librustzcash" +tezos tezos-sapling-parameters "Sapling parameters used in Tezos" +tezos tezos-scoru-wasm "Protocol environment dependency providing WASM functionality for SCORU" +tezos tezos-shell-benchmarks "Tezos: shell benchmarks" +tezos tezos-shell-context-test "Testing the Shell Context" +tezos tezos-shell-context "Tezos: economic-protocols environment implementation for `tezos-node`" +tezos tezos-shell-services-test-helpers "Tezos: Tezos shell_services test helpers" +tezos tezos-shell-services "Tezos: descriptions of RPCs exported by `tezos-shell`" +tezos tezos-shell "Tezos: core of `tezos-node` (gossip, validation scheduling, mempool, ...)" +tezos tezos-signer-backends "Tezos: remote-signature backends for `tezos-client`" +tezos tezos-signer-services "Tezos: descriptions of RPCs exported by `tezos-signer`" +tezos tezos-signer "Tezos: `tezos-signer` binary" +tezos tezos-stdlib "Tezos: yet-another local-extension of the OCaml standard library" +tezos tezos-stdlib-unix "Tezos: yet-another local-extension of the OCaml standard library (unix-specific fragment)" +tezos tezos-storage "Tezos: low-level key-value store for `tezos-node`" +tezos tezos-store "Tezos: store for `tezos-node`" +tezos tezos-test-helpers-extra "Test helpers dependent on tezos-base" +tezos tezos-test-helpers "Tezos-agnostic test helpers" +tezos tezos-test-services "Tezos: Alcotest-based test services" +tezos tezos "Tezos meta package installing all active binaries" +tezos tezos-tooling "Tezos: tooling for the project" +tezos tezos-tx-rollup-013-PtJakart "Tezos/Protocol: protocol specific library for `tezos-tx-rollup`" +tezos tezos-tx-rollup-014-PtKathma "Tezos/Protocol: protocol specific library for `tezos-tx-rollup`" +tezos tezos-tx-rollup-alpha "Tezos/Protocol: protocol specific library for `tezos-tx-rollup`" +tezos tezos-tx-rollup-client-013-PtJakart "Tezos/Protocol: `tezos-tx-rollup-client-alpha` client binary" +tezos tezos-tx-rollup-client-014-PtKathma "Tezos/Protocol: `tezos-tx-rollup-client-alpha` client binary" +tezos tezos-tx-rollup-client-alpha "Tezos/Protocol: `tezos-tx-rollup-client-alpha` client binary" +tezos tezos-tx-rollup-node-013-PtJakart "Tezos/Protocol: Transaction Rollup node binary" +tezos tezos-tx-rollup-node-014-PtKathma "Tezos/Protocol: Transaction Rollup node binary" +tezos tezos-tx-rollup-node-alpha "Tezos/Protocol: Transaction Rollup node binary" +tezos tezos-validation "Tezos: library for blocks validation" +tezos tezos-validator "Tezos: `tezos-validator` binary for external validation of blocks" +tezos tezos-version "Tezos: version information generated from Git" +tezos tezos-webassembly-interpreter "WebAssembly reference interpreter with tweaks for Tezos" +tezos tezos-workers "Tezos: worker library" +time ago "ago(1) - compute the number of days between two calendar dates" +time apero-time "OCaml Time Stamping Library" +time caldav "A CalDAV server" +time calendar "Library for handling dates and times in your program" +time calendars "Convert dates between gregorian/julian/french/hebrew calendars" +time dates_calc "A date calculation library" +time daypack-lib "A schedule, time and time slots handling library" +time duration "Conversions to various time units" +time glical "Glical: glancing at iCalendar data." +time icalendar "A library to parse and print the iCalendar (RFC 5545) format" +time ISO8601 "ISO 8601 and RFC 3999 date parsing for OCaml" +time mtime "Monotonic wall-clock time for OCaml" +time oclock "Oclock: Precise POSIX clock for OCaml" +time odate "Date & Duration Library" +time ptime "POSIX time for OCaml" +time timedesc-json "Timedesc JSON backend" +time timedesc "OCaml date time handling library" +time timedesc-sexp "Timedesc Sexp backend" +time timedesc-tzdb "Virtual library for Timedesc time zone database backends" +time timedesc-tzlocal-js "JS implementation for timedesc-tzlocal" +time timedesc-tzlocal "Virtual library for Timedesc local time zone detection backends" +time timed "Timed references for imperative state" +time time_now "Reports the current time" +time timere "OCaml date time reasoning library" +time timere-parse "OCaml date time and duration natural language parsing library" +time timezone "Time-zone handling" +tooling BetterErrors "Better compiler error output." +tooling bisect "Code coverage tool for the OCaml language" +tooling bisect_ppx "Code coverage for OCaml" +tooling bisect_ppx-ocamlbuild "Ocamlbuild plugin for Bisect_ppx, the coverage tool" +tooling bisect-summary +tooling camelot "An OCaml Linter / Style Checker" +tooling camlidl "Stub code generator for OCaml" +tooling camlmix "Camlmix is a generic preprocessor which converts text with embedded" +tooling camlp5 "Preprocessor-pretty-printer of OCaml" +tooling cmitomli "Converts compiled interface files (.cmi) into source interface files (.mli)" +tooling cmon "A library for printing OCaml values with sharing" +tooling codept "alternative ocaml dependency analyzer" +tooling coinst "Coinst tool suite to perform analysis on package repositories." +tooling cppo "Code preprocessor like cpp for OCaml" +tooling cppo_ocamlbuild "Plugin to use cppo with ocamlbuild" +tooling dead_code_analyzer "dead_code_analyzer -- Dead code analyzing tool." +tooling depgraph "dot graphs out of ocamldep output" +tooling drom_lib "The drom tool is a wrapper over opam/dune in an attempt to provide a cargo-like user experience" +tooling drom "The drom tool is a wrapper over opam/dune in an attempt to provide a cargo-like user experience" +tooling dum "Inspect the runtime representation of arbitrary OCaml values" +tooling dumpast "OCaml AST dumper" +tooling dump_ocamlformat "Dump preset configuration files for ocamlformat" +tooling earlybird "Debug adapter for OCaml 4.11" +tooling exn-source "Exception backtrace for OCaml with source code printing" +tooling findlib_top "Exposes findlib_top.cma without the need for using predicates" +tooling fromager "A CLI to format an ocaml codebase" +tooling gospel "A tool-agnostic formal specification language for OCaml" +tooling headache "Automatic generation of files headers" +tooling inspect "Inspect the runtime representation of arbitrary OCaml values." +tooling mascot "A style-checker for OCaml sources (code, documentation, interface, metrics, and typography)." +tooling mkocaml "Tool to generate OCaml projects" +tooling mld "The MLD package makes directory foo.mld turn into module Foo" +tooling namespaces "Turn directories into OCaml modules" +tooling not-ocamlfind "A small frontend for ocamlfind that adds a few useful commands" +tooling obelisk "Pretty-printing for Menhir files" +tooling objsize "Small library to compute sizes of OCaml heap values" +tooling ocaml_at_p "OCaml@p : A debugging print system for OCaml" +tooling ocamlclean "Reduce size of OCaml bytecode files by dead-code removing" +tooling ocamlc-loc "Parse ocaml compiler output into structured form" +tooling ocamldsort "Sorts a set of OCaml source files according to their dependencies" +tooling ocamlfind "A library manager for OCaml" +tooling ocamlfind-lint "Simple tool performing checks on installed findlib META files" +tooling ocamlfind-secondary "Adds support for ocaml-secondary-compiler to ocamlfind" +tooling ocamlformat "Auto-formatter for OCaml code" +tooling ocamlformat-rpc "Auto-formatter for OCaml code (RPC mode)" +tooling ocamlformat-rpc-lib "Auto-formatter for OCaml code (RPC mode)" +tooling ocamlformat_support "Support package for OCamlFormat" +tooling ocaml-indent "OCaml-indent: OCaml source code indenter" +tooling ocamllint "Detect common errors in OCaml code" +tooling ocaml-migrate-parsetree "Convert OCaml parsetrees between different versions" +tooling ocaml-migrate-parsetree-ocamlbuild "Ocamlbuild plugin for ocaml-migrate-parsetree" +tooling ocamlmod "Generate OCaml modules from source files" +tooling ocamlpp "OCaml binary files (.byte and .cmo) pretty printers." +tooling ocaml-print-intf "Display human-readable OCaml interface from a compiled .cmi" +tooling ocamlscript "Tool which compiles OCaml scripts into native code" +tooling ocaml-version "Manipulate, parse and generate OCaml compiler version strings" +tooling ocamlwc "Count lines in OCaml source code" +tooling ocp-build "Project manager for OCaml" +tooling ocp-indent "A simple tool to indent OCaml programs" +tooling ocp-indent-nlfork "ocp-indent library, "newline tokens" fork" +tooling ocp-manager "Global Manager for OCaml versions and OPAM switches" +tooling ocp-ocamlres "Manipulation, injection and extraction of embedded resources" +tooling ocp-pack-split "ocp-pack and ocp-split" +tooling ocp-pp "A simple preprocessor for OCaml" +tooling ocp-reloc "Relocation of OCaml bytecode executables" +tooling odoc-depgraph +tooling ogen "A tool for creating new OCaml projects with OPAM, Oasis, and Merlin" +tooling omod "Lookup and load installed OCaml modules" +tooling opaca "A friendly OCaml project scaffolding tool" +tooling optcomp "Optional compilation with cpp-like directives" +tooling oqamldebug "Graphical front-end to ocamldebug" +tooling oskel "Skeleton generator for OCaml projects" +tooling podge "Shortcuts and helpers for common tasks in OCaml ecosystem" +tooling rdbg "RDBG: a reactive programs debugger." +tooling reanalyze "Dead values/types, exception, and termination analysis for OCaml/ReScript" +tooling rotor "An automatic refactoring tool for OCaml" +tooling spin "OCaml project generator" +tooling spotinstall "A tool to facilitate the installation of OCaml annotation files (.cmt, .cmti, .spot, .spit)" +tooling starterkit "Virtual package for starting OCaml" +tooling trax "Stack-independent exception tracing" +tooling user-setup +unix build_path_prefix_map "An OCaml implementation of the BUILD_PATH_PREFIX_MAP specification" +unix extunix "Collection of thin bindings to various low-level system API" +unix fd-send-recv "Bindings for sendmsg/recvmsg that allow Unix.file_descrs to be sent and received over Unix domain sockets" +unix unix-dirent +unix unix-errno "Unix errno types, maps, and support" +unix unix-fcntl "Unix fcntl.h types, maps, and support" +unix unix-sys-resource +unix unix-sys-stat +unix unix-time "Unix time.h types, maps, and support" +unix unix-type-representations +unix unix-unistd "Host-independent unistd.h bindings" +utils accessor "A library that makes it nicer to work with nested functional data structures" +utils accessor_async "Accessors for Async types, for use with the Accessor library" +utils accessor_base "Accessors for Base types, for use with the Accessor library" +utils accessor_core "Accessors for Core types, for use with the Accessor library" +utils annexlib "An extension to the standard library" +utils apero-core "OCaml Utility Library" +utils archi +utils archi-async +utils archi-lwt +utils atomic +utils bau "Bigarray utilities" +utils bear "Bare essential additions to the stdlib" +utils bigarray-overlap "Bigarray.overlap" +utils bigstringaf "Bigstring intrinsics and fast blits based on memcpy/memmove" +utils bigstring "A set of utils for dealing with `bigarrays` of `char`" +utils bigstring-unix "I/O functions for bigstrings using file descriptors and memory-maps" +utils bitstring "Bitstrings and bitstring matching for OCaml" +utils bytearray "Efficient marshaling to and from bigarrays" +utils bytebuffer "Extensible buffers built on top of bigarrays" +utils camlix "Simple circuit breaker" +utils camllib "Utility Library (including various datatypes)" +utils camlp-streams "The Stream and Genlex libraries for use with Camlp4 and Camlp5" +utils canary "Capture unhandled exceptions and automatically report them through various channels" +utils captureio "Capture output to Stderr and Stdout" +utils cfstream "Stream operations in the style of Core's API" +utils clarity "Functional programming library" +utils comparelib "Part of Jane Street’s Core library" +utils crunch "Convert a filesystem into a static OCaml module" +utils delimcc "Oleg's delimited continuations library for byte-code and native OCaml" +utils domainslib "Nested-parallel programming library" +utils dtoa "Converts OCaml floats into strings (doubles to ascii, 'd to a'), using the efficient Grisu3 algorithm" +utils dyn "Dynamic type" +utils dynload-sys "Sys.argv override for dynamically loaded libraries" +utils easy-format +utils ez_api "Easy API library and tools" +utils fieldslib "Syntax extension to define first class values representing record fields, to get and set record fields, iterate and fold over all fields of a record and create new record values" +utils gen "Iterators for OCaml, both restartable and consumable" +utils GT "Generic programming with extensible transformations" +utils hack_parallel "Parallel and shared memory library" +utils higher_kinded "A library with an encoding of higher kinded types in OCaml" +utils higher "Library for higher-kinded programming" +utils iter "Simple abstraction over `iter` functions, intended to iterate efficiently on collections while performing some transformations" +utils lens "Functional lenses" +utils linkage "easier plugin loading" +utils make-random "Helper to build a module similar to Stdlib.Random" +utils maki "Persistent incremental computations, for repeatable tests and benchmarks." +utils missinglib "Collection of OCaml-related utilities" +utils mixture "The Mixture package is a mixin library for the module system" +utils monomorphic +utils more-ocaml "Support code for the book 'More OCaml'" +utils mwt "Mediumweight thread library for OCaml via Lwt" +utils nproc "Process pool implementation for OCaml." +utils ocaml-basics "Implements common functionnal patterns / abstractions" +utils ocaml_intrinsics "Intrinsics" +utils ocaml_plugin "Automatically build and dynlink OCaml source files" +utils ocplib-endian +utils ocplib_stuff "Basic stuff used by some OCP libraries and tools" +utils offheap "Copies OCaml objects out of the OCaml heap" +utils optint "Efficient integer types on 64-bit architectures" +utils orec "dynamic open records" +utils pa_ovisitor +utils parany "Parallelize any computation" +utils parmap "Minimalistic library allowing to exploit multicore architecture" +utils pattern "Run-time patterns that explain match failures" +utils plato "Python Library Adapted To OCaml" +utils prbnmcn-basic-structures "Base package for prbnmcn-* packages" +utils prbnmcn-stats "Basic statistics" +utils pringo "Pseudo-random, splittable number generators" +utils pumping "Regular languages in types" +utils pure-splitmix "Purely functional splittable PRNG" +utils record_builder "A library which provides traversal of records with an applicative" +utils records "Records" +utils regular "Library for regular data types" +utils reins +utils repr "Dynamic type representations. Provides no stability guarantee" +utils revops "Reversible operations" +utils selective "Selective applicative functors in OCaml" +utils sendmsg "π-calculus? In _my_ kernel?" +utils shared-secret "Exceptions are shared secrets" +utils simple63 "Integer compression and decompression module" +utils spotlib "Useful functions for OCaml programming used by @camlspotter" +utils stdint "Signed and unsigned integer types having specified widths" +utils stdune "Dune's unstable standard library" +utils subtype-refinement "Refinement types encoded with private types in OCaml" +utils traits "Common traits for generic functionality" +utils type_conv "Library for building type-driven syntax extensions" +utils typehashlib "Part of Jane Street’s Core library" +utils typerep_extended "Runtime types for OCaml" +utils typerep "typerep is a library for runtime types." +utils typeset "An embedded DSL for defining source code pretty printers" +utils unmagic "Runtime tag-checking of marshaled ocaml data" +utils variantslib "Part of Jane Street's Core library" +utils zephyrus "Zephyrus automatic configuration generation tool." +variants bsbnative "bsb-native is BuckleScript's bsb but for ocamlc and ocamlopt" +variants dkml-base-compiler "OCaml cross-compiler and libraries from the DKML distribution that works with at least Win32 and macOS" +variants dkml-component-staging-ocamlrun "DKML component for ocamlrun" +variants dkml-component-staging-opam32 "DKML component for 32-bit versions of opam" +variants dkml-component-staging-opam64 "DKML component for 64-bit versions of opam" +variants dkml-component-xx-console +variants dkml-c-probe +variants dkml-dune-dsl +variants dkml-dune-dsl-show +variants dkml-install "API and registry for Diskuv OCaml (DKML) installation components" +variants dkml-install-installer "Build tools for DKML installers" +variants dkml-install-runner "Runner executable for Diskuv OCaml (DKML) installation" +variants dkml-package-console +variants dkml-workflows +variants flowcaml +variants genlet "Let-insertion for MetaOCaml." +variants ocaml-base-compiler "First beta release of OCaml 5.0.0" +variants ocaml-beta "Virtual package for enabling OCaml beta releases" +variants ocamlcc "Compiler from OCaml bytecode executable files to C source code" +variants ocaml-compiler-libs "OCaml compiler libraries repackaged" +variants ocaml-config "OCaml Switch Configuration" +variants ocaml-freestanding-cross-aarch64 "Freestanding OCaml compiler" +variants ocaml-freestanding "Freestanding OCaml compiler" +variants ocaml-option-32bit "Set OCaml to be compiled in 32-bit mode for 64-bit Linux and OS X hosts" +variants ocaml-option-afl "Set OCaml to be compiled with afl-fuzz instrumentation" +variants ocaml-option-bytecode-only "Compile OCaml without the native-code compiler" +variants ocaml-option-default-unsafe-string "Set OCaml to be compiled without safe strings by default" +variants ocaml-option-flambda "Set OCaml to be compiled with flambda activated" +variants ocaml-option-fp "Set OCaml to be compiled with frame-pointers enabled" +variants ocaml-option-musl "Set OCaml to be compiled with musl-gcc" +variants ocaml-option-nnpchecker "Set OCaml to be compiled with --enable-naked-pointers-checker" +variants ocaml-option-nnp "Set OCaml to be compiled with --disable-naked-pointers" +variants ocaml-option-no-flat-float-array "Set OCaml to be compiled with --disable-flat-float-array" +variants ocaml-options-only-afl "Ensure that OCaml is compiled with AFL support enabled, and no other custom options" +variants ocaml-options-only-flambda "Ensure that OCaml is compiled with flambda activated, and no other custom options" +variants ocaml-options-only-flambda-fp "Ensure that OCaml is compiled with flambda and frame-pointer enabled, and no other custom options" +variants ocaml-options-only-fp "Ensure that OCaml is compiled with only frame-pointer enabled, and no other custom options" +variants ocaml-options-only-nnpchecker "Ensure that OCaml is compiled with enable-naked-pointers-checker, and no other custom options" +variants ocaml-options-only-nnp "Ensure that OCaml is compiled with no-naked-pointers, and no other custom options" +variants ocaml-options-only-no-flat-float-array "Ensure that OCaml is compiled with no-flat-float-array, and no other custom options" +variants ocaml-option-spacetime "Set OCaml to be compiled with spacetime activated" +variants ocaml-option-static "Set OCaml to be compiled with musl-gcc -static" +variants ocaml-options-vanilla "Ensure that OCaml is compiled with no special options enabled" +variants ocaml-secondary-compiler "OCaml 4.08.1 Secondary Switch Compiler" +variants ocaml-solo5-cross-aarch64 "Freestanding OCaml compiler" +variants ocaml-solo5 "Freestanding OCaml compiler" +variants ocaml-src "Compiler sources" +variants ocaml-system "The OCaml compiler (system version, from outside of opam)" +variants ocaml "The OCaml compiler (virtual package)" +variants ocaml-twt "The Whitespace Thing, a layout preprocessor for OCaml code" +variants ocaml-variants "Current trunk" +video ffmpeg-av "Bindings for the ffmpeg libraries -- top-level helpers" +video ffmpeg-avcodec "Bindings for the ffmpeg avcodec library" +video ffmpeg-avdevice "Bindings for the ffmpeg avdevice library" +video ffmpeg-avfilter "Bindings for the ffmpeg avfilter library" +video ffmpeg-avutil "Bindings for the ffmpeg avutil libraries" +video ffmpeg "Bindings for the ffmpeg libraries" +video ffmpeg-swresample "Bindings for the ffmpeg swresample library" +video ffmpeg-swscale "Bindings for the ffmpeg swscale library" +video frei0r "Bindings for the frei0r API which provides video effects" +video oplay "Raw YUV video player" +video schroedinger "Bindings for the schroedinger library to decode video files in Dirac format" +video theora "Bindings to libtheora" +web CamlGI "FastCGI and CGI library" +web camyll "A static site generator" +web ccss "CCSS is a preprocessor for CSS, extending the language with arithmetic operations and variables." +web cgi "Library for writing CGIs" +web cookie "Cookie handling for OCaml and ReasonML" +web cookies "HTTP cookies library for OCaml" +web cowabloga "Simple static blogging support" +web cow "Caml on the Web" +web css-parser "A CSS parser written in OCaml" +web dispatch "Path-based dispatching for client- and server-side applications" +web dream-accept "Accept headers parsing for Dream" +web dream-cli "Command Line Interface for Dream applications" +web dream-encoding "Encoding primitives for Dream" +web dream-htmx "Htmx utilities for Dream" +web dream-httpaf "Internal: shared http/af stack for Dream (server) and Hyper (client)" +web dream-livereload "Live reloading for Dream applications" +web dream-pure "Internal: shared HTTP types for Dream (server) and Hyper (client)" +web dream-serve "Static site server with live reload" +web dream "Tidy, feature-complete Web framework" +web eliom "Client/server Web framework" +web finch "Simple and fast site generator" +web FPauth-core "Easy authentication system for Dream framework" +web FPauth "Easy authentication system for Dream framework" +web FPauth-responses "Responses on basic events in FPauth-core authentication system" +web FPauth-strategies "Strategies to be used with FPauth-core authentication system" +web horned_worm "An easy functional Web app micro framework" +web jerboa "Jerboa is a minimalistic web framework for everyone" +web lambdoc "Library providing support for semantically rich documents in web applications." +web litiom "Extensions to Ocsigen's Eliom." +web minima-theme "OCaml port of the Jekyll Minima theme" +web naboris "Simple http server" +web ocamlapi_async "Path-based HTTP request routing for Ocaml" +web ocamlapi_lwt_unix "Path-based HTTP request routing for Ocaml" +web ocamlapi "Path-based HTTP request routing for Ocaml" +web ocamlapi_ppx "Path-based HTTP request routing for Ocaml" +web ocsigen-i18n "I18n made easy for web sites written with eliom" +web ocsigen-ppx-rpc "This PPX adds a syntax for RPCs for Eliom and Ocsigen Start" +web ocsigenserver "A full-featured and extensible Web server" +web ocsigen-start "An Eliom application skeleton ready to use to build your own application with users, (pre)registration, notifications, etc" +web ocsigen-toolkit "Reusable UI components for Eliom applications (client only, or client-server)" +web openapi_router "Http server agnostic Openapi documentation generation" +web opium-graphql "Run GraphQL servers with Opium" +web opium_kernel "Sinatra like web toolkit based on Lwt + Cohttp" +web opium "Sinatra like web toolkit based on Async + Cohttp" +web opium-testing "Testing library for Opium" +web owebl "A fast, light, and concurrent web framework inspired by Flask and Sinatra." +web rock "Minimalist framework to build extensible HTTP servers and clients" +web routes "Typed routing for OCaml applications" +web scgi "Simple Common Gateway Interface (SCGI) protocol support for interface with HTTP servers" +web sihl-cache "Cache service implementations for Sihl" +web sihl-contract "Sihl serivce interfaces" +web sihl-core "The core of the Sihl web framework" +web sihl-email "Email service implementations for Sihl" +web sihl-facade +web sihl-persistence "Sihl services to deal with data persistence" +web sihl-queue "Queue service implementations for Sihl" +web sihl-session "Sihl service to deal with sessions" +web sihl-storage "Storage service implementations for Sihl" +web sihl "The Sihl web framework" +web sihl-token "Token service implementations for Sihl" +web sihl-type "Contains Sihl types that are returned by Sihl services" +web sihl-user "User service implementations for Sihl" +web sihl-web "Sihl HTTP service and middlewares" +web sill "Implementation of Linear Session Types" +web slug "Url safe slug generator" +web soupault "Static website generator based on HTML rewriting" +web stationary "Static site generator" +web stone "Simple static website generator, useful for a portfolio or documentation pages" +web tiny_httpd_camlzip "Interface to camlzip for tiny_httpd" +web tiny_httpd "Minimal HTTP server using good old threads" +web wdialog "Dialog-oriented web applications" +web webbrowser "Open and reload URIs in browsers from OCaml" +web weberizer "Compile HTML templates into OCaml modules" +web webmachine "A REST toolkit for OCaml" +web wtr-ppx "Ppx to create routers" +web wtr "Well Typed Router" +web yurt "An HTTP framework for OCaml" +windows win-error "Manipulate Windows system errors" +windows win-eventlog "Log via the Windows event log from OCaml programs" +windows winsvc "Library to make OCaml program act as a Windows service" +xen libvhd "OCaml bindings for the C library 'libvhd' which allows the manipulation" +xen minios-xen "A minimal OS for running under the Xen hypervisor" +xen netchannel "Network device for reading and writing Ethernet frames via then Xen netfront/netback protocol" +xen vchan-unix "Xen Vchan implementation" +xen vchan "Xen Vchan implementation" +xen vchan-xen "Xen Vchan implementation" +xen xapi-backtrace "A simple library for recording and managing backtraces" +xen xapi-forkexecd "Sub-process control service for xapi" +xen xapi-idl "Interface descriptions and common boilerplate for xapi services." +xen xapi-inventory "Library for accessing the xapi toolstack inventory file" +xen xapi-libs-transitional "Further transitional libraries required by xapi" +xen xapi-rrdd "Performance monitoring daemon for xapi" +xen xapi-rrd "RRD library for use with xapi" +xen xapi-rrd-transport "Shared-memory protocols for exposing performance counters" +xen xapi-stdext "A deprecated collection of utility functions" +xen xapi-stdext-date "Xapi's standard library extension, Dates" +xen xapi-stdext-encodings "Xapi's standard library extension, Encodings" +xen xapi-stdext-pervasives "Xapi's standard library extension, Pervasives" +xen xapi-stdext-std "Xapi's standard library extension, Stdlib" +xen xapi-stdext-threads "Xapi's standard library extension, Threads" +xen xapi-stdext-unix "Xapi's standard library extension, Unix" +xen xapi-stdext-zerocheck "Xapi's standard library extension, Zerocheck" +xen xapi-tapctl "A library to control tapdisk on a Xen host" +xen xapi-xenops "Create/destroy/manipulate Xen domains" +xen xe "A command-line client for the 'xapi' service (as used in XenServer)" +xen xen-api-client +xen xenbigarray "Portable Bigarray intended for embedded Xen use" +xen xen-block-driver +xen xenctrl "Low-level Xen hypercall bindings." +xen xen-disk +xen xen-evtchn-unix "Xen event channel interface for Linux" +xen xen-evtchn "Xen event channel interface for MirageOS" +xen xen-gnt-unix "Xen grant table bindings for OCaml" +xen xen-gnt "Xen grant table bindings for OCaml" +xen xenstore_transport "Low-level libraries for connecting to a xenstore service on a xen host" +xen xenstore "Xenstore protocol in pure OCaml" +xen xentropyd "Xentropyd: provide entropy to Xen VMs" +xen xe-unikernel-upload "A simple tool to upload a Unikernel to a XenServer pool." +xml decoders-ezxmlm "Ezxmlm backend for decoders" +xml erm_xml "XML stream parser" +xml ezxmlm "Combinators for parsing and selection of XML structures" +xml ocaml-expat "Write XML-Parsers using the SAX method" +xml ocaml-xml-rpc +xml pxp "Polymorphic XML Parser" +xml tyxml "A library for building correct HTML and SVG documents" +xml tyxml-jsx "JSX syntax to write TyXML documents" +xml tyxml-lwd "Make reactive webpages in Js_of_ocaml using Tyxml and Lwd" +xml tyxml-ppx "PPX to write TyXML documents with the HTML syntax" +xml tyxml-syntax "Common layer for the JSX and PPX syntaxes for Tyxml" +xml xmelly "Simplest way to do simple parsing of simple XML files in OCaml" +xml xmldiff "Computing and applying diffs on XML trees" +xml xmldiff_js "Using Xmldiff on DOM" +xml xml-light "Xml-Light is a minimal XML parser & printer for OCaml" +xml xmlm "Streaming XML codec for OCaml" +xml xtmpl_js "Xml templating library, javascript library" +xml xtmpl_ppx "Xml templating library, ppx extension" +xml xtmpl "Small XML templating library." diff --git a/vendor/sherlodoc/www/static/robots.txt b/vendor/sherlodoc/www/static/robots.txt new file mode 100644 index 0000000000..e223f09833 --- /dev/null +++ b/vendor/sherlodoc/www/static/robots.txt @@ -0,0 +1,3 @@ +User-agent: * +Allow: /$ +Disallow: / diff --git a/vendor/sherlodoc/www/static/style.css b/vendor/sherlodoc/www/static/style.css new file mode 100644 index 0000000000..98e5bca588 --- /dev/null +++ b/vendor/sherlodoc/www/static/style.css @@ -0,0 +1,231 @@ +html { + min-height: 100%; +} + +body { + margin: 0; + padding: 0; + margin-bottom: 1em; + min-height: 100%; + background: url("/bg.jpg") no-repeat bottom right; + font-family: system-ui, sans-serif; +} + +form { + display: flex; + margin: 0; + padding: 1rem; + background-color: #EABB60; + border-bottom: 2px solid #C78746; + position: fixed; + top: 0px; + width: 100%; + height: 2.5em; +} + +#results { + margin-top: 7.5em; +} + +input { + line-height: 1.5em; +} + +input[type="text"] { + width: 80%; + background-color: #FADFB1; + font-size: 1.5em; + border: none; + margin-right: -2px; + padding: 0 0.5em; + margin-left: 1.7em; + outline: 1px solid #553515; +} +input[type="submit"] { + padding: 0 1em; + font-size: 1.5em; + background-color: #C78746; + border: none; + color: #553515; + font-weight: bold; + outline: 1px solid #553515; +} + +a { + text-decoration: none; +} + +.comment p { + line-height: 1.3em; +} + +.comment pre { + margin: 0 2em; + font-size: 1.1rem; + white-space: pre; +} + +.found > li > pre { + margin: 0.5em; + padding-left: 6em; + text-indent: -6em; + font-size: 1.1rem; + white-space: normal; +} + +pre em { + font-style: normal; + font-weight: bold; +} + +ul { + margin: 0; + padding: 0; +} + +.found > li { + list-style: none; + margin: 0; + padding: 0; + margin-bottom: 1.5em; + margin-right: 5em; + margin-left: 0.95em; +} + +.found > li > pre em { + margin: 0 -3px; + padding: 3px; + color: black; +} + +.found > li:hover > pre em { + background: #FADFB1; +} + +.found > li > pre a:hover em { + background: #EABB60; + border-bottom: 2px solid #553515; +} + + +h1, ul.doc, .comment { + margin: 0; + padding: 0; + margin-left: 3.4rem; +} + +.comment a, .comment a:visited { color: black } +.comment .at-tag { font-style: italic } +.comment li { list-style: square } + +h1 { + margin-bottom: 1em; + font-size: 3em; + font-family: serif; +} + +p.doc { + margin-bottom: 1em; + margin-left: 2.3em; + font-size: 1.5em; +} + +ul.doc > li { + margin-bottom: 0.5em; +} + +.doc code { + font-size: 1rem; + background: #eee; + padding: 0.1em 0.5em; +} + +.query { + background-color: #FADFB1; + border-top: 1px solid #C78746; + border-bottom: 2px solid #C78746; + position: fixed; + top: 4.5em; + width: 100%; + padding: 0.3em 4.2em; + font-style: italic; + color: #553515; +} +.query code { + margin-left: 1em; +} + +code { + font-size: 1rem; +} + +.pkg { + margin-left: 3em; + margin-bottom: -0.4em; +} + +.pkg a, .pkg a:visited { + margin: 0; + font-weight: bold; + font-size: 0.8em; + padding: 0 5px; + color: #1A3B60; +} + +.pkg .version { + font-weight: normal; + color: #8BA4C0; +} + +.pkg a:hover, .pkg a:hover .version { + background: #3D5570; + color: white !important; + text-decoration: none; +} + +.ad { + padding: 3rem 0; + margin-left: 2.3em; + font-style: italic; + font-size: 1rem; +} + +pre, code, .ad, .packages a, input#q { + font-family: ui-monospace, 'Fira Code', 'Cascadia Code', 'Source Code Pro', Menlo, Consolas, 'DejaVu Sans Mono', monospace; +} + +.ad svg { vertical-align: middle; margin-right: 0.5rem } + +.categories { + margin: 0; + margin-top: 3em; + margin-left: 2.5em; + margin-right: 2.5em; + padding: 0; + column-count: 4; + column-gap: 1em; + column-width: 20em; + line-height: 1.1em; +} + +.categories .category { + margin: 0; + padding: 0; + display: inline-block; +} + +.category h3 { + margin: 0; + padding: 0; + margin-top: 1.5em; + margin-bottom: 0.7em; +} + +.packages a { + display: inline-block; + white-space: nowrap; + margin-right: 1.5em; +} +.packages a:hover { + background: #eee; +} diff --git a/vendor/sherlodoc/www/ui.ml b/vendor/sherlodoc/www/ui.ml new file mode 100644 index 0000000000..c237e37966 --- /dev/null +++ b/vendor/sherlodoc/www/ui.ml @@ -0,0 +1,183 @@ +open Tyxml.Html + +let list_of_option = function + | None -> [] + | Some x -> [ x ] + +let render_link elt = [ a_href (Db.Entry.link elt) ] + +let string_of_kind = + let open Db.Entry.Kind in + function + | Doc -> "doc" + | Type_decl None -> "type" + | Type_decl (Some str) -> "type " ^ str + | Module -> "module" + | Exception _ -> "exception" + | Class_type -> "class" + | Method -> "method" + | Class -> "class" + | Type_extension -> "type" + | Extension_constructor _ -> "constructor" + | Module_type -> "module type" + | Constructor _ -> "constructor" + | Field _ -> "field" + | Val _ -> "val" + +let render_elt elt = + let open Db.Entry in + let link = render_link elt in + let html_txt = Unsafe.data in + let rhs = + match elt.rhs with + | Some rhs -> [ html_txt rhs ] + | None -> [] + in + let kind = string_of_kind elt.kind ^ " " in + let doc = + if elt.doc_html = "" + then [] + else [ div ~a:[ a_class [ "comment" ] ] [ Unsafe.data elt.doc_html ] ] + in + pre (txt kind :: a ~a:link [ em [ txt elt.name ] ] :: rhs) :: doc + +let render_pkg elt = + let open Db.Entry in + let { Package.name; version } = elt.pkg in + let link = Package.link elt.pkg in + [ div + ~a:[ a_class [ "pkg" ] ] + [ a + ~a:[ a_href link ] + [ txt name; txt " "; span ~a:[ a_class [ "version" ] ] [ txt version ] ] + ] + ] + +let render_result elt = render_pkg elt @ render_elt elt + +let render ~pretty results = + match results with + | [] -> div ~a:[ a_class [ "query" ] ] [ txt "No results! "; code [ txt pretty ] ] + | _ -> + div + [ div ~a:[ a_class [ "query" ] ] [ txt "Results for "; code [ txt pretty ] ] + ; ul ~a:[ a_class [ "found" ] ] @@ List.map (fun r -> li (render_result r)) results + ] + +let ajax_reload = + {js| + var latest = 0; + var current = 0; + document.getElementById('q').addEventListener('input', function(e) { + var param = encodeURIComponent(e.target.value); + ++latest; + var self = latest; + var req = new XMLHttpRequest(); + req.onreadystatechange = function() { + if (this.readyState === 4 && current < self) { + current = self; + document.getElementById('results').innerHTML = this.response; + } + }; + req.open('GET', '/api?q=' + param, true); + req.send(); + var url = param === '' ? '/' : '/?q=' + param; + history.replaceState(null, 'Sherlodoc', url); + }); + |js} + +let search_form query = + div + ~a:[ a_class [ "header" ] ] + [ form + ~a:[ a_method `Get ] + [ input + ~a: + [ a_input_type `Text + ; a_id "q" + ; a_name "q" + ; a_value query + ; a_placeholder "Search..." + ; a_autofocus () + ; a_autocomplete `Off + ] + () + ; input ~a:[ a_input_type `Submit; a_value "Search!" ] () + ] + ; script (Unsafe.data ajax_reload) + ] + +let template query contents = + html + ~a:[ a_lang "en" ] + (head + (title (txt "Sherlodoc")) + [ meta ~a:[ a_charset "UTF-8" ] () + ; meta ~a:[ a_name "viewport"; a_content "width=device-width, initial-scale=1" ] () + ; link ~rel:[ `Stylesheet ] ~href:"/s.css" () + ]) + @@ body [ search_form query; div ~a:[ a_id "results" ] [ contents ] ] + +let github_icon = + let open Tyxml.Svg in + Tyxml.Html.svg + ~a:[ a_width (16., None); a_height (16.0, None); a_viewBox (0., 0., 16., 16.) ] + [ path + ~a: + [ a_d + "M8 0C3.58 0 0 3.58 0 8c0 3.54 2.29 6.53 5.47 7.59.4.07.55-.17.55-.38 \ + 0-.19-.01-.82-.01-1.49-2.01.37-2.53-.49-2.69-.94-.09-.23-.48-.94-.82-1.13-.28-.15-.68-.52-.01-.53.63-.01 \ + 1.08.58 1.23.82.72 1.21 1.87.87 \ + 2.33.66.07-.52.28-.87.51-1.07-1.78-.2-3.64-.89-3.64-3.95 \ + 0-.87.31-1.59.82-2.15-.08-.2-.36-1.02.08-2.12 0 0 .67-.21 2.2.82.64-.18 \ + 1.32-.27 2-.27.68 0 1.36.09 2 .27 1.53-1.04 2.2-.82 2.2-.82.44 1.1.16 \ + 1.92.08 2.12.51.56.82 1.27.82 2.15 0 3.07-1.87 3.75-3.65 \ + 3.95.29.25.54.73.54 1.48 0 1.07-.01 1.93-.01 2.2 0 .21.15.46.55.38A8.012 \ + 8.012 0 0 0 16 8c0-4.42-3.58-8-8-8z" + ] + [] + ] + +let link_to_repo = + p + ~a:[ a_class [ "ad" ] ] + [ txt {|(* Read the source, fork and contribute to |} + ; a + ~a:[ a_href "https://github.com/art-w/sherlodoc" ] + [ github_icon; txt "art-w/sherlodoc" ] + ; txt " *)" + ] + +let link str = a ~a:[ a_href ("?q=" ^ Uri.pct_encode str) ] [ code [ txt str ] ] + +let explain () = + div + ~a:[ a_class [ "doc" ] ] + [ h1 [ txt "Sherlodoc" ] + ; p + ~a:[ a_class [ "doc" ] ] + [ txt "Fuzzy search in OCaml's documentation for almost all opam packages." ] + ; ul + ~a:[ a_class [ "doc" ] ] + [ li [ txt "Search by name: "; link "concat map"; txt " and "; link "Lwt pool" ] + ; li [ txt "Search by type with a colon: "; link ": list list -> list" ] + ; li + [ txt "Search on name and type with a colon separator: " + ; link "Yojson : t -> string" + ] + ; li [ txt "Search for constructors of a type: "; link ": Gg.color" ] + ; li + [ txt "Use _ to omit a subtype and search for consumers of a type: " + ; link ": Gg.color -> _" + ] + ; li + [ txt "Products and reordering of arguments: " + ; link ": 'a list -> ('a * int -> bool) -> 'a list" + ] + ] + ; Packages.html () + ; link_to_repo + ] + +let explain = lazy (explain ()) +let explain () = Lazy.force explain diff --git a/vendor/sherlodoc/www/www.ml b/vendor/sherlodoc/www/www.ml new file mode 100644 index 0000000000..91032d6be4 --- /dev/null +++ b/vendor/sherlodoc/www/www.ml @@ -0,0 +1,125 @@ +module Storage = Db.Storage +module H = Tyxml.Html +open Lwt.Syntax + +module Query_lwt = Query.Make (struct + type 'a t = 'a Lwt.t + + let return = Lwt.return + let map x f = Lwt.map f x + let bind x f = Lwt.bind x f + end) + +let api ~shards params = + let+ results = Query_lwt.search ~shards params in + let pretty = Query.pretty params in + Ui.render ~pretty results + +let api ~shards params = + if String.trim params.Query.query = "" + then Lwt.return (Ui.explain ()) + else api ~shards params + +let get_query params = Option.value ~default:"" (Dream.query params "q") + +let get_packages params = + match Dream.query params "packages" with + | None -> [] + | Some str -> String.split_on_char ',' str + +let get_limit params = + let default = 100 in + match Dream.query params "limit" with + | None -> default + | Some str -> + (try max 1 (min default (int_of_string str)) with + | _ -> default) + +let get_params params = + { Query.query = get_query params + ; packages = get_packages params + ; limit = get_limit params + } + +let root fn params = + let* result = fn params in + Dream.html result + +let string_of_tyxml html = Format.asprintf "%a" (Tyxml.Html.pp ()) html +let string_of_tyxml' html = Format.asprintf "%a" (Tyxml.Html.pp_elt ()) html + +let root fn params = + let params = get_params params in + try root fn params with + | err -> + Format.printf "ERROR: %S@." (Printexc.to_string err) ; + Dream.html (string_of_tyxml @@ Ui.template params.query (Ui.explain ())) + +let root fn params = + try root fn params with + | _ -> Dream.html (string_of_tyxml @@ Ui.template "" (Ui.explain ())) + +let cache_header : int option -> Dream.middleware = + fun max_age f req -> + let+ response = f req in + begin + match max_age with + | None -> () + | Some max_age -> + Dream.add_header + response + "Cache-Control" + ("public, max-age=" ^ string_of_int max_age) + end ; + response + +let cors_header f req = + let+ response = f req in + Dream.add_header response "Access-Control-Allow-Origin" "*" ; + response + +let cors_options = + Dream.options "**" (fun _ -> + let+ response = Dream.empty `No_Content in + Dream.add_header response "Access-Control-Allow-Methods" "GET, OPTIONS" ; + Dream.add_header response "Access-Control-Allow-Headers" "*" ; + response) + +let static ctype contents = Dream.respond ~headers:[ "Content-Type", ctype ] contents +let style_css _ = static "text/css" [%blob "www/static/style.css"] +let favicon_ico _ = static "image/x-icon" [%blob "www/static/favicon.ico"] +let robots_txt _ = static "text/plain" [%blob "www/static/robots.txt"] +let bg_jpg _ = static "image/jpeg" [%blob "www/static/bg.jpg"] + +let main cache_max_age db_format db_filename = + let module Storage = (val Db_store.storage_module db_format) in + let shards = Storage.load db_filename in + Dream.run ~interface:"127.0.0.1" ~port:1234 + @@ Dream.logger + @@ cache_header cache_max_age + @@ cors_header + @@ Dream.router + [ Dream.get + "/" + (root (fun params -> + let+ result = api ~shards params in + string_of_tyxml @@ Ui.template params.query result)) + ; Dream.get + "/api" + (root (fun params -> + let+ result = api ~shards params in + string_of_tyxml' result)) + ; Dream.get "/s.css" style_css + ; Dream.get "/robots.txt" robots_txt + ; Dream.get "/favicon.ico" favicon_ico + ; Dream.get "/bg.jpg" bg_jpg + ; cors_options + ] + +open Cmdliner + +let cache_max_age = + let doc = "HTTP cache max age (in seconds)" in + Arg.(value & opt (some int) None & info [ "c"; "cache" ] ~docv:"MAX_AGE" ~doc) + +let term = Term.(const main $ cache_max_age) diff --git a/vendor/sherlodoc/www/www.mli b/vendor/sherlodoc/www/www.mli new file mode 100644 index 0000000000..fae8900e05 --- /dev/null +++ b/vendor/sherlodoc/www/www.mli @@ -0,0 +1 @@ +val term : (Db_store.db_format -> string -> unit) Cmdliner.Term.t