├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .ocamlformat ├── LICENSE ├── Makefile ├── README.md ├── doc └── design.md ├── dune ├── dune-project ├── src ├── voodoo-do │ ├── do.ml │ ├── do.mli │ ├── dune │ ├── main.ml │ └── main.mli ├── voodoo-gen │ ├── dune │ ├── generate_html_docs.ml │ ├── generate_html_docs.mli │ ├── main.ml │ ├── main.mli │ ├── markdown.ml │ ├── markdown.mli │ ├── package_info.ml │ ├── package_info.mli │ ├── search_index.ml │ └── search_index.mli ├── voodoo-prep │ ├── dune │ ├── main.ml │ ├── main.mli │ ├── opam.ml │ ├── opam.mli │ ├── package.ml │ ├── package.mli │ ├── paths.ml │ ├── paths.mli │ ├── prep.ml │ ├── prep.mli │ ├── util.ml │ └── util.mli └── voodoo │ ├── compat.ml │ ├── compat.mli │ ├── dune │ ├── error_log.ml │ ├── error_log.mli │ ├── index_mld_page.ml │ ├── index_mld_page.mli │ ├── library_names.ml │ ├── library_names.mli │ ├── mld.ml │ ├── mld.mli │ ├── odoc.ml │ ├── odoc.mli │ ├── opam.ml │ ├── opam.mli │ ├── otherdocs.ml │ ├── otherdocs.mli │ ├── package.ml │ ├── package.mli │ ├── package_info.ml │ ├── package_info.mli │ ├── package_mlds.ml │ ├── package_mlds.mli │ ├── paths.ml │ ├── paths.mli │ ├── serialize │ ├── conv.ml │ ├── conv.mli │ ├── dune │ ├── fpath_.ml │ ├── fpath_.mli │ ├── package_info.ml │ ├── package_info.mli │ ├── status.ml │ ├── status.mli │ ├── string_.ml │ ├── string_.mli │ ├── util.ml │ └── util.mli │ ├── sourceinfo.ml │ ├── sourceinfo.mli │ ├── sourceinfo_index.ml │ ├── sourceinfo_index.mli │ ├── util.ml │ ├── util.mli │ ├── voodoo.ml │ └── voodoo.mli ├── test ├── can-read-library-names.t ├── can-render-org-files.t ├── can-render-tables.t ├── dune ├── packages │ ├── can-read-library-names │ │ ├── can-read-library-names.opam │ │ ├── dune-project │ │ ├── lib │ │ │ ├── dune │ │ │ ├── wrapped_module1.ml │ │ │ └── wrapped_module2.ml │ │ ├── lib2 │ │ │ ├── dune │ │ │ └── singleton.ml │ │ ├── lib3 │ │ │ ├── dune │ │ │ ├── unwrapped_module1.ml │ │ │ └── unwrapped_module2.ml │ │ └── test │ │ │ ├── dune │ │ │ └── test_test_project.ml │ ├── can-render-org-files │ │ ├── README.org │ │ ├── can-render-org-files.opam │ │ ├── dune │ │ ├── dune-project │ │ ├── lib.ml │ │ └── lib.mli │ └── can-render-tables │ │ ├── README.md │ │ ├── can-render-tables.opam │ │ ├── doc │ │ ├── dune │ │ └── index.mld │ │ ├── dune │ │ ├── dune-project │ │ ├── lib.ml │ │ └── lib.mli ├── uninstalled_package.t └── unit │ └── serialize │ ├── dune │ ├── main.ml │ ├── test_fpath.ml │ ├── test_package_info.ml │ ├── test_status.ml │ └── test_string.ml ├── voodoo-do.opam ├── voodoo-gen.opam ├── voodoo-lib.opam └── voodoo-prep.opam /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build-and-test: 11 | strategy: 12 | fail-fast: false 13 | 14 | matrix: 15 | os: 16 | - macos-latest 17 | - ubuntu-latest 18 | 19 | ocaml-compiler: 20 | - 5.0.x 21 | 22 | runs-on: ${{ matrix.os }} 23 | 24 | steps: 25 | - name: Checkout code 26 | uses: actions/checkout@v2 27 | 28 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 29 | uses: ocaml/setup-ocaml@v2 30 | with: 31 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 32 | 33 | - name: Install opam packages 34 | run: opam install . --with-test --deps-only 35 | 36 | - name: Run build 37 | run: opam exec -- dune build --root . 38 | 39 | - name: Run the unit tests 40 | run: opam exec -- dune test --root . 41 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Dune build directory 2 | _build/ 3 | 4 | # Local OPAM switch 5 | _opam/ 6 | 7 | # Generated files 8 | _generated/ 9 | *.mld 10 | compile/ 11 | html/ 12 | linked/ 13 | prep/ 14 | output/ 15 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.25.1 2 | profile=conventional 3 | parse-docstrings=true 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | ISC License 2 | 3 | Copyright (c) 2021 Jon Ludlam 4 | 5 | Permission to use, copy, modify, and/or distribute this software for any 6 | purpose with or without fee is hereby granted, provided that the above 7 | copyright notice and this permission notice appear in all copies. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ARGS := $(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)) 2 | $(eval $(ARGS):;@:) 3 | 4 | .PHONY: all 5 | all: 6 | opam exec -- dune build --root . @install 7 | 8 | .PHONY: deps 9 | deps: ## Install development dependencies 10 | opam install -y ocamlformat=0.25.1 11 | opam install --deps-only --with-test --with-doc -y . 12 | 13 | .PHONY: create_switch 14 | create_switch: 15 | opam switch create . --no-install 16 | 17 | .PHONY: switch 18 | switch: create_switch deps ## Create an opam switch and install development dependencies 19 | 20 | .PHONY: build 21 | build: ## Build the project, including non installable libraries and executables 22 | opam exec -- dune build --root . 23 | 24 | .PHONY: install 25 | install: all ## Install the packages on the system 26 | opam exec -- dune install --root . 27 | 28 | .PHONY: test 29 | test: ## Run the unit tests 30 | opam exec -- dune test --root . 31 | 32 | .PHONY: clean 33 | clean: ## Clean build artifacts and other generated files 34 | opam exec -- dune clean --root . 35 | 36 | .PHONY: doc 37 | doc: ## Generate odoc documentation 38 | opam exec -- dune build --root . @doc 39 | 40 | .PHONY: fmt 41 | fmt: ## Format the codebase with ocamlformat 42 | opam exec -- dune build --root . --auto-promote @fmt 43 | 44 | .PHONY: utop 45 | utop: ## Run a REPL and link with the project's libraries 46 | opam exec -- dune utop --root . lib -- -implicit-bindings 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

2 | voodoo 3 |

4 | 5 |

6 | Voodoo uses odoc to generate the package documentation for OCaml.org 7 |

8 | 9 |

10 | 11 | OCaml-CI Build Status 12 | 13 |

14 | 15 | ## :rocket: Getting started 16 | 17 | **voodoo** is intended to be used as part of an 18 | [ocurrent](https://github.com/ocurrent/ocurrent) pipeline, for example 19 | via [ocaml-docs-ci](https://github.com/ocurrent/ocaml-docs-ci). 20 | 21 | You need `opam`, you can install it by following [Opam's documentation](https://opam.ocaml.org/doc/Install.html). 22 | 23 | With `opam` installed, you can install the dependencies in a new local switch with: 24 | 25 | ```bash 26 | make switch 27 | ``` 28 | 29 | Then, build the project with: 30 | 31 | ```bash 32 | make build 33 | ``` 34 | 35 | **voodoo** is run in three successive steps detailed below. 36 | 37 | ## :seedling: 1. Prepare the packages: voodoo-prep 38 | 39 | To prepare the packages just run: 40 | 41 | ```sh 42 | voodoo-prep [-u ] 43 | ``` 44 | 45 | Where `` is a comma-separated list of packages and universes `pkg1:unv1,pkg2:unv2,...`. 46 | 47 | When you don't provide a universe explicitly, each package installed in the current switch will be prepared (prepped) for the compiling step. 48 | 49 | This creates an ad-hoc directory structure and populates it with `.cmt`, `.cmi`, `.cmti`, `.mld` from the current switch. 50 | The `ocamlobjinfo` of the `.cma` files are also copied, as well as the documentation files such as `.md`, `.html` and others (such as the `opam` files). 51 | 52 | 53 | ## :sweat_drops: 2. Compiling and linking the packages: voodoo-do 54 | 55 | Once `voodoo-prep` has run, `voodoo-do` is able to process packages. Simply run: 56 | 57 | ```sh 58 | voodoo-do -p [-b] [--failed] 59 | ``` 60 | 61 | This command runs `odoc compile` and `odoc link` on the package specified after `-p`. 62 | If the `--failed` flag is set, a file named `failed` containing `"failed"` is also generated. 63 | 64 | If the packages are processed out of dependency order, `voodoo-do` will alert that there are missing dependencies. 65 | 66 | ```sh 67 | voodoo-do -p odoc -b 68 | ... 69 | Missing dependency: Stdlib c21c5d26416461b543321872a551ea0d 70 | ... 71 | ``` 72 | 73 | In this case, we need to run `voodoo-do -p ocaml-base-compiler -b` first. 74 | 75 | Note that when being used in this mode, the `-b` flag should always be passed to `voodoo-do`. 76 | 77 | At this point, to view the output, use `odoc` to generate the support files (mostly: copying `highlight.js` from https://highlightjs.org and `odoc.css`): 78 | 79 | ```bash 80 | cd .. 81 | odoc support-files -o html 82 | ``` 83 | 84 | You can load the package index in your browser: 85 | 86 | ```sh 87 | open ./html/p///doc/index.html 88 | ``` 89 | 90 | ## :deciduous_tree: 3. Rendering the packages: voodoo-gen 91 | 92 | Once `voodoo-do` has run, you can generate the website with the documentation, run: 93 | 94 | ```bash 95 | voodoo-gen -o [-n ] [--pkg-version ] 96 | ``` 97 | 98 | This command runs `odoc html-generate` to render the files of the specified package as html. 99 | 100 | You can serve it with: 101 | 102 | ```bash 103 | opam install dream-serve 104 | dream-serve ./html 105 | ``` 106 | 107 | Load the package index in your browser: 108 | 109 | ```bash 110 | $ open http://localhost:8080/p///doc/index.html 111 | ``` 112 | 113 | ## :horse_racing: TLDR 114 | 115 | 1. Install packages to be documented in the current switch using `opam` 116 | 1. Create `_generated` directory 117 | 1. Run `voodoo-prep`. This creates the _ad-hoc_ directory structure inside `_generated` and populates it with `.cmt`, `.cmi`, `.cmti`, `.mld` from the current switch. Documentation files such as `.md`, `.html` and others are also copied. 118 | 1. Run `voodoo-do` on each package to compile and link the odoc files. 119 | 1. Run `voodoo-gen` to create the `_generated/output` directory and generate the HTML files. 120 | 1. Run `odoc support-files -o _generated/html` to add css and styling to the `html` subdirectory 121 | 1. Serve `_generated/html` 122 | 123 | `voodoo-*` commands must be called from the `_generated` directory. 124 | 125 | ```sh 126 | mkdir _generated 127 | cd _generated 128 | opam exec -- dune exec -- voodoo-prep 129 | opam exec -- dune exec -- voodoo-do -p -b 130 | opam exec -- dune exec -- voodoo-gen -o output 131 | cd .. 132 | odoc support-files -o _generated/html 133 | dream-serve _generated/html 134 | ``` 135 | -------------------------------------------------------------------------------- /doc/design.md: -------------------------------------------------------------------------------- 1 | # Initial design 2 | 3 | Contacts: @julow @jonludlam 4 | 5 | 6 | ## Voodoo 7 | 8 | - outline the whole process 9 | 10 | Stages of the process: 11 | 12 | 1. Decide what to build, recording decisions made. Concretely, we record the fact that we intend to build specific sets of opam packages at specific versions with a specific version of OCaml. 13 | 2. Run the build with ocluster (voodoo-submit) 14 | 3. Extract the all the information we need from each build, without making decisions about how it's presented (voodoo-prep) 15 | 4. Assemble the build results and make decisions on presentation (voodoo-assemble) 16 | 5. Perform the build, outputting html (voodoo-odoc) 17 | 6. Goto 1 18 | 19 | 20 | This may be an ocurrent pipeline or a shell script. 21 | 22 | - `voodoo-submit` 23 | Expect its output in a `prep` directory. 24 | - `voodoo-assemble` 25 | + Deeply copy `prep` into `assemble` 26 | To make sure we don't loose data when doing changes to assemble 27 | This can be optimized (eg. symlinks) 28 | + TODO: add a CLI to assemble 29 | + `voodoo-assemble assemble` 30 | (will mutate the assemble tree) 31 | - Generate the "compile" Makefile 32 | + `cd compile; odocmkgen gen ../assemble > Makefile` 33 | (the `cd` weird thing is because paths are relative in the generated Makefile) 34 | We place the generated Makefile into a `compile` directory 35 | - Run the compilation 36 | + `make -C compile` 37 | - Generate the "generate" Makefile 38 | + `cd generate; odocmkgen generate ../compile/odocl > Makefile` 39 | - Run generate 40 | + `make -C generate` 41 | 42 | ### Dependency universes 43 | 44 | A package in not just defined by the tuple of package name and package version. Additionally, it may be dependent on any of the packages it depends upon - for example, consider a package containing an mli file such as: 45 | 46 | ```ocaml 47 | module M : Set.S with type elt = int 48 | ``` 49 | 50 | The expansion of this will depend on which version of the standard library it was compiled against. 51 | 52 | A particular package is therefore specified by the triple of the package name, the package version, and the 'dependency universe hash'. This has is computed in the following way: 53 | 54 | 1. Find all dependencies (including transitive dependencies, though not going 'through' the ocaml package) using opam. 55 | 2. Sort and write them to a string, one package per line, in the format `.` 56 | 3. Compute md5 hash of the string. 57 | 58 | For example: 59 | 60 | ``` 61 | conf-m4.1 62 | ocaml.4.11.1 63 | ocamlbuild.0.14.0 64 | ocamlfind.1.8.1 65 | topkg.1.0.3 66 | ``` 67 | 68 | which are the dependencies on this particular system for the package `astring.0.8.5`. The hash of this should be `92edc0c1c4ec93b2f61fdd7fc9491460` 69 | 70 | The type to uniquely identify a package is therefore given by: 71 | 72 | ```ocaml 73 | type universe_id = Digest.t 74 | type package_name = string 75 | type package_version = string 76 | 77 | type package = universe_id * package_name * package_version 78 | ``` 79 | 80 | 81 | ### Handling packages, sub-packages and libraries 82 | 83 | Because odoc handles include paths in the same way that OCaml does, and because we would like references to behave in the same familiar way that normal OCaml paths do, it makes sense to keep the `odoc` files in the identical directory structure to that of the associated `cmt`, `cmti` and `cmi` files. This does _not_ imply that the directory structure of the output `html` files (or man/latex files) must mirror this. The implication of this is that we _cannot_ determine parent/child hierarchy by simple directory structure (in general). 84 | 85 | As an example of the various ways complex packages are layed out, we have the following case studies: 86 | 87 | #### Case study: yaml 88 | 89 | - Compiled with dune. 90 | - Contains multiple packages, including a sub-sub-package: 91 | 92 | ``` 93 | yaml 94 | yaml.bindings 95 | yaml.bindings.types 96 | yaml.c 97 | yaml.ffi 98 | yaml.types 99 | yaml.unix 100 | ``` 101 | 102 | - Each sub-package corresponds with precisely one META file 103 | - Each sub-package corresponds with precisely one archive 104 | - Each package has an isolated include directory 105 | - All subdirs are underneath ~/.opam/$switch/lib/yaml 106 | 107 | #### Case study: oasis 108 | 109 | - Not compiled with dune 110 | - Contains multiple packages: 111 | 112 | ``` 113 | oasis 114 | oasis.base 115 | oasis.builtin-plugins 116 | oasis.cli 117 | oasis.dynrun 118 | ``` 119 | 120 | - Two META files - one in ~/.opam/$switch/lib/plugin-loader and the other in ~/.opam/$switch/lib/oasis 121 | - Each sub-package corresponds with precisely one archive 122 | - Multiple packages share the same directory 123 | 124 | #### Case study: dose3 125 | 126 | - Not compiled with dune 127 | - Contains multiple packages: 128 | 129 | ``` 130 | dose3 131 | dose3.algo 132 | dose3.common 133 | dose3.csw 134 | dose3.debian 135 | dose3.doseparse 136 | dose3.doseparseNoRpm 137 | dose3.npm 138 | dose3.opam 139 | dose3.pef 140 | dose3.rpm 141 | dose3.versioning 142 | ``` 143 | 144 | - One META file, in ~/.opam/$switch/lib/dose3 145 | - The dose3 package contains multiple archives - `"common.cma algo.cma versioning.cma pef.cma debian.cma csw.cma opam.cma npm.cma"` 146 | - Sub-packages also contain the same archives - e.g. dose3.algo specifies `algo.cma` 147 | 148 | #### Case study: stdlib and associated libraries 149 | 150 | - Not compiled with dune 151 | - Contains multiple libraries, the exact list depends on the OCaml version: 152 | 153 | ``` 154 | bigarray 155 | bytes 156 | compiler-libs 157 | dynlink 158 | ocamldoc 159 | raw_spacetime 160 | stdlib 161 | str 162 | threads 163 | unix 164 | ``` 165 | 166 | - META files _not_ distributed with the package, they come with `ocamlfind` 167 | - META files in isolated directories, but many of the packages include dirs overlap 168 | 169 | #### Observations 170 | 171 | - Different sub-packages containing the same libraries is unusual. 172 | - It would be useful to be able to tell which subpackage contains which module, by URL/breadcrumbs 173 | 174 | Suggested layout: 175 | 176 | ``` 177 | /packages/$package/$version/TopLevelModules/index.html 178 | /packages/$package/$version/$subpackage/SubPackageModule/index.html 179 | ``` 180 | 181 | For example for `yaml`: 182 | 183 | ``` 184 | /packages/yaml/2.1.0/Yaml/index.html 185 | /packages/yaml/2.1.0/Yaml/Stream/index.html 186 | /packages/yaml/2.1.0/yaml.bindings/Yaml_bindings/index.html 187 | /packages/yaml/2.1.0/yaml.bindings.types/Yaml_bindings_types/index.html 188 | ``` 189 | 190 | Questions: 191 | 192 | - What do we do for something like dose3? 193 | - Can we just do nice docs for dune-based projects? probably not, not least due to Daniel's packages 194 | - How do we figure out which packages can be documented nicely? (e.g. no overlapping archives) 195 | 196 | - What do we do for the OCaml libraries (stdlib, seq, raw_spacetime, str etc -- these don't have opam packages -- mostly the META files come from the `ocamlfind` package) 197 | 198 | - What other packages will be painful? We have the 'corpus' compiled already, but missing files like META, dune-packages and so on. 199 | 200 | ### Package doc 201 | 202 | Most packages doesn't have documentation pages but have: 203 | 204 | - `doc/$/README.*` (.org or .md) 205 | - `doc/$/LICENSE.*` 206 | - `doc/$/CHANGES.*` 207 | - `lib/$/META` 208 | Every packages except the stdlib have it. 209 | It's the only way to know sub packages. 210 | - `lib/$/opam` 211 | Added by opam. 212 | - `lib/$/dune-package` 213 | Added by dune, only in projects using dune. 214 | Contains the same informations as `META`. 215 | - `lib/$/**.ml?` 216 | Source files, intended to be seen by merlin or why not, "see code" links from documentation. (Odoc should do that someday !) 217 | 218 | A few packages have documentation intended to be read by Odoc: 219 | 220 | - `doc/$/odoc-pages/index.mld` 221 | This is intended to be the entry point of the package's doc. 222 | `assemble` should use it has the package page, possibly modifying it to add a common header. 223 | - `doc/$/odoc-pages/*.mld` 224 | 225 | Various other files we can find sometimes: 226 | 227 | - `doc/$/*.ml` 228 | In dbuezli's libraries, it is meant to be appended at the end of `index.mld` automatically. 229 | - Some packages have things in `share/$` 230 | But these are not intended to be read by users (eg. emacs/vim plugins) 231 | 232 | `voodoo-prep` adds some other informations that may be useful: 233 | 234 | - List of dependencies to other packages 235 | 236 | ## Voodoo-submit 237 | 238 | Inputs: opam repository, s3 credentials, ocluster submission cap file 239 | 240 | ### First run 241 | 242 | - Uses 0install opam solver to obtain solutions for all versions of all packages with necessary constraints (e.g. ocaml > 4.02.3) and stores them 243 | - Submits jobs to ocluster embedding credentials for S3 storage of artefacts 244 | - each job is given the list of packages to install 245 | - each job is notified that one particular package is the 'target' package 246 | 247 | ### Subsequent runs 248 | 249 | - Finds new package/versions since last run 250 | - Submits required new jobs 251 | 252 | ## Voodoo-prep 253 | 254 | Repo: https://github.com/jonludlam/voodoo-prep 255 | 256 | This contains: 257 | - voodoo-prep (the tool) 258 | - odoc-upload.sh 259 | 260 | The job as submitted by voodoo-submit will install a specific set of packages. 261 | Once the job has completed, voodoo-prep, the binary, will be executed, and given the 'target' package on the command line. 262 | 263 | ### Voodoo-prep (the tool) 264 | 265 | Input: An opam environment 266 | Output: Opam packages compiled into a directory tree (voodoo-assemble's input) 267 | 268 | We iterate through all of the packages installed in the opam environment, and go through the files installed as part of each package, as recorded by `~/.opam//.opam-switch/install/.changes`. All typedtree and compiled interface files (.cmt, cmti and .cmi) files are copied into the following path: 269 | 270 | ``` 271 | prep/universes////lib/... 272 | ``` 273 | 274 | where the `...` represents the identical path the files appear under `~/.opam//lib` and `~/.opam//doc`. hash, package and version are the triple that uniquely identifies a package as described above. 275 | 276 | and all docs installed are copied into a similar path (TODO): 277 | 278 | ``` 279 | prep/universes////doc/... 280 | ``` 281 | 282 | The tool will also pick up `dune-package`, `META` and `opam` files. 283 | 284 | Additionally, the tool will run `odoc compile-depend` to record intra-package dependencies, and record the paths required for compilation for inter-package dependencies - that is, it will note that the package `foo` in universe `abc` depends upon package `bar` in universe `def`. 285 | 286 | We also collect the non-hidden modules contained in `cmxa/cma` libraries installed as part of the package. This is done as follows 287 | 288 | ``` 289 | ocamlobjinfo .cma | grep -E "^Unit name" | grep -v "__" 290 | ``` 291 | 292 | the output of which will be put in the field 'libraries' below. 293 | 294 | The data we collect per package looks like: 295 | 296 | ```ocaml 297 | (* Dependencies between cmt, cmti and cmi files that are all within this package *) 298 | type intra_dep = { 299 | source_file : string; 300 | deps : string list; 301 | } 302 | 303 | type deps = { 304 | intra : intra_dep list 305 | packages : (package * string list) list; 306 | (* string list indicates directories containing required units within that 307 | package *) 308 | } 309 | 310 | type libaries = { 311 | name : string; (* stdlib -- from stdlib.cma *) 312 | modules : string list; (* ["Stdlib"; "CamlinternalOO"; ... ] *) 313 | } 314 | 315 | type meta = { 316 | libraries : libraries list; 317 | deps : deps; 318 | blessed : bool; 319 | } 320 | ``` 321 | 322 | where `universe_id`, `package_name` and `package_version` correspond with the values in the path into which the `cm{t,ti,i}` files have been copied. The field 'blessed' is true if the package is the 'target' package and false otherwise. The `meta` type will be marshalled to an s-expression stored in the path 323 | 324 | ``` 325 | prep/universes////meta.sexp 326 | ``` 327 | 328 | 329 | 330 | 331 | ## Voodoo-assemble 332 | 333 | Input: Voodoo-prep's output 334 | Output: A directory tree ready to be consumed by odocmkgen (modifying the input tree) 335 | 336 | The output of voodoo-prep is a set of tarballs uploaded to an S3 bucket. Once these have all been created, they should be unpacked into a single tree containing one top-level directory: `prep`. 337 | 338 | This tool loads all of the metadata s-expressions created by `prep` to find a complete set of all universes/packages/versions that have been built. 339 | 340 | It then checks that for each package/version, we have exactly one 'blessed' universe. This step may need to add new ones - for example, for the `ocaml` package, for which we don't ever run voodoo-prep for explicitly. As a consequence, for each triple `(universe * package * version)` 341 | there will be exactly one that is 'blessed' and potentially many that are not. 342 | 343 | For each `(universe * package * version)` triple, we construct a directory tree and intermediate `mld` files. If the triple is 'blessed', we create the tree: 344 | 345 | ``` 346 | packages.mld 347 | packages/.mld 348 | packages//.mld 349 | packages///lib/ 350 | packages///doc/ 351 | ``` 352 | 353 | If the triple is not 'blessed', we construct the tree: 354 | 355 | ``` 356 | universes.mld 357 | universes/.mld 358 | universes//.mld 359 | universes///.mld 360 | universes////lib/ 361 | universes////doc/ 362 | ``` 363 | 364 | These `mld` files must contains `{!childpage}` references to every sub pages. The `.mld` file need more attention, see [Version.mld] below. 365 | 366 | ### Version.mld 367 | 368 | The contents of this file will be rendered when someone visits the URL `http://docs.ocaml.org/packages/$package/$version/` and is therefore the landing page for the package as a whole. As such it needs to contain all the important info needed. It should contain: 369 | 370 | - Name 371 | - One-line description from opam 372 | - Longer description from opam 373 | - Link to rendered README, CHANGELOG, LICENSE (maybe later) 374 | - Package Contents 375 | - Package Dependencies (references) 376 | 377 | The package may contain an `index.mld` file. It must be concatenated at the end of `version.mld` with its level-0 headings removed. 378 | 379 | The "Package Contents" layout is dependent upon the type of package. Examples follow: 380 | 381 | #### Multiple packages 382 | 383 | If there is more than one package, we should have sections for each sub-package, including an explicit section for the main package: 384 | 385 | ``` 386 | {2 Package: yaml} 387 | 388 | Top-level module: {!module-Yaml} 389 | 390 | {!modules: Yaml.Stream ...} 391 | 392 | {2 Sub-package: yaml.bindings} 393 | 394 | ... 395 | 396 | ``` 397 | 398 | ### Unwrapped libraries 399 | 400 | If the library is not wrapped, we just omit the link to the 'Top-level module': 401 | 402 | ``` 403 | {2 API} 404 | 405 | {!modules: Foo Bar Baz} 406 | ``` 407 | 408 | Note these depend upon https://github.com/ocaml/odoc/issues/297 being fixed, also https://github.com/ocaml/odoc/issues/478 409 | 410 | ## Odocmkgen 411 | 412 | It's also the "reference driver" for Odoc. For now, it's generic enough but we might choose to rename it voodoo- something if we need more specific features. 413 | 414 | Input: A directory tree in a specific format 415 | Output: A makefile describing the "compile" and "link" steps 416 | 417 | ### The directory tree format 418 | 419 | This tool won't try to understand universes and packages, the only API between `assemble` and `odocmkgen` is the way the directory tree. 420 | 421 | - Each intermediate directory is a "node" 422 | - Nodes can have a parent page, the "parent" of everything in that directory. Example: 423 | ``` 424 | root/ 425 | thing.mld 426 | thing/ 427 | a/ 428 | ... 429 | b.mld 430 | b/ 431 | ... 432 | ... 433 | ``` 434 | `thing.mld` is the parent page of the directory `thing`. 435 | `thing/b.mld` is the parent page of `thing/b`. 436 | - For nodes without parent, the grandparent is used. 437 | In the example above, `thing.mld` is also the parent page of `thing/a`. 438 | - Every `.mld`, `.cmti`, `.cmt`, `.cmi` are picked as compilation unit, other files are ignored 439 | The preference order is `.cmti`, `.cmt` and `.cmi`. 440 | There cannot be a name conflict between pages and modules because Odoc enforces a `page-` prefix. 441 | 442 | ### Dependencies 443 | 444 | Dependencies are queried with `odoc compile-deps` (they can also be specified, see `--dep` below). 445 | They are extended to entire node (eg. if `a/a.cmti` depends on `b/b.cmti` and `c/c.cmti`, the entire node `a` depends on the nodes `b` and `c`). Inside a node, exact dependencies are needed. 446 | The parent page is added to dependencies but not children. 447 | Direct dependencies are used when compiling but transitive dependencies are used for linking. 448 | Link-dependencies also include "--child" dependencies, recursively. 449 | 450 | It is possible to specify the dependencies of each files by passing the `--dep` option, for example to precompute them in a more efficient way. 451 | This option takes a file containing a list of paths separated by spaces and newlines. The first path of each line is the file is the target and the rest of the line is its dependencies. 452 | Every paths should be relative to the root path passed to `odocmkgen`. Missing targets are assumed to have no dependency, no attempt is made to compute missing dependencies. 453 | The "target" paths must be paths to files, the "dependencies" paths can either be files or directories (in which case, it is a dependency on everything directly in that directory). 454 | TODO: Use a better format to remove the implicit assumption about whitespaces, for example sexp. 455 | 456 | ### The generated Makefile 457 | 458 | Compile step: 459 | - Every nodes have a corresponding "compile-" PHONY rule that depends on units in the node. It is requested by link rules and the "compile" rule. 460 | Dependencies sometimes don't need to be more precise than entire nodes, this is useful to reduce drastically the size of the Makefile. 461 | - `odoc compile` is used to compile OCaml object files and mld pages into `.odoc` files. 462 | The corresponding parent page is specified by the `--parent` option and include paths by `-I`. 463 | Every dependencies are added to the include paths (`-I`) 464 | - When building a parent page, every children are listed using the `--child` option. 465 | 466 | Link step: 467 | - "compile-" rules are used to depend on compilation, link rules are independant. 468 | - `odoc link` is used to generate `.odocl` files. The search paths (`-I`) points to the parent, children and transitive dependencies. 469 | 470 | The default targets will run both the compile and link steps. Object files will be stored in `odoc` and `odocl` directories (relative to the Makefile location). 471 | 472 | It also have a "generate" subcommand working on a tree of `.odocl`that outputs a Makefile describing the rules to build the final HTML (also man, latex). 473 | 474 | ## Voodoo-link 475 | 476 | ## Further thoughts 477 | 478 | - Extra click in wrapped libraries 479 | Some libraries have one top-level module, which has the whole library as submodules. 480 | This module is generated by Dune and is often not very useful in the doc, it's an unordered list of modules. 481 | We could inline it into the package page and avoid an unecessary click. 482 | Some packages document this module carefully and it sometimes contains types and values (for example base). 483 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (with-stdout-to 3 | dune-project.1 4 | (run dune format-dune-file %{dep:dune-project}))) 5 | 6 | (rule 7 | (alias fmt) 8 | (action 9 | (diff dune-project dune-project.1))) 10 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | 3 | (name voodoo) 4 | 5 | (generate_opam_files true) 6 | 7 | (cram enable) 8 | 9 | (maintainers "Thibaut Mattio" "Sabine Schmaltz") 10 | 11 | (authors "Jon Ludlam" "Jules Aguillon" "Lucas Pluvinage") 12 | 13 | (license ISC) 14 | 15 | (source 16 | (github ocaml-doc/voodoo)) 17 | 18 | (package 19 | (name voodoo-lib) 20 | (synopsis "OCaml.org's package documentation generator (library)") 21 | (description 22 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-lib is the base library.") 23 | (depends 24 | (alcotest 25 | (and 26 | :with-test 27 | (>= 0.7.0))) 28 | bos 29 | astring 30 | fpath 31 | sexplib 32 | (yojson 33 | (>= 1.6.0)))) 34 | 35 | (package 36 | (name voodoo-prep) 37 | (synopsis "OCaml.org's package documentation generator (preparation step)") 38 | (description 39 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-prep runs the preparation step.") 40 | (depends 41 | cmdliner 42 | fpath 43 | bos 44 | (opam-format 45 | (>= 2.0.0)))) 46 | 47 | (package 48 | (name voodoo-do) 49 | (synopsis "OCaml.org's package documentation generator (compilation step)") 50 | (description 51 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-do runs the compilation step.") 52 | (depends 53 | voodoo-lib 54 | ; odoc.2.4.1 pinned by the pipeline 55 | (odoc 56 | (>= 2.4.1)) 57 | bos 58 | astring 59 | cmdliner 60 | (yojson 61 | (>= 1.6.0)))) 62 | 63 | (package 64 | (name voodoo-gen) 65 | (synopsis "OCaml.org's package documentation generator (generation step)") 66 | (description 67 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-gen generates the package documentation.") 68 | (depends 69 | (omd 70 | (= 2.0.0~alpha3)) 71 | voodoo-lib 72 | ; odoc.2.4.1 pinned by the pipeline 73 | (odoc 74 | (>= 2.4.1)) 75 | conf-pandoc 76 | astring 77 | cmdliner 78 | (yojson 79 | (>= 1.6.0)) 80 | bos 81 | sexplib 82 | fpath 83 | (conf-jq :with-test))) 84 | -------------------------------------------------------------------------------- /src/voodoo-do/do.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_lib 2 | module Result = Bos_setup.R 3 | open Result.Infix 4 | 5 | type ('a, 'e) result = ('a, 'e) Rresult.result = Ok of 'a | Error of 'e 6 | 7 | module InputSelect = struct 8 | let order path = 9 | let ext = Fpath.get_ext path in 10 | match ext with ".cmti" -> 0 | ".cmt" -> 1 | ".cmi" -> 2 | _ -> 3 11 | 12 | (* Given a list of Sourceinfo.t values, we need to find the 'best' 13 | file for each, and return an Sourceinfo_index.t of these *) 14 | let select sis = 15 | let h = Hashtbl.create (List.length sis) in 16 | List.iter 17 | (fun (si : Sourceinfo.t) -> 18 | let cur = try Hashtbl.find h si.digest with _ -> [] in 19 | Hashtbl.replace h si.digest (si :: cur)) 20 | sis; 21 | let result = 22 | Hashtbl.fold 23 | (fun _k v acc -> 24 | let best = 25 | List.sort 26 | (fun v1 v2 -> compare (order v1.Sourceinfo.path) (order v2.path)) 27 | v 28 | |> List.hd 29 | in 30 | best :: acc) 31 | h [] 32 | in 33 | Sourceinfo_index.of_source_infos result 34 | end 35 | 36 | module IncludePaths = struct 37 | let get : Sourceinfo_index.t -> Sourceinfo.t -> Fpath.Set.t = 38 | fun index si -> 39 | let s = Mld.compile_dir si.parent in 40 | let set = Fpath.Set.of_list [ s ] in 41 | List.fold_left 42 | (fun paths dep -> 43 | match Sourceinfo_index.find_opt dep.Odoc.c_digest index with 44 | | Some si -> Fpath.Set.add Sourceinfo.(compile_dir si) paths 45 | | None -> ( 46 | match Sourceinfo_index.find_extern_opt dep.Odoc.c_digest index with 47 | | Some p -> Fpath.Set.add p paths 48 | | None -> 49 | Format.eprintf "Missing dependency: %s %s\n%!" dep.c_unit_name 50 | dep.c_digest; 51 | paths)) 52 | set si.deps 53 | 54 | let link : Sourceinfo_index.t -> Fpath.Set.t = 55 | fun index -> 56 | let dirs = 57 | Sourceinfo_index.M.fold 58 | (fun _ v acc -> Fpath.Set.add (Sourceinfo.compile_dir v) acc) 59 | index.intern Fpath.Set.empty 60 | in 61 | Sourceinfo_index.M.fold 62 | (fun _ v acc -> Fpath.Set.add v acc) 63 | index.extern dirs 64 | end 65 | 66 | let get_source_info parent path = 67 | match Fpath.segs path with 68 | | "prep" :: "universes" :: id :: pkg_name :: version :: _ -> ( 69 | match Odoc.compile_deps path with 70 | | Some (name, digest, deps) -> 71 | [ 72 | Sourceinfo. 73 | { 74 | package = { universe = id; name = pkg_name; version }; 75 | path; 76 | name; 77 | digest; 78 | deps; 79 | parent; 80 | }; 81 | ] 82 | | None -> []) 83 | | _ -> [] 84 | 85 | let package_info_of_fpath p = 86 | match Fpath.segs p with 87 | | "prep" :: "universes" :: id :: pkg_name :: pkg_version :: _ -> 88 | (id, pkg_name, pkg_version) 89 | | _ -> 90 | Format.eprintf "%s\n%!" (Fpath.to_string p); 91 | failwith "Bad path" 92 | 93 | let find_universe_and_version pkg_name = 94 | Bos.OS.Dir.contents Fpath.(Paths.prep / "universes") >>= fun universes -> 95 | let universe = 96 | match 97 | Compat.List.find_opt 98 | (fun u -> 99 | match Bos.OS.Dir.exists Fpath.(u / pkg_name) with 100 | | Ok b -> b 101 | | Error _ -> false) 102 | universes 103 | with 104 | | Some u -> Ok u 105 | | None -> Error (`Msg (Format.sprintf "Failed to find package %s" pkg_name)) 106 | in 107 | universe >>= fun u -> 108 | Bos.OS.Dir.contents ~rel:true Fpath.(u / pkg_name) >>= fun version -> 109 | match (Fpath.segs u, version) with 110 | | _ :: _ :: u :: _, [ version ] -> Ok (u, Fpath.to_string version) 111 | | _ -> Error (`Msg (Format.sprintf "Failed to find package %s" pkg_name)) 112 | 113 | let run pkg_name ~blessed ~failed = 114 | let is_interesting p = 115 | List.mem (Fpath.get_ext p) [ ".cmti"; ".cmt"; ".cmi" ] 116 | in 117 | (* Remove old pages *) 118 | let () = 119 | Bos.OS.File.delete Fpath.(Paths.compile / "page-packages.odoc") 120 | |> Result.get_ok 121 | in 122 | let () = 123 | Bos.OS.File.delete Fpath.(Paths.compile / "page-universes.odoc") 124 | |> Result.get_ok 125 | in 126 | 127 | let universe, version = 128 | match find_universe_and_version pkg_name with 129 | | Ok x -> x 130 | | Error (`Msg e) -> 131 | Format.eprintf "%s\n%!" e; 132 | exit 1 133 | in 134 | 135 | let right_package p = 136 | let _, n, _ = package_info_of_fpath p in 137 | n = pkg_name 138 | in 139 | let prep = 140 | Bos.OS.Dir.fold_contents ~dotfiles:true 141 | (fun p acc -> 142 | if is_interesting p && right_package p then p :: acc else acc) 143 | [] Paths.prep 144 | |> Result.get_ok 145 | in 146 | let modules = 147 | List.fold_left 148 | (fun acc f -> 149 | let _, name = Fpath.split_base f in 150 | let name = Fpath.rem_ext name |> Fpath.to_string in 151 | if List.mem name acc then acc else name :: acc) 152 | [] prep 153 | in 154 | let package = { Package.universe; name = pkg_name; version } in 155 | let output_path = 156 | if blessed then Fpath.(Paths.link / "p" / pkg_name / version) 157 | else Fpath.(Paths.link / "u" / universe / pkg_name / version) 158 | in 159 | Util.mkdir_p output_path; 160 | 161 | let index_res = 162 | Bos.OS.Dir.fold_contents ~dotfiles:true 163 | (fun p acc -> 164 | let _, name = Fpath.split_base p in 165 | if name = Fpath.v "index.m" then Sourceinfo_index.(combine (read p) acc) 166 | else acc) 167 | Sourceinfo_index.empty Paths.compile 168 | in 169 | let index = 170 | match index_res with Ok index -> index | Error _ -> Sourceinfo_index.empty 171 | in 172 | 173 | let opam_file = match Opam.find package with Ok f -> Some f | _ -> None in 174 | 175 | let libraries = Library_names.get_libraries package in 176 | 177 | let package_mlds, otherdocs = Package_mlds.find package in 178 | 179 | let error_log = Error_log.find package in 180 | 181 | let auto_generated_index_mld = 182 | Index_mld_page.gen package ~blessed ~modules ~libraries ~package_mlds 183 | ~error_log ~failed 184 | in 185 | 186 | let () = 187 | Package_info.gen ~output:output_path ~libraries:libraries.libraries 188 | in 189 | 190 | let sis = 191 | Compat.List.concat_map (get_source_info auto_generated_index_mld) prep 192 | in 193 | let this_index = InputSelect.select sis in 194 | Sourceinfo_index.write this_index auto_generated_index_mld; 195 | let index = Sourceinfo_index.combine this_index index in 196 | let rec compile h si compiled = 197 | if List.mem si.Sourceinfo.path compiled then compiled 198 | else 199 | let compiled = 200 | List.fold_left 201 | (fun (compiled : Fpath.t list) dep -> 202 | match Sourceinfo_index.find_opt dep.Odoc.c_digest this_index with 203 | | Some si -> compile h si compiled 204 | | None -> compiled) 205 | compiled si.deps 206 | in 207 | let includes = IncludePaths.get index si in 208 | let output = Sourceinfo.output_file si in 209 | Odoc.compile ~parent:auto_generated_index_mld.Mld.name ~output si.path 210 | ~includes ~children:[]; 211 | si.path :: compiled 212 | in 213 | let _ = ignore (Sourceinfo_index.M.fold compile this_index.intern []) in 214 | let mldvs = 215 | Package_mlds.compile ~parent:auto_generated_index_mld package_mlds 216 | in 217 | let unit_includes = IncludePaths.link index in 218 | let docs_includes = Package_mlds.include_paths mldvs in 219 | let all_includes = Fpath.Set.union unit_includes docs_includes in 220 | let all_includes = 221 | Fpath.Set.add (Mld.compile_dir auto_generated_index_mld) all_includes 222 | in 223 | let output = Fpath.(v "html") in 224 | Util.mkdir_p output; 225 | Sourceinfo_index.M.iter 226 | (fun _ si -> 227 | if Sourceinfo.is_hidden si then () 228 | else 229 | Odoc.link 230 | (Sourceinfo.output_file si) 231 | ~includes:all_includes 232 | ~output:(Sourceinfo.output_odocl si)) 233 | this_index.intern; 234 | let odocls = 235 | Sourceinfo_index.M.fold 236 | (fun _ si acc -> 237 | if Sourceinfo.is_hidden si then acc 238 | else Sourceinfo.output_odocl si :: acc) 239 | this_index.intern [] 240 | in 241 | Odoc.link 242 | (Mld.output_file auto_generated_index_mld) 243 | ~includes:all_includes 244 | ~output:(Mld.output_odocl auto_generated_index_mld); 245 | List.iter 246 | (fun mldv -> 247 | Odoc.link (Mld.output_file mldv) ~includes:all_includes 248 | ~output:(Mld.output_odocl mldv)) 249 | mldvs; 250 | let odocls = 251 | odocls @ List.map Mld.output_odocl (auto_generated_index_mld :: mldvs) 252 | in 253 | Format.eprintf "%d other files to copy\n%!" (List.length otherdocs); 254 | let otherdocs, _opam_file = 255 | Otherdocs.copy auto_generated_index_mld otherdocs opam_file 256 | in 257 | List.iter (fun p -> Format.eprintf "dest: %a\n%!" Fpath.pp p) otherdocs; 258 | List.iter (Odoc.html ~output) odocls; 259 | let () = 260 | Bos.OS.File.delete (Fpath.v "compile/page-p.odoc") |> Result.get_ok 261 | in 262 | let () = 263 | Bos.OS.File.delete (Fpath.v "compile/page-u.odoc") |> Result.get_ok 264 | in 265 | let () = 266 | Bos.OS.File.delete (Fpath.v ("compile/p/page-" ^ pkg_name ^ ".odoc")) 267 | |> Result.get_ok 268 | in 269 | if failed then 270 | Bos.OS.File.write Fpath.(output_path / "failed") "failed" |> Result.get_ok; 271 | () 272 | -------------------------------------------------------------------------------- /src/voodoo-do/do.mli: -------------------------------------------------------------------------------- 1 | val run : string -> blessed:bool -> failed:bool -> unit 2 | (** [run pkg ~blessed ~failed] runs [odoc compile] and [odoc link] on package 3 | [pkg]. If [failed] is set, a file named [failed] containing "failed" is also 4 | generated. *) 5 | -------------------------------------------------------------------------------- /src/voodoo-do/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (public_name voodoo-do) 4 | (package voodoo-do) 5 | (libraries bos.setup voodoo-lib cmdliner)) 6 | -------------------------------------------------------------------------------- /src/voodoo-do/main.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_lib 2 | 3 | [@@@ocaml.warning "-3"] 4 | 5 | open Cmdliner 6 | 7 | let run package blessed switch failed = 8 | Opam.switch := switch; 9 | Do.run package ~blessed ~failed 10 | 11 | let package = 12 | let doc = "Select the package to process" in 13 | Arg.( 14 | required & opt (some string) None & info [ "p"; "package" ] ~docv:"PKG" ~doc) 15 | 16 | let blessed = 17 | let doc = "Mark the package as blessed" in 18 | Arg.(value & flag & info [ "b"; "blessed" ] ~doc) 19 | 20 | let switch = 21 | let doc = "Opam switch to use. If not set, defaults to the current switch" in 22 | Arg.( 23 | value & opt (some string) None & info [ "s"; "switch" ] ~doc ~docv:"SWITCH") 24 | 25 | let failed = 26 | let doc = "Indicate that the build failed" in 27 | Arg.(value & flag & info [ "failed" ] ~doc) 28 | 29 | let cmd = 30 | let doc = "Process a prepped package" in 31 | ( Term.(const run $ package $ blessed $ switch $ failed), 32 | Term.info "voodoo-do" ~doc ~exits:Term.default_exits ) 33 | 34 | let () = Term.(exit @@ eval cmd) 35 | -------------------------------------------------------------------------------- /src/voodoo-do/main.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-doc/voodoo/dc54397f66abf95c964ea4de0f3a0ff2aec56efe/src/voodoo-do/main.mli -------------------------------------------------------------------------------- /src/voodoo-gen/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (public_name voodoo-gen) 4 | (package voodoo-gen) 5 | (libraries odoc.odoc omd bos bos.setup yojson cmdliner voodoo_lib)) 6 | -------------------------------------------------------------------------------- /src/voodoo-gen/generate_html_docs.ml: -------------------------------------------------------------------------------- 1 | open Odoc_odoc 2 | module Result = Bos_setup.R 3 | open Result.Infix 4 | 5 | let document_of_odocl ~syntax input = 6 | let open Odoc_document in 7 | Odoc_file.load input >>= fun unit -> 8 | match unit.content with 9 | | Odoc_file.Page_content odoctree -> 10 | Ok (Renderer.document_of_page ~syntax odoctree) 11 | | Unit_content odoctree -> 12 | Ok (Renderer.document_of_compilation_unit ~syntax odoctree) 13 | | Source_tree_content _ -> 14 | Error (`Msg "document_of_odocl: Source_tree_content unexpected") 15 | 16 | let render_document ~output odoctree = 17 | let aux pages = 18 | Odoc_document.Renderer.traverse pages ~f:(fun file_path content -> 19 | let output_path = output file_path in 20 | let directory = Fs.File.dirname output_path in 21 | Fs.Directory.mkdir_p directory; 22 | let oc = open_out (Fs.File.to_string output_path) in 23 | let fmt = Format.formatter_of_out_channel oc in 24 | Format.fprintf fmt "%t@?" content; 25 | close_out oc) 26 | in 27 | aux 28 | @@ Odoc_html.Generator.render 29 | ~config: 30 | (Odoc_html.Config.v ~semantic_uris:false ~indent:false ~flat:false 31 | ~open_details:true ~as_json:true ()) 32 | odoctree; 33 | Ok () 34 | 35 | let docs_ids parent docs = 36 | Odoc_file.load parent >>= fun root -> 37 | match root.content with 38 | | Page_content odoctree -> ( 39 | match odoctree.Odoc_model.Lang.Page.name with 40 | | { iv = `LeafPage _; _ } -> Error (`Msg "Parent is a leaf!") 41 | | { iv = `Page (maybe_container_page, _); _ } as parent_id -> 42 | let result = 43 | List.map 44 | (fun doc -> 45 | let id = 46 | let basename = Fpath.basename doc in 47 | { 48 | parent_id with 49 | iv = 50 | `LeafPage 51 | ( maybe_container_page, 52 | Odoc_model.Names.PageName.make_std basename ); 53 | } 54 | in 55 | (id, doc)) 56 | docs 57 | in 58 | Ok result) 59 | | _ -> Error (`Msg "Parent is not a page!") 60 | 61 | let render ~output file = 62 | let open Odoc_document in 63 | let f = Fs.File.of_string (Fpath.to_string file) in 64 | document_of_odocl ~syntax:Renderer.OCaml f >>= fun document -> 65 | render_document ~output document >>= fun () -> 66 | let urls = 67 | let rec get_subpages document = 68 | document 69 | :: (Doctree.Subpages.compute document 70 | |> List.map (fun (subpage : Types.Subpage.t) -> 71 | get_subpages subpage.content) 72 | |> List.flatten) 73 | in 74 | match document with 75 | | Odoc_document.Types.Document.Page p -> get_subpages p 76 | | _ -> [] 77 | in 78 | Ok urls 79 | 80 | let render_text ~id ~output doc = 81 | let url = Odoc_document.Url.Path.from_identifier id in 82 | Markdown.read_plain doc url >>= fun p -> render_document ~output (Page p) 83 | 84 | let render_markdown ~id ~output doc = 85 | let url = Odoc_document.Url.Path.from_identifier id in 86 | match Markdown.read_md doc url with 87 | | Ok page -> render_document ~output (Page page) 88 | | Error _ -> render_text ~id ~output doc 89 | 90 | let render_org ~id ~output doc = 91 | let url = Odoc_document.Url.Path.from_identifier id in 92 | match Markdown.read_org doc url with 93 | | Ok page -> render_document ~output (Page page) 94 | | Error _ -> render_text ~id ~output doc 95 | 96 | let render_other ~output ~parent ~otherdocs = 97 | docs_ids parent otherdocs >>= fun docs -> 98 | let errors = 99 | List.fold_left 100 | (fun acc (id, doc) -> 101 | let result = 102 | match Fpath.get_ext doc with 103 | | ".md" -> render_markdown ~output ~id doc 104 | | ".org" -> render_org ~output ~id doc 105 | | _ -> render_text ~output ~id doc 106 | in 107 | match result with Ok _ -> acc | Error (`Msg m) -> (doc, m) :: acc) 108 | [] docs 109 | in 110 | match errors with 111 | | [] -> Ok () 112 | | _ -> 113 | Error 114 | (`Msg 115 | (String.concat "\n" 116 | (List.map 117 | (fun (doc, m) -> Format.asprintf "%a: %s" Fpath.pp doc m) 118 | errors))) 119 | -------------------------------------------------------------------------------- /src/voodoo-gen/generate_html_docs.mli: -------------------------------------------------------------------------------- 1 | val render : 2 | output:(Fpath.t -> Odoc_odoc.Fs.File.t) -> 3 | Fpath.t -> 4 | (Odoc_document.Types.Page.t list, [ `Msg of string ]) result 5 | (** [render ~output f] renders the [.odocl] file [f] as html by running 6 | [odoc html-generate]. [output] determines the output path from the input 7 | path. *) 8 | 9 | val render_other : 10 | output:(Fpath.t -> Odoc_odoc.Fs.File.t) -> 11 | parent:Odoc_odoc.Fs.File.t -> 12 | otherdocs:Fpath.t list -> 13 | (unit, [ `Msg of string ]) result 14 | (** [render_other ~output ~parent ~otherdocs] renders the documents [otherdocs] 15 | as html. [parent] is used to get the path to the document. [output] 16 | determines the output path from the input path. *) 17 | -------------------------------------------------------------------------------- /src/voodoo-gen/main.ml: -------------------------------------------------------------------------------- 1 | open Cmdliner 2 | module Result = Bos_setup.R 3 | 4 | [@@@ocaml.warning "-3"] 5 | 6 | let docs = "ARGUMENTS" 7 | 8 | let convert_directory ?(create = false) () : 9 | Odoc_odoc.Fs.Directory.t Arg.converter = 10 | let dir_parser, dir_printer = Arg.string in 11 | let odoc_dir_parser str = 12 | let () = if create then Odoc_odoc.Fs.Directory.(mkdir_p (of_string str)) in 13 | match dir_parser str with 14 | | `Ok res -> `Ok (Odoc_odoc.Fs.Directory.of_string res) 15 | | `Error e -> `Error e 16 | in 17 | let odoc_dir_printer fmt dir = 18 | dir_printer fmt (Odoc_odoc.Fs.Directory.to_string dir) 19 | in 20 | (odoc_dir_parser, odoc_dir_printer) 21 | 22 | let output = 23 | let doc = "Output directory where the HTML tree is expected to be saved." in 24 | Arg.( 25 | required 26 | & opt (some (convert_directory ~create:true ())) None 27 | & info ~docs ~docv:"DIR" ~doc [ "o"; "output-dir" ]) 28 | 29 | type files = { otherdocs : Fpath.t list; odocls : Fpath.t list } 30 | 31 | let empty = { otherdocs = []; odocls = [] } 32 | 33 | let generate_pkgver output_dir name_filter version_filter = 34 | let linkedpath = Fpath.(v "linked") in 35 | match 36 | Bos.OS.Dir.fold_contents ~elements:`Dirs 37 | (fun p (pkgs, othervers) -> 38 | let optmatch opt v = match opt with Some x -> x = v | None -> true in 39 | match Fpath.segs p with 40 | | [ "linked"; "p"; pkg_name; pkg_version ] 41 | when optmatch name_filter pkg_name 42 | && optmatch version_filter pkg_version -> 43 | ((p, None, pkg_name, pkg_version) :: pkgs, othervers) 44 | | [ "linked"; "p"; pkg_name; pkg_version ] 45 | when optmatch name_filter pkg_name -> 46 | (pkgs, pkg_version :: othervers) 47 | | [ "linked"; "u"; universe; pkg_name; pkg_version ] 48 | when optmatch name_filter pkg_name 49 | && optmatch version_filter pkg_version -> 50 | ((p, Some universe, pkg_name, pkg_version) :: pkgs, othervers) 51 | | _ -> (pkgs, othervers)) 52 | ([], []) linkedpath 53 | with 54 | | Error (`Msg m) -> 55 | Format.eprintf "Failed to find any packages: %s\n%!" m; 56 | exit 1 57 | | Ok (pkgs, vs) -> 58 | Format.eprintf "%d other versions, %d packages\n%!" (List.length vs) 59 | (List.length pkgs); 60 | let handle_package (pkg_path, universe, pkg_name, ver) = 61 | let failed = 62 | Bos.OS.File.exists Fpath.(pkg_path / "failed") |> function 63 | | Ok x -> x 64 | | _ -> false 65 | in 66 | match 67 | Bos.OS.Dir.fold_contents ~elements:`Files ~dotfiles:false 68 | (fun p files -> 69 | match Fpath.get_ext p with 70 | | ".odocl" -> { files with odocls = p :: files.odocls } 71 | | _ -> ( 72 | match Fpath.basename p with 73 | | "opam" -> files 74 | | "content.tar" -> files 75 | | _ -> { files with otherdocs = p :: files.otherdocs })) 76 | empty pkg_path 77 | with 78 | | Error (`Msg m) -> 79 | Format.eprintf "Failed to handle package %s.%s: %s\n%!" pkg_name ver 80 | m; 81 | exit 1 82 | | Ok files -> ( 83 | let parent = 84 | List.find 85 | (fun p -> 86 | let _, f = Fpath.split_base p in 87 | f = Fpath.v "page-doc.odocl") 88 | files.odocls 89 | in 90 | let otherdocs = List.sort Fpath.compare files.otherdocs in 91 | let files = files.odocls in 92 | Format.eprintf "Found %d files\n%!" (List.length files); 93 | let output file_path = 94 | let p, ext = Fpath.split_ext ~multi:true file_path in 95 | let extensions = String.split_on_char '.' ext |> List.rev in 96 | let filename = Fpath.filename p |> String.uppercase_ascii in 97 | let output_path = 98 | match (filename, extensions) with 99 | | "README", "html" :: _ -> Fpath.set_ext "html" p ~multi:true 100 | | _ -> file_path 101 | in 102 | Fpath.normalize @@ Odoc_odoc.Fs.File.append output_dir output_path 103 | in 104 | let paths = 105 | List.rev_map (Generate_html_docs.render ~output) files 106 | |> List.rev_map Result.get_ok |> List.flatten 107 | in 108 | let foutput = 109 | Fpath.v (Odoc_odoc.Fs.Directory.to_string output_dir) 110 | in 111 | let output_prefix = 112 | match universe with 113 | | None -> Fpath.(foutput / "p" / pkg_name / ver) 114 | | Some universe -> 115 | Fpath.(foutput / "u" / universe / pkg_name / ver) 116 | in 117 | 118 | Package_info.gen ~input:parent ~output:output_prefix paths; 119 | Generate_html_docs.render_other ~parent ~otherdocs ~output 120 | |> Result.get_ok; 121 | 122 | let otherdocs = 123 | let init = Voodoo_serialize.Status.Otherdocs.empty in 124 | List.fold_left 125 | (fun (acc : Voodoo_serialize.Status.Otherdocs.t) path -> 126 | let _, file = Fpath.split_base path in 127 | let file = Fpath.rem_ext file |> Fpath.to_string in 128 | match file with 129 | | "README" -> { acc with readme = path :: acc.readme } 130 | | "LICENSE" -> { acc with license = path :: acc.license } 131 | | "CHANGES" -> { acc with changes = path :: acc.changes } 132 | | _ -> { acc with others = path :: acc.others }) 133 | init otherdocs 134 | in 135 | let status = { Voodoo_serialize.Status.failed; otherdocs } in 136 | if Option.is_none universe then 137 | Yojson.Safe.to_file 138 | Fpath.(output_prefix / "status.json" |> to_string) 139 | (Voodoo_serialize.Status.to_yojson status); 140 | 141 | match 142 | Search_index.generate_index 143 | [ 144 | pkg_path |> Fpath.to_string 145 | |> Odoc_odoc.Fs.Directory.of_string; 146 | ] 147 | Fpath.(output_prefix / "index.js") 148 | with 149 | | Ok () -> () 150 | | Error (`Msg m) -> 151 | Format.eprintf "Error generating index for fuse: %s\n%!" m) 152 | in 153 | 154 | List.iter handle_package pkgs 155 | 156 | module SMap = Map.Make (String) 157 | 158 | let version = "v0.0.1" 159 | 160 | let package_name_opt = 161 | let doc = 162 | "Package name (e.g. voodoo) - will only handle the named package if set" 163 | in 164 | Arg.( 165 | value 166 | & opt (some string) None 167 | & info ~docs ~docv:"NAME" ~doc [ "n"; "name" ]) 168 | 169 | let package_version_opt = 170 | let doc = 171 | "Package version (e.g. 0.0.1) - will only handle the specified version \ 172 | package if set" 173 | in 174 | Arg.( 175 | value 176 | & opt (some string) None 177 | & info ~docs ~docv:"VERSION" ~doc [ "pkg-version" ]) 178 | 179 | let default_cmd = 180 | let doc = "Documentation generator" in 181 | ( Term.( 182 | const generate_pkgver $ output $ package_name_opt $ package_version_opt), 183 | Term.info "voodoo-gen" ~version ~doc ~exits:Term.default_exits ) 184 | 185 | let () = Term.(exit @@ eval default_cmd) 186 | -------------------------------------------------------------------------------- /src/voodoo-gen/main.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-doc/voodoo/dc54397f66abf95c964ea4de0f3a0ff2aec56efe/src/voodoo-gen/main.mli -------------------------------------------------------------------------------- /src/voodoo-gen/markdown.ml: -------------------------------------------------------------------------------- 1 | (* Markdown renderer *) 2 | open Omd 3 | module Result = Bos_setup.R 4 | open Result.Infix 5 | 6 | type intermediate = 7 | | Bl of Odoc_document.Types.Block.t 8 | | It of Odoc_document.Types.Item.t 9 | 10 | let rec inline : 'attr inline -> Odoc_document.Types.Inline.t = function 11 | | Concat (_, is) -> inlines is 12 | | Text (_, s) -> [ { desc = Text s; attr = [] } ] 13 | | Emph (_, s) -> [ { desc = Styled (`Emphasis, inline s); attr = [] } ] 14 | | Strong (_, s) -> [ { desc = Styled (`Bold, inline s); attr = [] } ] 15 | | Code (_, c) -> 16 | [ { desc = Source [ Elt [ { desc = Text c; attr = [] } ] ]; attr = [] } ] 17 | | Hard_break _ -> [ { desc = Linebreak; attr = [] } ] 18 | | Soft_break _ -> [ { desc = Text " "; attr = [] } ] 19 | | Link (_, l) -> 20 | [ { desc = Link (l.destination, inline l.label); attr = [] } ] 21 | | Image _ -> [] 22 | | Html (_, h) -> [ { desc = Raw_markup ("html", h); attr = [] } ] 23 | 24 | and inlines xs = List.concat (List.map inline xs) 25 | 26 | let rec block : 'attr block -> intermediate = function 27 | | Paragraph (_, p) -> Bl [ { desc = Paragraph (inline p); attr = [] } ] 28 | | List (_, Bullet _, _sp, items) -> 29 | let i = 30 | List.map 31 | (fun items -> match blocks items with [ Bl x ] -> x | _ -> []) 32 | items 33 | in 34 | Bl [ { desc = List (Unordered, i); attr = [] } ] 35 | | List (_, Ordered _, _sp, items) -> 36 | let i = 37 | List.map 38 | (fun items -> match blocks items with [ Bl x ] -> x | _ -> []) 39 | items 40 | in 41 | Bl [ { desc = List (Ordered, i); attr = [] } ] 42 | | Blockquote (_, _bs) -> Bl [] 43 | | Thematic_break _ -> Bl [] 44 | | Heading (_, n, i) -> 45 | It 46 | (Heading 47 | { label = None; level = n; title = inline i; source_anchor = None }) 48 | | Code_block (_, _a, b) -> 49 | Bl 50 | [ 51 | { 52 | desc = Source ("markdown", [ Elt [ { desc = Text b; attr = [] } ] ]); 53 | attr = []; 54 | }; 55 | ] 56 | | (Html_block _ | Definition_list _ | Table (_, _, _)) as elt -> 57 | let html = Omd.to_html [ elt ] in 58 | Bl [ { desc = Raw_markup ("html", html); attr = [] } ] 59 | 60 | and merge xs = 61 | List.fold_right 62 | (fun x (cur, acc) -> 63 | match x with Bl a -> (a @ cur, acc) | It _ -> ([], x :: Bl cur :: acc)) 64 | xs ([], []) 65 | |> (fun (x, y) -> Bl x :: y) 66 | |> List.filter (function Bl [] -> false | _ -> true) 67 | 68 | and blocks xs = List.map block xs |> merge 69 | 70 | let of_content content ~name ~url = 71 | let md = Omd.of_string content in 72 | let intermediate = blocks md in 73 | let items = List.map (function It x -> x | Bl x -> Text x) intermediate in 74 | let open Odoc_document.Types.Page in 75 | Ok 76 | (match items with 77 | | [] -> { preamble = []; items = []; url; source_anchor = None } 78 | | (Heading _ as x) :: rest -> 79 | { preamble = [ x ]; items = rest; url; source_anchor = None } 80 | | _ -> 81 | { 82 | preamble = 83 | [ 84 | Heading 85 | { 86 | label = None; 87 | level = 1; 88 | title = [ { desc = Text name; attr = [] } ]; 89 | source_anchor = None; 90 | }; 91 | ]; 92 | items; 93 | url; 94 | source_anchor = None; 95 | }) 96 | 97 | let read_org f url = 98 | let name = Fpath.basename f in 99 | let fname = Fpath.to_string f in 100 | let cmd = 101 | Bos.Cmd.( 102 | v "pandoc" % "--wrap" % "none" % "--from" % "org" % "--to" % "markdown" 103 | % fname) 104 | in 105 | Bos.OS.Cmd.(run_out cmd |> to_string) >>= fun content -> 106 | of_content content ~name ~url 107 | 108 | let read_md f url = 109 | let name = Fpath.basename f in 110 | Bos.OS.File.read f >>= fun content -> of_content content ~name ~url 111 | 112 | let read_plain f url = 113 | let name = Fpath.basename f in 114 | Bos.OS.File.read f >>= fun content -> 115 | let open Odoc_document.Types.Page in 116 | Ok 117 | { 118 | url; 119 | items = [ Text [ { desc = Verbatim content; attr = [] } ] ]; 120 | preamble = 121 | [ 122 | Heading 123 | { 124 | label = None; 125 | level = 1; 126 | title = [ { desc = Text name; attr = [] } ]; 127 | source_anchor = None; 128 | }; 129 | ]; 130 | source_anchor = None; 131 | } 132 | -------------------------------------------------------------------------------- /src/voodoo-gen/markdown.mli: -------------------------------------------------------------------------------- 1 | val read_org : 2 | Fpath.t -> 3 | Odoc_document.Url.Path.t -> 4 | (Odoc_document.Types.Page.t, [ `Msg of string ]) result 5 | (** [read_org f url] returns the odoc page generated from the org file [f] 6 | having the url [url]. *) 7 | 8 | val read_md : 9 | Fpath.t -> 10 | Odoc_document.Url.Path.t -> 11 | (Odoc_document.Types.Page.t, [ `Msg of string ]) result 12 | (** [read_md f url] returns the odoc page generated from the markdown file [f] 13 | having the url [url]. *) 14 | 15 | val read_plain : 16 | Fpath.t -> 17 | Odoc_document.Url.Path.t -> 18 | (Odoc_document.Types.Page.t, [ `Msg of string ]) result 19 | (** [read_plain f url] returns the odoc page generated from the plain file [f] 20 | having the url [url]. *) 21 | -------------------------------------------------------------------------------- /src/voodoo-gen/package_info.ml: -------------------------------------------------------------------------------- 1 | module Result = Bos_setup.R 2 | open Result.Infix 3 | module StringMap = Map.Make (String) 4 | 5 | let info_of_paths ~(info : string Voodoo_serialize.Package_info.t) paths = 6 | let children = ref StringMap.empty in 7 | let kind = ref StringMap.empty in 8 | let path_to_string v = 9 | let remove_prefix = function 10 | | "p" :: _p :: _v :: "doc" :: v -> v 11 | | "u" :: _u :: _p :: _v :: "doc" :: v -> v 12 | | v -> v 13 | in 14 | v |> Odoc_document.Url.Path.to_list |> List.map snd |> remove_prefix 15 | |> String.concat "." 16 | in 17 | List.iter 18 | (fun (page : Odoc_document.Types.Page.t) -> 19 | let path = page.url in 20 | kind := StringMap.add (path_to_string path) path.kind !kind; 21 | Option.iter 22 | (fun (parent : Odoc_document.Url.Path.t) -> 23 | children := 24 | StringMap.update (path_to_string parent) 25 | (function 26 | | None -> Some [ path.name ] | Some v -> Some (path.name :: v)) 27 | !children) 28 | path.parent) 29 | paths; 30 | let rec get_tree root = 31 | let children = 32 | StringMap.find_opt root !children |> Option.value ~default:[] 33 | in 34 | let kind = StringMap.find root !kind in 35 | let submodules = List.map (fun c -> get_tree (root ^ "." ^ c)) children in 36 | let name = 37 | List.fold_left (fun _ -> Fun.id) root (String.split_on_char '.' root) 38 | in 39 | { Voodoo_serialize.Package_info.Module.name; kind; submodules } 40 | in 41 | List.map 42 | (fun { Voodoo_serialize.Package_info.Library.name; modules; dependencies } -> 43 | let modules = 44 | List.filter_map 45 | (fun t -> try Some (get_tree t) with Not_found -> None) 46 | modules 47 | in 48 | { Voodoo_serialize.Package_info.Library.name; modules; dependencies }) 49 | info.libraries 50 | 51 | let gen ~input ~output paths = 52 | Result.ignore_error ~use:ignore 53 | @@ 54 | let input = Fpath.(parent input / "package.json" |> to_string) in 55 | let info = 56 | Voodoo_serialize.Package_info.of_yojson Voodoo_serialize.String_.of_yojson 57 | (Yojson.Safe.from_file input) 58 | in 59 | let libraries = info_of_paths ~info paths in 60 | Bos.OS.Dir.create output >>= fun (_ : bool) -> 61 | let output = Fpath.(to_string (output / "package.json")) in 62 | Yojson.Safe.to_file output 63 | (Voodoo_serialize.Package_info.to_yojson 64 | Voodoo_serialize.Package_info.Module.to_yojson { libraries }); 65 | Ok () 66 | -------------------------------------------------------------------------------- /src/voodoo-gen/package_info.mli: -------------------------------------------------------------------------------- 1 | val gen : 2 | input:Fpath.t -> output:Fpath.t -> Odoc_document.Types.Page.t list -> unit 3 | (** [gen ~input ~output paths] reads a [packags.json] located at [input] and 4 | generates a new [package.json] located at [output] describing the same 5 | package and using [paths] to add children information. *) 6 | -------------------------------------------------------------------------------- /src/voodoo-gen/search_index.ml: -------------------------------------------------------------------------------- 1 | module Result = Bos_setup.R 2 | open Result.Infix 3 | 4 | type entry = { 5 | id : Odoc_model.Paths.Identifier.Any.t; 6 | doc : Odoc_model.Comment.docs option; 7 | } 8 | 9 | module Generate = struct 10 | (** Get plain text doc-comment from a doc comment *) 11 | 12 | module C = Odoc_model.Comment 13 | 14 | let get_value x = x.Odoc_model.Location_.value 15 | 16 | let rec string_of_doc (doc : C.docs) = 17 | doc |> List.map get_value 18 | |> List.map s_of_block_element 19 | |> String.concat " " 20 | 21 | and s_of_block_element (be : C.block_element) = 22 | match be with 23 | | `Paragraph is -> inlines is 24 | | `Tag _ -> "" 25 | | `List (_, ls) -> 26 | List.map (fun x -> x |> List.map get_value |> List.map nestable) ls 27 | |> List.concat |> String.concat " " 28 | | `Heading (_, _, h) -> inlines h 29 | | `Modules _ -> "" 30 | | `Code_block (_, s, _) -> s |> get_value 31 | | `Verbatim v -> v 32 | | `Math_block m -> m 33 | | `Table { data; _ } -> grid data 34 | 35 | and cell (c : _ C.cell) = 36 | c |> fst |> List.map (fun x -> get_value x |> nestable) |> String.concat " " 37 | 38 | and row (r : _ C.row) = r |> List.map cell |> String.concat " " 39 | and grid (g : _ C.grid) = g |> List.map row |> String.concat " " 40 | 41 | and nestable (n : C.nestable_block_element) = 42 | s_of_block_element (n :> C.block_element) 43 | 44 | and inlines (is : C.inline_element C.with_location list) = 45 | is |> List.map (fun x -> get_value x |> inline) |> String.concat "" 46 | 47 | and leaf_inline (i : C.leaf_inline_element) = 48 | match i with 49 | | `Space -> " " 50 | | `Word w -> w 51 | | `Code_span s -> s 52 | | `Math_span m -> m 53 | | `Raw_markup (_, _) -> "" 54 | 55 | and inline (i : C.inline_element) = 56 | match i with 57 | | #C.leaf_inline_element as i -> leaf_inline (i :> C.leaf_inline_element) 58 | | `Styled (_, b) -> inlines b 59 | | `Reference (_, c) -> link_content c 60 | | `Link (_, c) -> link_content c 61 | 62 | and link_content (l : C.link_content) = non_link_inlines l 63 | 64 | and non_link_inline (x : C.non_link_inline_element) = 65 | match x with 66 | | #C.leaf_inline_element as x -> leaf_inline (x :> C.leaf_inline_element) 67 | | `Styled (_, b) -> non_link_inlines b 68 | 69 | and non_link_inlines (is : C.non_link_inline_element C.with_location list) = 70 | is |> List.map (fun x -> get_value x |> non_link_inline) |> String.concat "" 71 | 72 | let rec full_name_aux : Odoc_model.Paths.Identifier.t -> string list = 73 | let open Odoc_model.Names in 74 | let open Odoc_model.Paths in 75 | fun x -> 76 | match x.iv with 77 | | `Root (_, name) -> [ ModuleName.to_string name ] 78 | | `Page (_, name) -> [ PageName.to_string name ] 79 | | `LeafPage (_, name) -> [ PageName.to_string name ] 80 | | `Module (parent, name) -> 81 | ModuleName.to_string name :: full_name_aux (parent :> Identifier.t) 82 | | `Parameter (parent, name) -> 83 | ModuleName.to_string name :: full_name_aux (parent :> Identifier.t) 84 | | `Result x -> full_name_aux (x :> Identifier.t) 85 | | `ModuleType (parent, name) -> 86 | ModuleTypeName.to_string name 87 | :: full_name_aux (parent :> Identifier.t) 88 | | `Type (parent, name) -> 89 | TypeName.to_string name :: full_name_aux (parent :> Identifier.t) 90 | | `CoreType name -> [ TypeName.to_string name ] 91 | | `Constructor (parent, name) -> 92 | ConstructorName.to_string name 93 | :: full_name_aux (parent :> Identifier.t) 94 | | `Field (parent, name) -> 95 | FieldName.to_string name :: full_name_aux (parent :> Identifier.t) 96 | | `Extension (parent, name) -> 97 | ExtensionName.to_string name :: full_name_aux (parent :> Identifier.t) 98 | | `ExtensionDecl (parent, _, name) -> 99 | ExtensionName.to_string name :: full_name_aux (parent :> Identifier.t) 100 | | `Exception (parent, name) -> 101 | ExceptionName.to_string name :: full_name_aux (parent :> Identifier.t) 102 | | `CoreException name -> [ ExceptionName.to_string name ] 103 | | `Value (parent, name) -> 104 | ValueName.to_string name :: full_name_aux (parent :> Identifier.t) 105 | | `Class (parent, name) -> 106 | ClassName.to_string name :: full_name_aux (parent :> Identifier.t) 107 | | `ClassType (parent, name) -> 108 | ClassTypeName.to_string name :: full_name_aux (parent :> Identifier.t) 109 | | `Method (parent, name) -> 110 | MethodName.to_string name :: full_name_aux (parent :> Identifier.t) 111 | | `InstanceVariable (parent, name) -> 112 | InstanceVariableName.to_string name 113 | :: full_name_aux (parent :> Identifier.t) 114 | | `Label (parent, name) -> 115 | LabelName.to_string name :: full_name_aux (parent :> Identifier.t) 116 | | `SourceDir (parent, name) -> 117 | name :: full_name_aux (parent :> Identifier.t) 118 | | `AssetFile (parent, name) -> 119 | name :: full_name_aux (parent :> Identifier.t) 120 | | `SourceLocationMod parent -> full_name_aux (parent :> Identifier.t) 121 | | `SourceLocation (parent, name) -> 122 | DefName.to_string name :: full_name_aux (parent :> Identifier.t) 123 | | `SourceLocationInternal (parent, name) -> 124 | LocalName.to_string name :: full_name_aux (parent :> Identifier.t) 125 | | `SourcePage (parent, name) -> 126 | name :: full_name_aux (parent :> Identifier.t) 127 | 128 | let prefixname : 129 | [< Odoc_model.Paths.Identifier.t_pv ] Odoc_model.Paths.Identifier.id -> 130 | string = 131 | fun n -> 132 | match full_name_aux (n :> Odoc_model.Paths.Identifier.t) with 133 | | [] -> "" 134 | | _ :: q -> String.concat "." (List.rev q) 135 | 136 | let string_of_entry { id; doc } = 137 | Odoc_document.Url.from_identifier ~stop_before:false id >>= fun url -> 138 | let config = 139 | Odoc_html.Config.v ~semantic_uris:true ~indent:false ~flat:false 140 | ~open_details:false ~as_json:false () 141 | in 142 | let name = Odoc_model.Paths.Identifier.name id in 143 | let prefixname = prefixname id in 144 | let kind = 145 | match id.iv with 146 | | `InstanceVariable _ -> "instance variable" 147 | | `Parameter _ -> "parameter" 148 | | `Module _ -> "module" 149 | | `ModuleType _ -> "module type" 150 | | `Method _ -> "method" 151 | | `Field _ -> "field" 152 | | `Result _ -> "result" 153 | | `Label _ -> "label" 154 | | `Type _ -> "type" 155 | | `Exception _ -> "exception" 156 | | `Class _ -> "class" 157 | | `Page _ -> "page" 158 | | `LeafPage _ -> "leaf page" 159 | | `CoreType _ -> "core type" 160 | | `ClassType _ -> "class type" 161 | | `Value _ -> "val" 162 | | `CoreException _ -> "core exception" 163 | | `Constructor _ -> "constructor" 164 | | `Extension _ -> "extension" 165 | | `ExtensionDecl _ -> "extension-decl" 166 | | `Root _ -> "root" 167 | | `SourceDir _ -> "source dir" 168 | | `AssetFile _ -> "asset file" 169 | | `SourceLocationMod _ -> "source location mod" 170 | | `SourceLocation _ -> "source location" 171 | | `SourceLocationInternal _ -> "source location internal" 172 | | `SourcePage _ -> "source page" 173 | in 174 | let url = Odoc_html.Link.href ~config ~resolve:(Base "") url in 175 | let json = 176 | `Assoc 177 | [ 178 | ("name", `String name); 179 | ("prefixname", `String prefixname); 180 | ("kind", `String kind); 181 | ("url", `String url); 182 | ( "comment", 183 | match doc with None -> `Null | Some c -> `String (string_of_doc c) 184 | ); 185 | ] 186 | in 187 | Ok (Yojson.to_string json) 188 | end 189 | 190 | module Load_doc = struct 191 | open Odoc_model.Paths 192 | open Odoc_model.Lang 193 | open Odoc_model.Names 194 | 195 | let rec is_internal : Identifier.t -> bool = 196 | fun x -> 197 | match x.iv with 198 | | `Root (_, name) -> ModuleName.is_internal name 199 | | `Page (_, _) -> false 200 | | `LeafPage (_, _) -> false 201 | | `Module (_, name) -> ModuleName.is_internal name 202 | | `Parameter (_, name) -> ModuleName.is_internal name 203 | | `Result x -> is_internal (x :> Identifier.t) 204 | | `ModuleType (_, name) -> ModuleTypeName.is_internal name 205 | | `Type (_, name) -> TypeName.is_internal name 206 | | `CoreType name -> TypeName.is_internal name 207 | | `Constructor (parent, _) -> is_internal (parent :> Identifier.t) 208 | | `Field (parent, _) -> is_internal (parent :> Identifier.t) 209 | | `Extension (parent, _) -> is_internal (parent :> Identifier.t) 210 | | `ExtensionDecl (parent, _, _) -> is_internal (parent :> Identifier.t) 211 | | `Exception (parent, _) -> is_internal (parent :> Identifier.t) 212 | | `CoreException _ -> false 213 | | `Value (_, name) -> ValueName.is_internal name 214 | | `Class (_, name) -> ClassName.is_internal name 215 | | `ClassType (_, name) -> ClassTypeName.is_internal name 216 | | `Method (parent, _) -> is_internal (parent :> Identifier.t) 217 | | `InstanceVariable (parent, _) -> is_internal (parent :> Identifier.t) 218 | | `Label (parent, _) -> is_internal (parent :> Identifier.t) 219 | | `SourceDir (parent, _) -> is_internal (parent :> Identifier.t) 220 | | `AssetFile (parent, _) -> is_internal (parent :> Identifier.t) 221 | | `SourceLocationMod parent -> is_internal (parent :> Identifier.t) 222 | | `SourceLocation (parent, _) -> is_internal (parent :> Identifier.t) 223 | | `SourceLocationInternal (parent, _) -> 224 | is_internal (parent :> Identifier.t) 225 | | `SourcePage (parent, _) -> is_internal (parent :> Identifier.t) 226 | 227 | let add t ppf = 228 | if is_internal t.id then () 229 | else 230 | match Generate.string_of_entry t with 231 | | Ok entry -> Format.fprintf ppf "%s,\n" entry 232 | | Error _ -> () 233 | 234 | let rec unit ppf t = 235 | let open Compilation_unit in 236 | let () = content ppf t.content in 237 | add { id = (t.id :> Identifier.Any.t); doc = None } ppf 238 | 239 | and content ppf = 240 | let open Compilation_unit in 241 | function 242 | | Module m -> 243 | let () = signature ppf m in 244 | () 245 | | Pack _ -> () 246 | 247 | and signature ppf (s : Signature.t) = List.iter (signature_item ppf) s.items 248 | 249 | and signature_item ppf s_item = 250 | match s_item with 251 | | Signature.Module (_, m) -> module_ ppf m 252 | | ModuleType mt -> module_type ppf mt 253 | | ModuleSubstitution mod_subst -> module_subst ppf mod_subst 254 | | ModuleTypeSubstitution mt_subst -> module_type_subst ppf mt_subst 255 | | Open _ -> () 256 | | Type (_, t_decl) -> type_decl ppf t_decl 257 | | TypeSubstitution t_decl -> type_decl ppf t_decl 258 | | TypExt te -> type_extension ppf te 259 | | Exception exc -> exception_ ppf exc 260 | | Value v -> value ppf v 261 | | Class (_, cl) -> class_ ppf cl 262 | | ClassType (_, clt) -> class_type ppf clt 263 | | Include i -> include_ ppf i 264 | | Comment _ -> () 265 | 266 | and include_ ppf inc = 267 | let () = include_decl ppf inc.decl in 268 | include_expansion ppf inc.expansion 269 | 270 | and include_decl _ppf _decl = () 271 | and include_expansion ppf expansion = signature ppf expansion.content 272 | 273 | and class_type ppf ct = 274 | let () = add { id = (ct.id :> Identifier.Any.t); doc = Some ct.doc } ppf in 275 | let () = class_type_expr ppf ct.expr in 276 | match ct.expansion with None -> () | Some cs -> class_signature ppf cs 277 | 278 | and class_type_expr ppf ct_expr = 279 | match ct_expr with 280 | | ClassType.Constr (_, _) -> () 281 | | ClassType.Signature cs -> class_signature ppf cs 282 | 283 | and class_signature ppf ct_expr = 284 | List.iter (class_signature_item ppf) ct_expr.items 285 | 286 | and class_signature_item ppf item = 287 | match item with 288 | | ClassSignature.Method m -> 289 | add { id = (m.id :> Identifier.Any.t); doc = Some m.doc } ppf 290 | | ClassSignature.InstanceVariable _ -> () 291 | | ClassSignature.Constraint _ -> () 292 | | ClassSignature.Inherit _ -> () 293 | | ClassSignature.Comment _ -> () 294 | 295 | and class_ ppf cl = 296 | let () = add { id = (cl.id :> Identifier.Any.t); doc = Some cl.doc } ppf in 297 | let () = class_decl ppf cl.type_ in 298 | match cl.expansion with 299 | | None -> () 300 | | Some cl_signature -> class_signature ppf cl_signature 301 | 302 | and class_decl ppf cl_decl = 303 | match cl_decl with 304 | | Class.ClassType expr -> class_type_expr ppf expr 305 | | Class.Arrow (_, _, decl) -> class_decl ppf decl 306 | 307 | and exception_ ppf exc = 308 | add { id = (exc.id :> Identifier.Any.t); doc = Some exc.doc } ppf 309 | 310 | and type_extension ppf te = 311 | match te.constructors with 312 | | [] -> () 313 | | c :: _ -> 314 | let () = 315 | add { id = (c.id :> Identifier.Any.t); doc = Some te.doc } ppf 316 | in 317 | List.iter (extension_constructor ppf) te.constructors 318 | 319 | and extension_constructor ppf ext_constr = 320 | add 321 | { id = (ext_constr.id :> Identifier.Any.t); doc = Some ext_constr.doc } 322 | ppf 323 | 324 | and module_subst _ppf _mod_subst = () 325 | and module_type_subst _ppf _mod_subst = () 326 | 327 | and value ppf v = 328 | add { id = (v.id :> Identifier.Any.t); doc = Some v.doc } ppf 329 | 330 | and module_ ppf m = 331 | let () = add { id = (m.id :> Identifier.Any.t); doc = Some m.doc } ppf in 332 | let () = 333 | match m.type_ with 334 | | Module.Alias (_, None) -> () 335 | | Module.Alias (_, Some s_e) -> simple_expansion ppf s_e 336 | | Module.ModuleType mte -> module_type_expr ppf mte 337 | in 338 | () 339 | 340 | and type_decl ppf td = 341 | add { id = (td.id :> Identifier.Any.t); doc = Some td.doc } ppf 342 | 343 | and module_type ppf mt = 344 | let () = add { id = (mt.id :> Identifier.Any.t); doc = Some mt.doc } ppf in 345 | match mt.expr with 346 | | None -> () 347 | | Some mt_expr -> module_type_expr ppf mt_expr 348 | 349 | and simple_expansion ppf s_e = 350 | match s_e with 351 | | ModuleType.Signature sg -> signature ppf sg 352 | | Functor (param, s_e) -> 353 | let () = functor_parameter ppf param in 354 | simple_expansion ppf s_e 355 | 356 | and module_type_expr ppf mte = 357 | match mte with 358 | | ModuleType.Path _ -> () 359 | | ModuleType.Signature s -> signature ppf s 360 | | ModuleType.Functor (fp, mt_expr) -> 361 | let () = functor_parameter ppf fp in 362 | let () = module_type_expr ppf mt_expr in 363 | () 364 | | ModuleType.With { w_expansion = None; _ } -> () 365 | | ModuleType.With { w_expansion = Some se; _ } -> simple_expansion ppf se 366 | | ModuleType.TypeOf { t_expansion = None; _ } -> () 367 | | ModuleType.TypeOf { t_expansion = Some se; _ } -> simple_expansion ppf se 368 | 369 | and functor_parameter ppf fp = 370 | match fp with 371 | | FunctorParameter.Unit -> () 372 | | FunctorParameter.Named n -> module_type_expr ppf n.expr 373 | end 374 | 375 | let load_dir path = 376 | Odoc_odoc.Fs.Directory.fold_files_rec_result ~ext:"odocl" 377 | (fun acc file -> 378 | Odoc_odoc.Odoc_file.load file >>= fun unit -> Ok (unit :: acc)) 379 | [] path 380 | 381 | let generate_index dirs output = 382 | dirs 383 | |> List.fold_left 384 | (fun acc dir -> 385 | acc >>= fun acc -> 386 | load_dir dir >>= fun units -> Ok (units @ acc)) 387 | (Ok []) 388 | >>= fun units -> 389 | let units = 390 | List.filter_map 391 | (function 392 | | { Odoc_odoc.Odoc_file.content = Unit_content unit; _ } 393 | when not unit.hidden -> 394 | Some unit 395 | | _ -> None) 396 | units 397 | in 398 | let ppf = 399 | Odoc_odoc.Fs.Directory.mkdir_p (Odoc_odoc.Fs.File.dirname output); 400 | let oc = open_out_bin (Odoc_odoc.Fs.File.to_string output) in 401 | Format.formatter_of_out_channel oc 402 | in 403 | Format.fprintf ppf "let documents = ["; 404 | let () = List.iter (Load_doc.unit ppf) units in 405 | let () = 406 | Format.fprintf ppf 407 | {|]; 408 | const options = { keys: ['name', 'comment'] }; 409 | var idx_fuse = new Fuse(documents, options);|} 410 | in 411 | Ok () 412 | -------------------------------------------------------------------------------- /src/voodoo-gen/search_index.mli: -------------------------------------------------------------------------------- 1 | val generate_index : 2 | Odoc_odoc.Fs.directory list -> Fpath.t -> (unit, [ `Msg of string ]) result 3 | (** [generate_index dirs output] reads the [*.odocl] files located in [dirs] and 4 | generates a JavaScript file [output] describing the contents of the 5 | [*.odocl] files. *) 6 | -------------------------------------------------------------------------------- /src/voodoo-prep/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (public_name voodoo-prep) 4 | (package voodoo-prep) 5 | (libraries cmdliner fpath bos opam-format)) 6 | -------------------------------------------------------------------------------- /src/voodoo-prep/main.ml: -------------------------------------------------------------------------------- 1 | open Cmdliner 2 | 3 | [@@@ocaml.warning "-3"] 4 | 5 | module Prep = struct 6 | let switch = 7 | let doc = 8 | "Opam switch to use. If not set, defaults to the current switch" 9 | in 10 | Arg.( 11 | value 12 | & opt (some string) None 13 | & info [ "s"; "switch" ] ~doc ~docv:"SWITCH") 14 | 15 | let prep switch universes = 16 | Opam.switch := switch; 17 | Prep.run universes 18 | 19 | let universes = 20 | let doc = "Provide universe spec as 'package:universe_id' couples" in 21 | Arg.( 22 | value 23 | & opt (list (pair ~sep:':' string string)) [] 24 | & info [ "u"; "universes" ] ~doc) 25 | 26 | let cmd = Term.(const prep $ switch $ universes) 27 | let info = Term.info "prep" ~doc:"Prep a directory tree for compiling" 28 | end 29 | 30 | let _ = 31 | match Term.eval_choice ~err:Format.err_formatter Prep.(cmd, info) [] with 32 | | `Error _ -> 33 | Format.pp_print_flush Format.err_formatter (); 34 | exit 2 35 | | _ -> () 36 | -------------------------------------------------------------------------------- /src/voodoo-prep/main.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-doc/voodoo/dc54397f66abf95c964ea4de0f3a0ff2aec56efe/src/voodoo-prep/main.mli -------------------------------------------------------------------------------- /src/voodoo-prep/opam.ml: -------------------------------------------------------------------------------- 1 | open Bos 2 | 3 | let opam = Cmd.v "opam" 4 | let switch = ref None 5 | 6 | type package = { name : string; version : string } 7 | 8 | let rec get_switch () = 9 | match !switch with 10 | | None -> 11 | let cur_switch = 12 | Util.lines_of_process Cmd.(opam % "switch" % "show") |> List.hd 13 | in 14 | switch := Some cur_switch; 15 | get_switch () 16 | | Some s -> s 17 | 18 | let prefix () = 19 | Util.lines_of_process 20 | Cmd.(opam % "var" % "--switch" % get_switch () % "prefix") 21 | |> List.hd 22 | 23 | let deps_of_opam_result line = 24 | match Astring.String.fields ~empty:false line with 25 | | [ name; version ] -> [ { name; version } ] 26 | | _ -> [] 27 | 28 | let all_opam_packages () = 29 | Util.lines_of_process 30 | Cmd.( 31 | opam % "list" % "--switch" % get_switch () % "--columns=name,version" 32 | % "--color=never" % "--short") 33 | |> List.map deps_of_opam_result 34 | |> List.flatten 35 | 36 | let pkg_contents { Package.name; _ } = 37 | let prefix = Fpath.v (prefix ()) in 38 | let changes_file = 39 | Format.asprintf "%a/.opam-switch/install/%s.changes" Fpath.pp prefix name 40 | in 41 | let file = OpamFilename.raw changes_file in 42 | let filename = 43 | OpamFile.make @@ OpamFilename.raw @@ Filename.basename changes_file 44 | in 45 | let changed = 46 | OpamFilename.with_contents 47 | (fun str -> 48 | OpamFile.Changes.read_from_string ~filename 49 | @@ 50 | (* Field [opam-version] is invalid in [*.changes] files, displaying a warning. *) 51 | if OpamStd.String.starts_with ~prefix:"opam-version" str then 52 | match OpamStd.String.cut_at str '\n' with 53 | | Some (_, str) -> str 54 | | None -> assert false 55 | else str) 56 | file 57 | in 58 | let added = 59 | OpamStd.String.Map.fold 60 | (fun file x acc -> 61 | match x with 62 | | OpamDirTrack.Added _ -> ( 63 | try 64 | if not @@ Sys.is_directory Fpath.(to_string (prefix // v file)) 65 | then file :: acc 66 | else acc 67 | with _ -> 68 | acc 69 | (* dose (and maybe others) sometimes creates a symlink to something that doesn't exist *) 70 | ) 71 | | _ -> acc) 72 | changed [] 73 | in 74 | List.map Fpath.v added 75 | 76 | let opam_file { Package.name; version; _ } = 77 | let prefix = Fpath.v (prefix ()) in 78 | let opam_file = 79 | Format.asprintf "%a/.opam-switch/packages/%s.%s/opam" Fpath.pp prefix name 80 | version 81 | in 82 | try 83 | let ic = open_in opam_file in 84 | let lines = Util.lines_of_channel ic in 85 | close_in ic; 86 | Some lines 87 | with _ -> None 88 | -------------------------------------------------------------------------------- /src/voodoo-prep/opam.mli: -------------------------------------------------------------------------------- 1 | type package = { name : string; version : string } 2 | (** Equivalent of type [Package.t] when the universe is not yet known. *) 3 | 4 | val switch : string option ref 5 | (** [switch] returns the local opam switch name. *) 6 | 7 | val prefix : unit -> string 8 | (** [prefix ()] returns the root directory of the local opam switch. *) 9 | 10 | val all_opam_packages : unit -> package list 11 | (** [all_opam_packages ()] returns the list of installed packages. *) 12 | 13 | val pkg_contents : Package.t -> Fpath.t list 14 | (** [pkg_contents p] returns the list of files installed by package [p]. *) 15 | 16 | val opam_file : Package.t -> string list option 17 | (** [opam_file p] returns the contents of the opam file of package [p]. *) 18 | -------------------------------------------------------------------------------- /src/voodoo-prep/package.ml: -------------------------------------------------------------------------------- 1 | type t = { universe_id : string; name : string; version : string } 2 | 3 | let prep_path p = 4 | Fpath.(Paths.prep / "universes" / p.universe_id / p.name / p.version) 5 | -------------------------------------------------------------------------------- /src/voodoo-prep/package.mli: -------------------------------------------------------------------------------- 1 | type t = { universe_id : string; name : string; version : string } 2 | 3 | val prep_path : t -> Fpath.t 4 | (** [prep_path p] is the directory where the prepped package [p] is stored. 5 | 6 | Warning: it needs to stay in sync with [src/voodoo/package.ml]*) 7 | -------------------------------------------------------------------------------- /src/voodoo-prep/paths.ml: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | let prep = Fpath.v "prep" 4 | -------------------------------------------------------------------------------- /src/voodoo-prep/paths.mli: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | val prep : t 4 | (** [prep] is the root directory where the prepped packages are stored. 5 | 6 | Warning: it needs to stay in sync with [src/voodoo/paths.ml] *) 7 | -------------------------------------------------------------------------------- /src/voodoo-prep/prep.ml: -------------------------------------------------------------------------------- 1 | type actions = { copy : (Fpath.t * Fpath.t) list; objinfo : Fpath.t list } 2 | 3 | (** [process_package root p files] copies some files among [files] to the 4 | [Package.prep_path p]. Store the [ocamlobjinfo] of the [.cma] files. *) 5 | let process_package : Fpath.t -> Package.t -> Fpath.t list -> unit = 6 | fun root package files -> 7 | let dest = Package.prep_path package in 8 | 9 | (* Some packages produce ocaml artefacts that can't be processed with the switch's 10 | ocaml compiler - most notably the secondary compiler! This switch is intended to 11 | be used to ignore those files *) 12 | let process_ocaml_artefacts = 13 | let package_blacklist = [ "ocaml-secondary-compiler" ] in 14 | not (List.mem package.name package_blacklist) 15 | in 16 | 17 | let foldfn fpath acc = 18 | let is_in_doc_dir = 19 | match Fpath.segs fpath with "doc" :: _ -> true | _ -> false 20 | in 21 | 22 | (* Menhir puts a dune build dir into docs for some reason *) 23 | let in_build_dir = List.exists (fun x -> x = "_build") (Fpath.segs fpath) in 24 | 25 | let _, filename = Fpath.split_base fpath in 26 | let ext = Fpath.get_ext filename in 27 | let no_ext = Fpath.rem_ext filename in 28 | let has_hyphen = String.contains (Fpath.to_string filename) '-' in 29 | let is_module = 30 | process_ocaml_artefacts 31 | && List.mem ext [ ".cmt"; ".cmti"; ".cmi" ] 32 | && not has_hyphen 33 | in 34 | let do_copy = 35 | (not in_build_dir) 36 | && (is_in_doc_dir || is_module 37 | || List.mem no_ext (List.map Fpath.v [ "META"; "dune-package" ])) 38 | in 39 | let is_cma = process_ocaml_artefacts && List.mem ext [ ".cma"; ".cmxa" ] in 40 | let copy = 41 | if do_copy then Fpath.(root // fpath, dest // fpath) :: acc.copy 42 | else acc.copy 43 | in 44 | let objinfo = if is_cma then fpath :: acc.objinfo else acc.objinfo in 45 | { copy; objinfo } 46 | in 47 | let actions = List.fold_right foldfn files { copy = []; objinfo = [] } in 48 | List.iter 49 | (fun (src, dst) -> 50 | let dir, _ = Fpath.split_base dst in 51 | Util.mkdir_p dir; 52 | Util.cp (Fpath.to_string src) (Fpath.to_string dst)) 53 | actions.copy; 54 | List.iter 55 | (fun fpath -> 56 | let lines = 57 | Util.lines_of_process 58 | Bos.Cmd.(v "ocamlobjinfo" % Fpath.(to_string (root // fpath))) 59 | in 60 | Util.write_file Fpath.(dest // set_ext "ocamlobjinfo" fpath) lines) 61 | actions.objinfo 62 | 63 | let run (universes : (string * string) list) = 64 | let get_universe = 65 | match universes with 66 | | [] -> 67 | let id = ref 0 in 68 | Printf.eprintf 69 | "Warning: No universes have been specified: will generate dummy \ 70 | universes\n\ 71 | %!"; 72 | fun pkg -> 73 | let universe_id = string_of_int !id in 74 | let name = pkg.Opam.name in 75 | let version = pkg.version in 76 | incr id; 77 | Some { Package.universe_id; name; version } 78 | | _ -> ( 79 | fun pkg -> 80 | try 81 | let universe_id = List.assoc pkg.Opam.name universes in 82 | let name = pkg.name in 83 | let version = pkg.version in 84 | Some { universe_id; name; version } 85 | with _ -> None) 86 | in 87 | 88 | let packages = 89 | Opam.all_opam_packages () 90 | |> List.fold_left 91 | (fun acc pkg -> 92 | match get_universe pkg with Some pkg -> pkg :: acc | None -> acc) 93 | [] 94 | in 95 | let root = Opam.prefix () |> Fpath.v in 96 | let pkg_contents = 97 | List.map (fun package -> (package, Opam.pkg_contents package)) packages 98 | in 99 | List.iter 100 | (fun (package, files) -> process_package root package files) 101 | pkg_contents; 102 | List.iter 103 | (fun package -> 104 | match Opam.opam_file package with 105 | | Some lines -> 106 | let dest = Package.prep_path package in 107 | Util.write_file Fpath.(dest / "opam") lines 108 | | None -> ()) 109 | packages 110 | -------------------------------------------------------------------------------- /src/voodoo-prep/prep.mli: -------------------------------------------------------------------------------- 1 | val run : (string * string) list -> unit 2 | (** [run universes] prepares all packages installed in the current switch. 3 | 4 | For each package [p]: 5 | 6 | - copy some of the files installed by [p] to the [prep/] directory. 7 | - store the [ocamlobjinfo] of the [.cma] files in the same directory. 8 | - copy the [opam] file. *) 9 | -------------------------------------------------------------------------------- /src/voodoo-prep/util.ml: -------------------------------------------------------------------------------- 1 | open Bos 2 | 3 | let lines_of_channel ic = 4 | let rec inner acc = 5 | try 6 | let l = input_line ic in 7 | inner (l :: acc) 8 | with End_of_file -> List.rev acc 9 | in 10 | inner [] 11 | 12 | let lines_of_process cmd = 13 | match OS.Cmd.(run_out ~err:err_null cmd |> to_lines) with 14 | | Ok x -> x 15 | | Error (`Msg e) -> failwith ("Error: " ^ e) 16 | 17 | let mkdir_p d = 18 | let segs = 19 | Fpath.segs (Fpath.normalize d) |> List.filter (fun s -> String.length s > 0) 20 | in 21 | let _ = 22 | List.fold_left 23 | (fun path seg -> 24 | let d = Fpath.(path // v seg) in 25 | try 26 | Unix.mkdir (Fpath.to_string d) 0o755; 27 | d 28 | with 29 | | Unix.Unix_error (Unix.EEXIST, _, _) -> d 30 | | exn -> raise exn) 31 | (Fpath.v ".") segs 32 | in 33 | () 34 | 35 | let write_file filename lines = 36 | let dir = fst (Fpath.split_base filename) in 37 | mkdir_p dir; 38 | let oc = open_out (Fpath.to_string filename) in 39 | List.iter (fun line -> Printf.fprintf oc "%s\n" line) lines; 40 | close_out oc 41 | 42 | let cp src dst = assert (lines_of_process Cmd.(v "cp" % src % dst) = []) 43 | -------------------------------------------------------------------------------- /src/voodoo-prep/util.mli: -------------------------------------------------------------------------------- 1 | val lines_of_channel : in_channel -> string list 2 | (** [lines_of_channel c] returns lines read on channel [c]. *) 3 | 4 | val lines_of_process : Bos.Cmd.t -> string list 5 | (** [lines_of_process p] returns lines read from the output of process [p]. *) 6 | 7 | val mkdir_p : Fpath.t -> unit 8 | (** [mkdir_p x] recursively creates directory [x] and its parents. *) 9 | 10 | val write_file : Fpath.t -> string list -> unit 11 | (** [write_file f lines] writes [lines] into file [f]. *) 12 | 13 | val cp : string -> string -> unit 14 | (** [cp src dst] copies [src] to [dst]. *) 15 | -------------------------------------------------------------------------------- /src/voodoo/compat.ml: -------------------------------------------------------------------------------- 1 | module List = struct 2 | let concat_map f l = List.flatten (List.map f l) 3 | 4 | let rec find_opt p = function 5 | | [] -> None 6 | | x :: l -> if p x then Some x else find_opt p l 7 | end 8 | -------------------------------------------------------------------------------- /src/voodoo/compat.mli: -------------------------------------------------------------------------------- 1 | module List : sig 2 | val concat_map : ('a -> 'b list) -> 'a list -> 'b list 3 | (** [concat_map f l] gives the same result as [List.concat (List.map f l)]. *) 4 | 5 | val find_opt : ('a -> bool) -> 'a list -> 'a option 6 | (** [find_opt f l] returns the first element of the list [l] that satisfies 7 | the predicate [f]. Returns [None] if there is no value that satisfies [f] 8 | in the list [l]. *) 9 | end 10 | -------------------------------------------------------------------------------- /src/voodoo/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name voodoo_lib) 3 | (public_name voodoo-lib) 4 | (libraries 5 | findlib 6 | astring 7 | fpath 8 | bos 9 | bos.setup 10 | sexplib 11 | yojson 12 | voodoo-lib.serialize)) 13 | -------------------------------------------------------------------------------- /src/voodoo/error_log.ml: -------------------------------------------------------------------------------- 1 | type t = string list option 2 | 3 | let find package = 4 | let path = Fpath.(Package.prep_path package / "opam.err.log") in 5 | try 6 | let ic = open_in (Fpath.to_string path) in 7 | let result = Util.lines_of_channel ic in 8 | close_in ic; 9 | Format.printf "Found error log (%d bytes)\n%!" 10 | (List.fold_left (fun sum l -> sum + String.length l + 1) 0 result); 11 | Some result 12 | with _ -> None 13 | -------------------------------------------------------------------------------- /src/voodoo/error_log.mli: -------------------------------------------------------------------------------- 1 | type t = string list option 2 | 3 | val find : Package.t -> t 4 | (** [find p] returns the contents of the [opam.err.log] file, if it exists, 5 | located in the prepped directory of package [p]. *) 6 | -------------------------------------------------------------------------------- /src/voodoo/index_mld_page.ml: -------------------------------------------------------------------------------- 1 | let gen_with_libraries (libraries : Library_names.library list) = 2 | let libraries = 3 | if List.length libraries = 0 then [] 4 | else 5 | let x = 6 | List.map 7 | (fun { Library_names.name; modules; _ } -> 8 | let non_hidden = 9 | List.filter (fun x -> not (Util.is_hidden x)) modules 10 | in 11 | let a = 12 | [ 13 | Printf.sprintf "Documentation: {!modules:%s}" 14 | (String.concat " " non_hidden); 15 | ] 16 | in 17 | [ "{2 " ^ name ^ "}" ] @ a @ [ "" ]) 18 | libraries 19 | |> List.flatten 20 | in 21 | [ 22 | "{1 Libraries}"; 23 | "This package provides the following libraries (via ocamlobjinfo):"; 24 | ] 25 | @ x 26 | in 27 | libraries 28 | 29 | let gen_with_error l = 30 | let escape line = 31 | let ls = Astring.String.cuts ~sep:"v}" line in 32 | String.concat "v }" ls 33 | in 34 | match l with 35 | | Some lines -> 36 | [ 37 | "{1 Error log}"; 38 | "The package failed to build. The error log from opam follows."; 39 | "{v"; 40 | ] 41 | @ List.map escape lines @ [ "v}" ] 42 | | None -> 43 | [ 44 | "{1 Failure}"; 45 | "The package failed to build. There are no error logs to display"; 46 | ] 47 | 48 | let gen : 49 | Package.t -> 50 | libraries:Library_names.t -> 51 | error_log:Error_log.t -> 52 | failed:bool -> 53 | string = 54 | fun package ~libraries ~error_log ~failed -> 55 | Format.eprintf "libraries: [%s]\n%!" 56 | (String.concat "," 57 | (List.map (fun x -> x.Library_names.name) libraries.libraries)); 58 | let result = 59 | if failed then gen_with_error error_log 60 | else gen_with_libraries libraries.libraries 61 | in 62 | Format.sprintf "{0 %s %s}\n %s" package.name package.version 63 | (String.concat "\n" result) 64 | 65 | let gen : 66 | Package.t -> 67 | blessed:bool -> 68 | modules:string list -> 69 | libraries:Library_names.t -> 70 | package_mlds:Fpath.t list -> 71 | error_log:Error_log.t -> 72 | failed:bool -> 73 | Mld.t = 74 | fun package ~blessed ~modules ~libraries ~package_mlds ~error_log ~failed -> 75 | let cwd = Fpath.v "." in 76 | let mld_index, mld_children = 77 | List.partition (fun mld -> Fpath.basename mld = "index.mld") package_mlds 78 | in 79 | let m_children = List.map (fun m -> Odoc.CModule m) modules in 80 | let p_children = 81 | List.map 82 | (fun p -> 83 | Format.eprintf "page child: %a\n%!" Fpath.pp p; 84 | Odoc.CPage Fpath.(rem_ext p |> basename)) 85 | mld_children 86 | in 87 | let children = m_children @ p_children in 88 | let children = 89 | match children with [] -> [ Odoc.CPage "dummy" ] | _ -> children 90 | in 91 | let top_parents = 92 | if blessed then 93 | let packages = 94 | Mld.v cwd "p" None 95 | [ Odoc.CPage package.name ] 96 | (Printf.sprintf "{0 Packages}\n{!childpage:%s}\n" package.name) 97 | in 98 | packages 99 | else 100 | let universes = 101 | Mld.v cwd "u" None 102 | [ Odoc.CPage package.universe ] 103 | (Printf.sprintf "{0 Universes}\n{!childpage:%s}\n" package.universe) 104 | in 105 | let universe = 106 | Mld.v cwd package.universe (Some universes) 107 | [ Odoc.CPage package.name ] 108 | (Printf.sprintf "{0 %s}\n{!childpage:%s}\n" package.universe 109 | package.name) 110 | in 111 | universe 112 | in 113 | let pkg = 114 | Mld.v cwd package.name (Some top_parents) 115 | [ Odoc.CPage package.version ] 116 | (Printf.sprintf "{0 %s}\n{!childpage:%s}\n" package.name package.version) 117 | in 118 | 119 | let version = 120 | Mld.v cwd package.version (Some pkg) [ Odoc.CPage "doc" ] 121 | (Printf.sprintf "{0 %s}\n{!childpage:doc}\n" package.version) 122 | in 123 | 124 | let content = 125 | match mld_index with 126 | | [] -> gen package ~libraries ~error_log ~failed 127 | | x :: _ -> 128 | let ic = open_in (Fpath.to_string x) in 129 | let result = really_input_string ic (in_channel_length ic) in 130 | close_in ic; 131 | result 132 | in 133 | let () = 134 | match Bos.OS.File.delete Fpath.(v "doc.mld") with 135 | | Ok x -> x 136 | | Error (`Msg m) -> 137 | Format.eprintf "Failed to remove file: doc.mld - %s\n%!" m; 138 | () 139 | in 140 | let doc = Mld.v cwd "doc" (Some version) children content in 141 | Mld.compile doc; 142 | doc 143 | -------------------------------------------------------------------------------- /src/voodoo/index_mld_page.mli: -------------------------------------------------------------------------------- 1 | val gen : 2 | Package.t -> 3 | blessed:bool -> 4 | modules:string list -> 5 | libraries:Library_names.t -> 6 | package_mlds:Fpath.t list -> 7 | error_log:Error_log.t -> 8 | failed:bool -> 9 | Mld.t 10 | (** [gen] generates an index.mld file for packages that don't have one. *) 11 | -------------------------------------------------------------------------------- /src/voodoo/library_names.ml: -------------------------------------------------------------------------------- 1 | (** To extract the library names for a given package, without using dune, we 2 | 3 | 1. parse the META file of the package with ocamlfind to see which libraries 4 | exist and what their archive name (.cma filename) is. 5 | 6 | 2. use ocamlobjinfo to get a list of all modules within the archives. 7 | 8 | This code assumes that the META file lists for every library an archive 9 | [archive_name], and that for this cma archive exists a corresponsing 10 | [archive_name].ocamlobjinfo file. *) 11 | 12 | type library = { 13 | name : string; 14 | archive_name : string; 15 | mutable modules : string list; 16 | } 17 | 18 | type t = { libraries : library list } 19 | 20 | let read_libraries_from_pkg_defs ~library_name pkg_defs = 21 | try 22 | let cma_filename = Fl_metascanner.lookup "archive" [ "byte" ] pkg_defs in 23 | let archive_name = 24 | let file_name_len = String.length cma_filename in 25 | if file_name_len > 0 then String.sub cma_filename 0 (file_name_len - 4) 26 | else cma_filename 27 | in 28 | if String.length archive_name > 0 then 29 | [ { name = library_name; archive_name; modules = [] } ] 30 | else [] 31 | with Not_found -> [] 32 | 33 | let process_meta_file file = 34 | let _ = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in 35 | let ic = open_in (Fpath.to_string file) in 36 | let meta = Fl_metascanner.parse ic in 37 | let base_library_name = 38 | if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename 39 | else Fpath.get_ext file 40 | in 41 | let rec extract_name_and_archive ~prefix 42 | ((name, pkg_expr) : string * Fl_metascanner.pkg_expr) = 43 | let library_name = prefix ^ "." ^ name in 44 | let libraries = 45 | read_libraries_from_pkg_defs ~library_name pkg_expr.pkg_defs 46 | in 47 | let child_libraries = 48 | pkg_expr.pkg_children 49 | |> List.map (extract_name_and_archive ~prefix:library_name) 50 | |> List.flatten 51 | in 52 | libraries @ child_libraries 53 | in 54 | let libraries = 55 | read_libraries_from_pkg_defs ~library_name:base_library_name meta.pkg_defs 56 | in 57 | let is_not_private (lib : library) = 58 | not 59 | (String.split_on_char '.' lib.name 60 | |> List.exists (fun x -> x = "__private__")) 61 | in 62 | let libraries = 63 | libraries 64 | @ (meta.pkg_children 65 | |> List.map (extract_name_and_archive ~prefix:base_library_name) 66 | |> List.flatten) 67 | |> List.filter is_not_private 68 | in 69 | libraries 70 | 71 | let process_ocamlobjinfo_file ~(libraries : library list) file = 72 | let _ = 73 | Format.eprintf "process_ocamlobjinfo_file: %s\n%!" (Fpath.to_string file) 74 | in 75 | let ic = open_in (Fpath.to_string file) in 76 | let lines = Util.lines_of_channel ic in 77 | let affix = "Unit name: " in 78 | let len = String.length affix in 79 | close_in ic; 80 | let units = 81 | Compat.List.concat_map 82 | (fun line -> 83 | if Astring.String.is_prefix ~affix line then 84 | [ String.sub line len (String.length line - len) ] 85 | else []) 86 | lines 87 | in 88 | let _, archive_name = Fpath.split_base file in 89 | let archive_name = archive_name |> Fpath.rem_ext |> Fpath.to_string in 90 | let _ = 91 | Format.eprintf "trying to look up archive_name: %s\nunits: %s\n%!" 92 | archive_name (String.concat "," units) 93 | in 94 | try 95 | let library = 96 | List.find (fun l -> l.archive_name = archive_name) libraries 97 | in 98 | library.modules <- library.modules @ units 99 | with Not_found -> 100 | Format.eprintf "failed to find archive_name: %s\n%!" archive_name; 101 | () 102 | 103 | let get_libraries package = 104 | let path = Package.prep_path package in 105 | let maybe_meta_files = 106 | Bos.OS.Dir.fold_contents ~dotfiles:true 107 | (fun p acc -> 108 | let is_meta = p |> Fpath.basename = "META" in 109 | if is_meta then p :: acc else acc) 110 | [] path 111 | in 112 | 113 | match maybe_meta_files with 114 | | Error (`Msg msg) -> 115 | failwith 116 | ("FIXME: error traversing directories to find the META files: " ^ msg) 117 | | Ok meta_files -> ( 118 | let libraries = 119 | meta_files |> List.map process_meta_file |> List.flatten 120 | in 121 | 122 | let _ = 123 | Format.eprintf "found archive_names: [%s]\n%!" 124 | (String.concat ", " 125 | (List.map (fun (l : library) -> l.archive_name) libraries)) 126 | in 127 | 128 | let maybe_ocamlobjinfo_files = 129 | Bos.OS.Dir.fold_contents ~dotfiles:true 130 | (fun p acc -> 131 | let is_ocamlobjinfo = Fpath.get_ext p = ".ocamlobjinfo" in 132 | if is_ocamlobjinfo then p :: acc else acc) 133 | [] path 134 | in 135 | match maybe_ocamlobjinfo_files with 136 | | Error (`Msg msg) -> 137 | failwith 138 | ("FIXME: error traversing directories to find the ocamlobjinfo \ 139 | files: " ^ msg) 140 | | Ok ocamlobjinfo_files -> 141 | List.iter (process_ocamlobjinfo_file ~libraries) ocamlobjinfo_files; 142 | let _ = 143 | Format.eprintf "found archive_names: [%s]\n%!" 144 | (String.concat ", " 145 | (List.map 146 | (fun (l : library) -> 147 | l.archive_name ^ "/" ^ String.concat "," l.modules) 148 | libraries)) 149 | in 150 | { libraries }) 151 | -------------------------------------------------------------------------------- /src/voodoo/library_names.mli: -------------------------------------------------------------------------------- 1 | type library = { 2 | name : string; 3 | archive_name : string; 4 | mutable modules : string list; 5 | } 6 | 7 | type t = { libraries : library list } 8 | 9 | val get_libraries : Package.t -> t 10 | (** [get_libraries p] returns all libraries in the package, including their 11 | modules. *) 12 | -------------------------------------------------------------------------------- /src/voodoo/mld.ml: -------------------------------------------------------------------------------- 1 | module Result = Bos_setup.R 2 | 3 | type t = { 4 | path : Paths.t; 5 | name : string; 6 | parent : t option; 7 | children : Odoc.child list; 8 | } 9 | 10 | let rec pp fmt v = 11 | let child_pp fmt = function 12 | | Odoc.CModule m -> Format.fprintf fmt "CModule %s" m 13 | | CPage p -> Format.fprintf fmt "CPage %s" p 14 | | CSrc p -> Format.fprintf fmt "CSrc %s" p 15 | in 16 | Format.fprintf fmt "{ path: %a; name: %s; parent: %a; children: %a }" Fpath.pp 17 | v.path v.name (Fmt.option pp) v.parent 18 | (Fmt.list ~sep:(fun fmt () -> Format.fprintf fmt ",") child_pp) 19 | v.children 20 | 21 | let rec output_dir : base:Fpath.t -> t -> Paths.t = 22 | fun ~base mld -> 23 | match mld.parent with 24 | | None -> base 25 | | Some p -> 26 | let pdir = output_dir ~base p in 27 | Fpath.(pdir / p.name) 28 | 29 | let compile_dir = output_dir ~base:Paths.compile 30 | let link_dir = output_dir ~base:Paths.link 31 | let output_file mld = Fpath.(compile_dir mld / ("page-" ^ mld.name ^ ".odoc")) 32 | let output_odocl mld = Fpath.(link_dir mld / ("page-" ^ mld.name ^ ".odocl")) 33 | 34 | let rec compile mld = 35 | let () = Bos.OS.File.delete (output_file mld) |> Result.get_ok in 36 | let extra_include, parent = 37 | match mld.parent with 38 | | None -> ([], None) 39 | | Some parent -> 40 | compile parent; 41 | ([ compile_dir parent ], Some parent.name) 42 | in 43 | let includes = Fpath.Set.of_list extra_include in 44 | ignore 45 | (Odoc.compile ?parent ~output:(output_file mld) mld.path ~includes 46 | ~children:mld.children) 47 | 48 | let write mld contents = 49 | let oc = open_out Fpath.(to_string mld.path) in 50 | Printf.fprintf oc "%s" contents; 51 | close_out oc 52 | 53 | let v dir name parent children contents = 54 | let path = Fpath.(dir / (name ^ ".mld")) in 55 | let mld = { path; name; parent; children } in 56 | Util.mkdir_p dir; 57 | write mld contents; 58 | mld 59 | 60 | let of_fpath ~parent path = 61 | let _, name_ext = Fpath.split_base path in 62 | let name = Fpath.rem_ext name_ext |> Fpath.to_string in 63 | { path; name; parent = Some parent; children = [] } 64 | -------------------------------------------------------------------------------- /src/voodoo/mld.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | path : Fpath.t; 3 | name : string; 4 | parent : t option; 5 | children : Odoc.child list; 6 | } 7 | 8 | val pp : t Fmt.t 9 | val output_dir : base:Fpath.t -> t -> Fpath.t 10 | 11 | val compile_dir : t -> Fpath.t 12 | (** [compile_dir x] returns the directory containing the files produced by 13 | running [odoc compile] on [x]. *) 14 | 15 | val link_dir : t -> Fpath.t 16 | (** [link_dir x] returns the directory containing the files produced by running 17 | [odoc link] on [x]. *) 18 | 19 | val output_file : t -> Fpath.t 20 | (** [output_file x] returns the path of the [.odoc] file resulting of running 21 | [odoc compile] on [x]. *) 22 | 23 | val output_odocl : t -> Fpath.t 24 | (** [output_odocl x] returns the path of the [.odocl] file resulting of running 25 | [odoc link] on [x]. *) 26 | 27 | val compile : t -> unit 28 | (** [compile x] calls [odoc compile] on [x] and its parents. *) 29 | 30 | val v : Fpath.t -> string -> t option -> Odoc.child list -> string -> t 31 | val of_fpath : parent:t -> Fpath.t -> t 32 | -------------------------------------------------------------------------------- /src/voodoo/odoc.ml: -------------------------------------------------------------------------------- 1 | type compile_dep = { c_unit_name : string; c_digest : string } 2 | 3 | type link_dep = { 4 | l_package : string; 5 | l_name : string; 6 | l_digest : Digest.t; 7 | l_version : string; 8 | l_universe : string option; 9 | } 10 | 11 | let pp_link_dep fmt l = 12 | Format.fprintf fmt "{ %s %s %s %s}" l.l_package l.l_name l.l_version 13 | (match l.l_universe with Some u -> Printf.sprintf "(%s)" u | None -> "") 14 | 15 | let compile_deps file = 16 | let deps_file = Fpath.add_ext "deps" file in 17 | let process_line line = 18 | match Astring.String.cuts ~sep:" " line with 19 | | [ c_unit_name; c_digest ] -> [ { c_unit_name; c_digest } ] 20 | | _ -> [] 21 | in 22 | let exists = Sys.file_exists (Fpath.to_string deps_file) in 23 | let lines = 24 | if exists then ( 25 | let ic = open_in (Fpath.to_string deps_file) in 26 | let lines = Util.lines_of_channel ic in 27 | close_in ic; 28 | lines) 29 | else 30 | let odoc = Bos.Cmd.v "odoc" in 31 | let lines = 32 | Util.lines_of_process 33 | Bos.Cmd.(odoc % "compile-deps" % Fpath.to_string file) 34 | in 35 | let tmp_file = Fpath.to_string (Fpath.add_ext "tmp" deps_file) in 36 | let oc = open_out tmp_file in 37 | List.iter (fun l -> Printf.fprintf oc "%s\n" l) lines; 38 | close_out oc; 39 | Unix.rename tmp_file (Fpath.to_string deps_file); 40 | lines 41 | in 42 | let deps = Compat.List.concat_map process_line lines in 43 | let _, lname = Fpath.(split_base (rem_ext file)) in 44 | let name = Astring.String.Ascii.capitalize (Fpath.to_string lname) in 45 | match List.partition (fun d -> d.c_unit_name = name) deps with 46 | | self :: _, deps -> 47 | let digest = self.c_digest in 48 | Some (name, digest, deps) 49 | | _ -> 50 | Format.eprintf "Failed to find digest for self (%s)\n%!" name; 51 | None 52 | 53 | type child = CModule of string | CPage of string | CSrc of string 54 | 55 | let compile ?parent ?output path ~includes ~children = 56 | let cmd = Bos.Cmd.(v "odoc" % "compile" % Fpath.to_string path) in 57 | let cmd = 58 | match output with 59 | | Some fpath -> Bos.Cmd.(cmd % "-o" % Fpath.to_string fpath) 60 | | None -> cmd 61 | in 62 | let cmd = 63 | match parent with 64 | | Some str -> Bos.Cmd.(cmd % "--parent" % Printf.sprintf "page-\"%s\"" str) 65 | | None -> cmd 66 | in 67 | let cmd = 68 | Fpath.Set.fold 69 | (fun i c -> Bos.Cmd.(c % "-I" % Fpath.to_string i)) 70 | includes cmd 71 | in 72 | let cmd = 73 | List.fold_left 74 | (fun cmd c -> 75 | let arg = 76 | match c with 77 | | CModule m -> "module-" ^ m 78 | | CPage p -> "page-\"" ^ p ^ "\"" 79 | | CSrc p -> "src-" ^ p 80 | in 81 | Bos.Cmd.(cmd % "--child" % arg)) 82 | cmd children 83 | in 84 | Format.eprintf "compile command: %a\n%!" Bos.Cmd.pp cmd; 85 | Util.run_silent cmd 86 | 87 | let link path ~includes ~output = 88 | let cmd = 89 | Bos.Cmd.( 90 | v "odoc" % "link" % Fpath.to_string path % "-o" % Fpath.to_string output) 91 | in 92 | let cmd = 93 | Fpath.Set.fold 94 | (fun i c -> Bos.Cmd.(c % "-I" % Fpath.to_string i)) 95 | includes cmd 96 | in 97 | Util.run_silent cmd 98 | 99 | let html path ~output = 100 | let cmd = 101 | Bos.Cmd.( 102 | v "odoc" % "html-generate" % "--indent" % Fpath.to_string path % "-o" 103 | % Fpath.to_string output) 104 | in 105 | Util.run_silent cmd 106 | -------------------------------------------------------------------------------- /src/voodoo/odoc.mli: -------------------------------------------------------------------------------- 1 | type compile_dep = { c_unit_name : string; c_digest : string } 2 | (** The name and optional digest of a dependency. Modules compiled with 3 | [--no-alias-deps] don't have digests for purely aliased modules. *) 4 | 5 | type link_dep = { 6 | l_package : string; 7 | l_name : string; 8 | l_digest : string; 9 | l_version : string; 10 | l_universe : string option; 11 | } 12 | 13 | val pp_link_dep : Format.formatter -> link_dep -> unit 14 | val compile_deps : Fpath.t -> (string * string * compile_dep list) option 15 | 16 | type child = 17 | | CModule of string (** module name, e.g. 'String' *) 18 | | CPage of string (** page name, e.g. 'packages' *) 19 | | CSrc of string (* 'src' *) 20 | 21 | val compile : 22 | ?parent:string -> 23 | ?output:Fpath.t -> 24 | Fpath.t -> 25 | includes:Fpath.set -> 26 | children:child list -> 27 | unit 28 | (** [compile p ?parent ?output ~includes ~children] runs [odoc compile] on path 29 | [p]. *) 30 | 31 | val link : Fpath.t -> includes:Fpath.set -> output:Fpath.t -> unit 32 | (** [link p ~includes ~output] runs [odoc link] on path [p]. *) 33 | 34 | val html : Fpath.t -> output:Fpath.t -> unit 35 | (** [html p ~output] runs [odoc html-generate] on path [p]. *) 36 | -------------------------------------------------------------------------------- /src/voodoo/opam.ml: -------------------------------------------------------------------------------- 1 | module Result = Bos_setup.R 2 | 3 | let switch = ref None 4 | 5 | let find package = 6 | let path = Package.prep_path package in 7 | Bos.OS.Dir.fold_contents ~dotfiles:true 8 | (fun p acc -> 9 | let _, name = Fpath.split_base p in 10 | if name = Fpath.v "opam" then Ok p else acc) 11 | (Error (`Msg "No opam file found")) 12 | path 13 | |> Result.join 14 | -------------------------------------------------------------------------------- /src/voodoo/opam.mli: -------------------------------------------------------------------------------- 1 | val switch : string option ref 2 | (** [switch] returns the local opam switch name. *) 3 | 4 | val find : Package.t -> (Fpath.t, [> Bos_setup.R.msg ]) Bos_setup.result 5 | (** [find p] returns the path to the [opam] file of package [p], in the prepped 6 | directory of [p]. *) 7 | -------------------------------------------------------------------------------- /src/voodoo/otherdocs.ml: -------------------------------------------------------------------------------- 1 | let copy version docs opam_file = 2 | let dir = Fpath.(Mld.link_dir version / version.name) in 3 | let copy src = 4 | let _, n = Fpath.split_base src in 5 | let _ = 6 | match Bos.OS.Dir.create dir with 7 | | Ok _ -> () 8 | | Error (`Msg m) -> 9 | Format.eprintf "Failed to create destination dir: %s\n%!" m; 10 | () 11 | in 12 | let dst = Fpath.(dir // n) in 13 | Format.eprintf "dst: %a\n%!" Fpath.pp dst; 14 | match Util.copy src dst with Ok _ -> [ dst ] | Error _ -> [] 15 | in 16 | let opam_file = 17 | match opam_file with 18 | | Some f -> ( match copy f with dst :: _ -> Some dst | [] -> None) 19 | | None -> None 20 | in 21 | (List.map copy docs |> List.concat, opam_file) 22 | -------------------------------------------------------------------------------- /src/voodoo/otherdocs.mli: -------------------------------------------------------------------------------- 1 | val copy : 2 | Mld.t -> Fpath.t list -> Fpath.t option -> Fpath.t list * Fpath.t option 3 | (** [copy version docs opam_file] copies the other docs [docs] and [opam_file] 4 | into the [version] directory, returns paths to the successfully copied 5 | files. *) 6 | -------------------------------------------------------------------------------- /src/voodoo/package.ml: -------------------------------------------------------------------------------- 1 | type t = { universe : string; name : string; version : string } 2 | 3 | let prep_path p = 4 | Fpath.(Paths.prep / "universes" / p.universe / p.name / p.version) 5 | -------------------------------------------------------------------------------- /src/voodoo/package.mli: -------------------------------------------------------------------------------- 1 | type t = { universe : string; name : string; version : string } 2 | 3 | val prep_path : t -> Fpath.t 4 | (** [prep_path p] is the directory where the prepped package [p] is stored. 5 | 6 | Warning: it needs to stay in sync with [src/voodoo-prep/package.ml] *) 7 | -------------------------------------------------------------------------------- /src/voodoo/package_info.ml: -------------------------------------------------------------------------------- 1 | let gen ~output ~libraries = 2 | let libraries = 3 | libraries 4 | |> List.map (fun { Library_names.name; modules; _ } -> 5 | { 6 | Voodoo_serialize.Package_info.Library.name; 7 | modules; 8 | dependencies = []; 9 | }) 10 | in 11 | 12 | let output = Fpath.(to_string (output / "package.json")) in 13 | Yojson.Safe.to_file output 14 | (Voodoo_serialize.Package_info.to_yojson Voodoo_serialize.String_.to_yojson 15 | { libraries }) 16 | -------------------------------------------------------------------------------- /src/voodoo/package_info.mli: -------------------------------------------------------------------------------- 1 | val gen : output:Fpath.t -> libraries:Library_names.library list -> unit 2 | (** [gen ~output ~dune ~libraries] generates a [package.json] describing the 3 | content of the package described by the dune file [dune], or the libraries 4 | [libraries]. *) 5 | -------------------------------------------------------------------------------- /src/voodoo/package_mlds.ml: -------------------------------------------------------------------------------- 1 | let find package = 2 | let path = Fpath.(Package.prep_path package / "doc" / package.name) in 3 | let res = 4 | Bos.OS.Dir.fold_contents ~elements:`Files ~dotfiles:false 5 | (fun p (mlds, other) -> 6 | match Fpath.segs p |> List.rev with 7 | | _ :: "odoc-pages" :: _ when Fpath.get_ext p = ".mld" -> 8 | (p :: mlds, other) 9 | | _ -> (mlds, p :: other)) 10 | ([], []) path 11 | in 12 | match res with 13 | | Ok (mlds, other) -> 14 | Format.eprintf "Found %d mld pages and %d other pages\n%!" 15 | (List.length mlds) (List.length other); 16 | (mlds, other) 17 | | Error _ -> 18 | Format.eprintf "Found no other pages\n%!"; 19 | ([], []) 20 | 21 | let compile ~parent package_mlds = 22 | if List.length package_mlds = 0 then ( 23 | Format.eprintf "No children\n%!"; 24 | []) 25 | else ( 26 | Format.eprintf "package mlds: [%s]\n%!" 27 | (String.concat "," (List.map Fpath.to_string package_mlds)); 28 | let package_mlds = 29 | List.filter (fun p -> Fpath.basename p <> "index.mld") package_mlds 30 | in 31 | let package_mldvs = List.map (Mld.of_fpath ~parent) package_mlds in 32 | List.iter Mld.compile package_mldvs; 33 | package_mldvs) 34 | 35 | let include_paths mlds = 36 | let all_mlds = 37 | match mlds with { Mld.parent = Some p; _ } :: _ -> p :: mlds | _ -> mlds 38 | in 39 | List.fold_left 40 | (fun acc mld -> Fpath.Set.add (Mld.compile_dir mld) acc) 41 | Fpath.Set.empty all_mlds 42 | -------------------------------------------------------------------------------- /src/voodoo/package_mlds.mli: -------------------------------------------------------------------------------- 1 | val find : Package.t -> Fpath.t list * Fpath.t list 2 | (** [find p] returns the list of [.mld] pages and other pages from the [doc/] 3 | directory in the prepped directory of package [p]. *) 4 | 5 | val compile : parent:Mld.t -> Fpath.t list -> Mld.t list 6 | (** [compile ~parent mlds] calls [odoc compile] on each mld file of [mlds]. *) 7 | 8 | val include_paths : Mld.t list -> Fpath.set 9 | (** [include_paths mlds] returns the paths of the parents of each mld file of 10 | [mlds]. *) 11 | -------------------------------------------------------------------------------- /src/voodoo/paths.ml: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | let compile = Fpath.v "compile" 4 | let prep = Fpath.v "prep" 5 | let link = Fpath.v "linked" 6 | -------------------------------------------------------------------------------- /src/voodoo/paths.mli: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | val compile : Fpath.t 4 | (** [compile] is the root directory where the results of [odoc compile] are 5 | stored. *) 6 | 7 | val prep : Fpath.t 8 | (** [prep] is the root directory where the prepped packages are stored. 9 | 10 | Warning: it needs to stay in sync with [src/voodoo-prep/paths.ml] *) 11 | 12 | val link : Fpath.t 13 | (** [link] is the root directory where the results of [odoc link] are stored. *) 14 | -------------------------------------------------------------------------------- /src/voodoo/serialize/conv.ml: -------------------------------------------------------------------------------- 1 | type 'a of_yojson = Yojson.Safe.t -> 'a 2 | type 'a to_yojson = 'a -> Yojson.Safe.t 3 | -------------------------------------------------------------------------------- /src/voodoo/serialize/conv.mli: -------------------------------------------------------------------------------- 1 | type 'a of_yojson = Yojson.Safe.t -> 'a 2 | type 'a to_yojson = 'a -> Yojson.Safe.t 3 | -------------------------------------------------------------------------------- /src/voodoo/serialize/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name voodoo_serialize) 3 | (public_name voodoo-lib.serialize) 4 | (libraries fpath yojson)) 5 | -------------------------------------------------------------------------------- /src/voodoo/serialize/fpath_.ml: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | let of_yojson json = json |> Yojson.Safe.Util.to_string |> Fpath.v 4 | let to_yojson x = `String (Fpath.to_string x) 5 | -------------------------------------------------------------------------------- /src/voodoo/serialize/fpath_.mli: -------------------------------------------------------------------------------- 1 | type t = Fpath.t 2 | 3 | val of_yojson : t Conv.of_yojson 4 | val to_yojson : t Conv.to_yojson 5 | -------------------------------------------------------------------------------- /src/voodoo/serialize/package_info.ml: -------------------------------------------------------------------------------- 1 | module Kind = struct 2 | type t = 3 | [ `Module 4 | | `Page 5 | | `LeafPage 6 | | `SourcePage 7 | | `ModuleType 8 | | `Parameter of int 9 | | `Class 10 | | `ClassType 11 | | `File ] 12 | 13 | let to_string = function 14 | | `Page -> "page" 15 | | `Module -> "module" 16 | | `LeafPage -> "leaf-page" 17 | | `SourcePage -> "source" 18 | | `ModuleType -> "module-type" 19 | | `Parameter arg_num -> Printf.sprintf "argument-%d" arg_num 20 | | `Class -> "class" 21 | | `ClassType -> "class-type" 22 | | `File -> "file" 23 | 24 | let of_string = function 25 | | "page" -> `Page 26 | | "module" -> `Module 27 | | "leaf-page" -> `LeafPage 28 | | "source" -> `SourcePage 29 | | "module-type" -> `ModuleType 30 | | "class" -> `Class 31 | | "class-type" -> `ClassType 32 | | "file" -> `File 33 | | s when String.length s > 9 && String.sub s 0 9 = "argument-" -> 34 | let i = String.sub s 9 (String.length s - 9) in 35 | `Parameter (int_of_string i) 36 | | s -> 37 | raise (Invalid_argument (Format.sprintf "Variant not supported: %s" s)) 38 | 39 | let equal x y = to_string x = to_string y 40 | let pp fs x = Format.fprintf fs "%s" (to_string x) 41 | let of_yojson json = json |> Yojson.Safe.Util.to_string |> of_string 42 | let to_yojson x = `String (to_string x) 43 | end 44 | 45 | module Module = struct 46 | type t = { name : string; submodules : t list; kind : Kind.t } 47 | 48 | let rec equal x y = 49 | x.name = y.name && Kind.equal x.kind y.kind 50 | && Util.list_equal equal x.submodules y.submodules 51 | 52 | let rec pp fs x = 53 | Format.fprintf fs "(name:%S) (submodules:%a) (kind:%a)" x.name 54 | (Format.pp_print_list pp) x.submodules Kind.pp x.kind 55 | 56 | let rec of_yojson json = 57 | let open Yojson.Safe.Util in 58 | let name = json |> member "name" |> to_string in 59 | let submodules = 60 | json |> member "submodules" |> to_list |> List.map of_yojson 61 | in 62 | (* [Invalid_argument] is not caught on purpose. *) 63 | let kind = json |> member "kind" |> Kind.of_yojson in 64 | { name; submodules; kind } 65 | 66 | let rec to_yojson { name; kind; submodules } = 67 | let name = ("name", `String name) in 68 | let submodules = ("submodules", `List (List.map to_yojson submodules)) in 69 | let kind = ("kind", Kind.to_yojson kind) in 70 | `Assoc [ name; submodules; kind ] 71 | end 72 | 73 | module Library = struct 74 | type 'a t = { name : string; modules : 'a list; dependencies : string list } 75 | 76 | let equal f x y = 77 | x.name = y.name 78 | && Util.list_equal f x.modules y.modules 79 | && Util.list_equal ( = ) x.dependencies y.dependencies 80 | 81 | let pp f fs x = 82 | Format.fprintf fs "(name:%S) (modules:%a) (dependencies:%a)" x.name 83 | (Format.pp_print_list f) x.modules 84 | (Format.pp_print_list Format.pp_print_string) 85 | x.dependencies 86 | 87 | let of_yojson f json = 88 | let open Yojson.Safe.Util in 89 | let name = json |> member "name" |> to_string in 90 | let modules = json |> member "modules" |> to_list |> List.map f in 91 | let dependencies = 92 | try json |> member "dependencies" |> to_list |> List.map to_string 93 | with Type_error _ -> [] 94 | in 95 | { name; modules; dependencies } 96 | 97 | let to_yojson f { name; modules; dependencies } = 98 | let list_string v = `List (List.map (fun m -> `String m) v) in 99 | let name = ("name", `String name) in 100 | let modules = ("modules", `List (List.map f modules)) in 101 | let dependencies = [ ("dependencies", list_string dependencies) ] in 102 | `Assoc (name :: modules :: dependencies) 103 | end 104 | 105 | type 'a t = { libraries : 'a Library.t list } 106 | 107 | let equal f x y = Util.list_equal (Library.equal f) x.libraries y.libraries 108 | 109 | let pp f fs x = 110 | Format.fprintf fs "(libraries:%a)" 111 | (Format.pp_print_list (Library.pp f)) 112 | x.libraries 113 | 114 | let of_yojson f json = 115 | let open Yojson.Safe.Util in 116 | let libraries = 117 | json |> member "libraries" |> to_list |> List.map (Library.of_yojson f) 118 | in 119 | { libraries } 120 | 121 | let to_yojson f { libraries } = 122 | `Assoc [ ("libraries", `List (List.map (Library.to_yojson f) libraries)) ] 123 | -------------------------------------------------------------------------------- /src/voodoo/serialize/package_info.mli: -------------------------------------------------------------------------------- 1 | module Kind : sig 2 | type t = 3 | [ `Module 4 | | `Page 5 | | `LeafPage 6 | | `SourcePage 7 | | `ModuleType 8 | | `Parameter of int 9 | | `Class 10 | | `ClassType 11 | | `File ] 12 | 13 | val equal : t -> t -> bool 14 | val pp : Format.formatter -> t -> unit 15 | val of_yojson : t Conv.of_yojson 16 | val to_yojson : t Conv.to_yojson 17 | end 18 | 19 | module Module : sig 20 | type t = { name : string; submodules : t list; kind : Kind.t } 21 | 22 | val equal : t -> t -> bool 23 | val pp : Format.formatter -> t -> unit 24 | val of_yojson : t Conv.of_yojson 25 | val to_yojson : t Conv.to_yojson 26 | end 27 | 28 | module Library : sig 29 | type 'a t = { name : string; modules : 'a list; dependencies : string list } 30 | 31 | val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 32 | val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit 33 | val of_yojson : 'a Conv.of_yojson -> 'a t Conv.of_yojson 34 | val to_yojson : 'a Conv.to_yojson -> 'a t Conv.to_yojson 35 | end 36 | 37 | type 'a t = { libraries : 'a Library.t list } 38 | 39 | val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 40 | val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit 41 | val of_yojson : 'a Conv.of_yojson -> 'a t Conv.of_yojson 42 | val to_yojson : 'a Conv.to_yojson -> 'a t Conv.to_yojson 43 | -------------------------------------------------------------------------------- /src/voodoo/serialize/status.ml: -------------------------------------------------------------------------------- 1 | module Otherdocs = struct 2 | type t = { 3 | readme : Fpath.t list; 4 | license : Fpath.t list; 5 | changes : Fpath.t list; 6 | others : Fpath.t list; 7 | } 8 | 9 | let empty = { readme = []; license = []; changes = []; others = [] } 10 | 11 | let equal x y = 12 | Util.list_equal Fpath.equal x.readme y.readme 13 | && Util.list_equal Fpath.equal x.license y.license 14 | && Util.list_equal Fpath.equal x.changes y.changes 15 | && Util.list_equal Fpath.equal x.others y.others 16 | 17 | let pp fs x = 18 | Format.fprintf fs "(readme:%a) (license:%a) (changes:%a) (others:%a)" 19 | (Format.pp_print_list Fpath.pp) 20 | x.readme 21 | (Format.pp_print_list Fpath.pp) 22 | x.license 23 | (Format.pp_print_list Fpath.pp) 24 | x.changes 25 | (Format.pp_print_list Fpath.pp) 26 | x.others 27 | 28 | let of_yojson json = 29 | let open Yojson.Safe.Util in 30 | let readme = 31 | json |> member "readme" |> to_list |> List.map Fpath_.of_yojson 32 | in 33 | let license = 34 | json |> member "license" |> to_list |> List.map Fpath_.of_yojson 35 | in 36 | let changes = 37 | json |> member "changes" |> to_list |> List.map Fpath_.of_yojson 38 | in 39 | let others = 40 | json |> member "others" |> to_list |> List.map Fpath_.of_yojson 41 | in 42 | { readme; license; changes; others } 43 | 44 | let to_yojson { readme; license; changes; others } = 45 | let readme = ("readme", `List (List.map Fpath_.to_yojson readme)) in 46 | let license = ("license", `List (List.map Fpath_.to_yojson license)) in 47 | let changes = ("changes", `List (List.map Fpath_.to_yojson changes)) in 48 | let others = ("others", `List (List.map Fpath_.to_yojson others)) in 49 | `Assoc [ readme; license; changes; others ] 50 | end 51 | 52 | type t = { failed : bool; otherdocs : Otherdocs.t } 53 | 54 | let equal x y = x.failed = y.failed && Otherdocs.equal x.otherdocs y.otherdocs 55 | 56 | let pp fs x = 57 | Format.fprintf fs "(failed:%b) (otherdocs:%a)" x.failed Otherdocs.pp 58 | x.otherdocs 59 | 60 | let of_yojson json = 61 | let open Yojson.Safe.Util in 62 | let failed = json |> member "failed" |> to_bool in 63 | let otherdocs = json |> member "otherdocs" |> Otherdocs.of_yojson in 64 | { failed; otherdocs } 65 | 66 | let to_yojson { failed; otherdocs } = 67 | let failed = ("failed", `Bool failed) in 68 | let otherdocs = ("otherdocs", Otherdocs.to_yojson otherdocs) in 69 | `Assoc [ failed; otherdocs ] 70 | -------------------------------------------------------------------------------- /src/voodoo/serialize/status.mli: -------------------------------------------------------------------------------- 1 | module Otherdocs : sig 2 | type t = { 3 | readme : Fpath.t list; 4 | license : Fpath.t list; 5 | changes : Fpath.t list; 6 | others : Fpath.t list; 7 | } 8 | 9 | val empty : t 10 | val equal : t -> t -> bool 11 | val pp : Format.formatter -> t -> unit 12 | val of_yojson : t Conv.of_yojson 13 | val to_yojson : t Conv.to_yojson 14 | end 15 | 16 | type t = { failed : bool; otherdocs : Otherdocs.t } 17 | 18 | val equal : t -> t -> bool 19 | val pp : Format.formatter -> t -> unit 20 | val of_yojson : t Conv.of_yojson 21 | val to_yojson : t Conv.to_yojson 22 | -------------------------------------------------------------------------------- /src/voodoo/serialize/string_.ml: -------------------------------------------------------------------------------- 1 | type t = string 2 | 3 | let of_yojson json = json |> Yojson.Safe.Util.to_string 4 | let to_yojson x = `String x 5 | -------------------------------------------------------------------------------- /src/voodoo/serialize/string_.mli: -------------------------------------------------------------------------------- 1 | type t = string 2 | 3 | val of_yojson : t Conv.of_yojson 4 | val to_yojson : t Conv.to_yojson 5 | -------------------------------------------------------------------------------- /src/voodoo/serialize/util.ml: -------------------------------------------------------------------------------- 1 | let rec list_equal f x y = 2 | match (x, y) with 3 | | [], [] -> true 4 | | [], _ | _, [] -> false 5 | | a :: b, c :: d -> f a c && list_equal f b d 6 | -------------------------------------------------------------------------------- /src/voodoo/serialize/util.mli: -------------------------------------------------------------------------------- 1 | val list_equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool 2 | -------------------------------------------------------------------------------- /src/voodoo/sourceinfo.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | package : Package.t; 3 | path : Paths.t; 4 | name : string; 5 | digest : string; 6 | parent : Mld.t; 7 | deps : Odoc.compile_dep list; 8 | } 9 | 10 | let output_dir ~base si = 11 | let segs = Fpath.segs si.path in 12 | match segs with 13 | | _prep :: _universe :: _package :: _version :: rest -> 14 | let fpath' = Fpath.v (String.concat "/" rest) in 15 | Fpath.append 16 | (Mld.output_dir ~base si.parent) 17 | (Fpath.split_base fpath' |> fst) 18 | | _ -> failwith "Invalid path" 19 | 20 | let compile_dir = output_dir ~base:Paths.compile 21 | let link_dir = output_dir ~base:Paths.link 22 | let output_file si = Fpath.(compile_dir si / (si.name ^ ".odoc")) 23 | let output_odocl si = Fpath.(link_dir si / (si.name ^ ".odocl")) 24 | let is_hidden t = Util.is_hidden t.name 25 | -------------------------------------------------------------------------------- /src/voodoo/sourceinfo.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | package : Package.t; 3 | path : Fpath.t; 4 | name : string; 5 | digest : string; 6 | parent : Mld.t; 7 | deps : Odoc.compile_dep list; 8 | } 9 | 10 | val compile_dir : t -> Fpath.t 11 | (** [compile_dir x] returns the directory containing the files produced by 12 | running [odoc compile] on [x]. *) 13 | 14 | val output_file : t -> Fpath.t 15 | (** [output_file x] returns the path of the [.odoc] file resulting of running 16 | [odoc compile] on [x]. *) 17 | 18 | val output_odocl : t -> Fpath.t 19 | (** [output_odocl x] returns the path of the [.odocl] file resulting of running 20 | [odoc link] on [x]. *) 21 | 22 | val is_hidden : t -> bool 23 | -------------------------------------------------------------------------------- /src/voodoo/sourceinfo_index.ml: -------------------------------------------------------------------------------- 1 | module M = Map.Make (String) 2 | 3 | type t = { intern : Sourceinfo.t M.t; extern : Fpath.t M.t } 4 | 5 | let empty = { intern = M.empty; extern = M.empty } 6 | 7 | type serialisable = (string * Fpath.t) list 8 | 9 | let find_opt name t = try Some (M.find name t.intern) with _ -> None 10 | let find_extern_opt name t = try Some (M.find name t.extern) with _ -> None 11 | 12 | let write t parent_mld = 13 | let output_dir = Mld.compile_dir parent_mld in 14 | Util.mkdir_p Fpath.(output_dir / parent_mld.name); 15 | let oc = 16 | open_out Fpath.(to_string (output_dir / parent_mld.name / "index.m")) 17 | in 18 | (* Turn intern into extern for serialising *) 19 | let extern : serialisable = 20 | M.fold 21 | (fun k v acc -> M.add k (Sourceinfo.compile_dir v) acc) 22 | t.intern M.empty 23 | |> M.bindings 24 | in 25 | Printf.fprintf oc "%s" (Marshal.to_string extern []); 26 | close_out oc 27 | 28 | let read f = 29 | let ic = open_in Fpath.(to_string f) in 30 | let extern_list = (Marshal.from_channel ic : serialisable) in 31 | close_in ic; 32 | let extern = 33 | List.fold_left (fun acc (k, v) -> M.add k v acc) M.empty extern_list 34 | in 35 | { intern = M.empty; extern } 36 | 37 | let combine t1 t2 = 38 | { 39 | intern = M.fold M.add t1.intern t2.intern; 40 | extern = M.fold M.add t1.extern t2.extern; 41 | } 42 | 43 | let of_source_infos sis = 44 | let intern = 45 | List.fold_left (fun t si -> M.add si.Sourceinfo.digest si t) M.empty sis 46 | in 47 | { intern; extern = M.empty } 48 | -------------------------------------------------------------------------------- /src/voodoo/sourceinfo_index.mli: -------------------------------------------------------------------------------- 1 | (** Map of module digest to source info *) 2 | module M : sig 3 | include module type of Map.Make (String) 4 | end 5 | 6 | type t = { intern : Sourceinfo.t M.t; extern : Fpath.t M.t } 7 | 8 | val empty : t 9 | val find_opt : M.key -> t -> Sourceinfo.t option 10 | val find_extern_opt : M.key -> t -> Fpath.t option 11 | 12 | val write : t -> Mld.t -> unit 13 | (** [write x parent_mld] writes the index file [x] into 14 | 'packages///index.m' or 15 | 'universes////index.m' *) 16 | 17 | val read : Fpath.t -> t 18 | val combine : t -> t -> t 19 | val of_source_infos : Sourceinfo.t list -> t 20 | -------------------------------------------------------------------------------- /src/voodoo/util.ml: -------------------------------------------------------------------------------- 1 | open Bos 2 | module Result = Bos_setup.R 3 | open Result.Infix 4 | 5 | let is_hidden s = 6 | let len = String.length s in 7 | let rec aux i = 8 | if i > len - 2 then false 9 | else if s.[i] = '_' && s.[i + 1] = '_' then true 10 | else aux (i + 1) 11 | in 12 | aux 0 13 | 14 | let lines_of_channel ic = 15 | let rec inner acc = 16 | try 17 | let l = input_line ic in 18 | inner (l :: acc) 19 | with End_of_file -> List.rev acc 20 | in 21 | inner [] 22 | 23 | let lines_of_process cmd = 24 | match OS.Cmd.(run_out ~err:err_stderr cmd |> to_lines) with 25 | | Ok x -> x 26 | | Error (`Msg e) -> failwith ("Error: " ^ e) 27 | 28 | let run_silent cmd = 29 | match OS.Cmd.(run_out ~err:err_stderr cmd |> to_null) with 30 | | Ok x -> x 31 | | Error (`Msg e) -> failwith ("Error: " ^ e) 32 | 33 | let mkdir_p d = 34 | let segs = 35 | Fpath.segs (Fpath.normalize d) |> List.filter (fun s -> String.length s > 0) 36 | in 37 | let _ = 38 | List.fold_left 39 | (fun path seg -> 40 | let d = Fpath.(path // v seg) in 41 | try 42 | Unix.mkdir (Fpath.to_string d) 0o755; 43 | d 44 | with 45 | | Unix.Unix_error (Unix.EEXIST, _, _) -> d 46 | | exn -> raise exn) 47 | (Fpath.v ".") segs 48 | in 49 | () 50 | 51 | let copy src dst = Bos.OS.File.read src >>= Bos.OS.File.write dst 52 | -------------------------------------------------------------------------------- /src/voodoo/util.mli: -------------------------------------------------------------------------------- 1 | val is_hidden : string -> bool 2 | (** [is_hidden s] returns whether [s] is the name of a hidden module, ie. if it 3 | is generated by [odoc] and contains "__". *) 4 | 5 | val lines_of_channel : in_channel -> string list 6 | (** [lines_of_channel c] returns lines read on channel [c]. *) 7 | 8 | val lines_of_process : Bos.Cmd.t -> string list 9 | (** [lines_of_process p] returns lines read from the output of process [p]. *) 10 | 11 | val run_silent : Bos.Cmd.t -> unit 12 | (** [run_silent c] runs command [c] without displaying the output. *) 13 | 14 | val mkdir_p : Fpath.t -> unit 15 | (** [mkdir_p x] recursively creates directory [x] and its parents. *) 16 | 17 | val copy : Fpath.t -> Fpath.t -> (unit, [> Bos_setup.R.msg ]) Bos_setup.result 18 | (** [copy src dst] copies [src] to [dst]. *) 19 | -------------------------------------------------------------------------------- /src/voodoo/voodoo.ml: -------------------------------------------------------------------------------- 1 | module Opam = Opam 2 | module Sourceinfo = Sourceinfo 3 | module Sourceinfo_index = Sourceinfo_index 4 | module Mld = Mld 5 | module Odoc = Odoc 6 | module Paths = Paths 7 | module Util = Util 8 | module Library_names = Library_names 9 | module Package = Package 10 | module Package_mlds = Package_mlds 11 | module Error_log = Error_log 12 | module Index_mld_page = Index_mld_page 13 | module Package_info = Package_info 14 | module Otherdocs = Otherdocs 15 | -------------------------------------------------------------------------------- /src/voodoo/voodoo.mli: -------------------------------------------------------------------------------- 1 | module Opam = Opam 2 | module Sourceinfo = Sourceinfo 3 | module Sourceinfo_index = Sourceinfo_index 4 | module Mld = Mld 5 | module Odoc = Odoc 6 | module Paths = Paths 7 | module Util = Util 8 | module Library_names = Library_names 9 | module Package = Package 10 | module Package_mlds = Package_mlds 11 | module Error_log = Error_log 12 | module Index_mld_page = Index_mld_page 13 | module Package_info = Package_info 14 | module Otherdocs = Otherdocs 15 | -------------------------------------------------------------------------------- /test/can-read-library-names.t: -------------------------------------------------------------------------------- 1 | Install the package 2 | 3 | $ PKG=can-read-library-names 4 | $ opam install packages/$PKG --yes > /dev/null 5 | 6 | Generate the can-read-library-names documentation 7 | 8 | $ voodoo-prep 9 | Warning: No universes have been specified: will generate dummy universes 10 | 11 | $ voodoo-do -p $PKG -b 2> /dev/null 12 | 13 | $ voodoo-gen -o output 14 | 0 other versions, 1 packages 15 | Found 5 files 16 | 17 | Generates a package.json file with the library names 18 | $ cat output/p/$PKG/1.0/package.json | jq . 19 | { 20 | "libraries": [ 21 | { 22 | "name": "can-read-library-names.singleton", 23 | "modules": [ 24 | { 25 | "name": "Singleton", 26 | "submodules": [], 27 | "kind": "module" 28 | } 29 | ], 30 | "dependencies": [] 31 | }, 32 | { 33 | "name": "can-read-library-names.unwrapped", 34 | "modules": [ 35 | { 36 | "name": "Unwrapped_module2", 37 | "submodules": [], 38 | "kind": "module" 39 | }, 40 | { 41 | "name": "Unwrapped_module1", 42 | "submodules": [], 43 | "kind": "module" 44 | } 45 | ], 46 | "dependencies": [] 47 | }, 48 | { 49 | "name": "can-read-library-names.wrapped", 50 | "modules": [ 51 | { 52 | "name": "Wrapped", 53 | "submodules": [ 54 | { 55 | "name": "Wrapped_module2", 56 | "submodules": [], 57 | "kind": "module" 58 | }, 59 | { 60 | "name": "Wrapped_module1", 61 | "submodules": [], 62 | "kind": "module" 63 | } 64 | ], 65 | "kind": "module" 66 | } 67 | ], 68 | "dependencies": [] 69 | } 70 | ] 71 | } 72 | 73 | Converted the README.org file in HTML 74 | $ cat output/p/$PKG/1.0/README.org.html.json | jq '.content' 75 | cat: output/p/can-read-library-names/1.0/README.org.html.json: No such file or directory 76 | 77 | Uninstall the package 78 | $ opam remove $PKG --yes > /dev/null 79 | -------------------------------------------------------------------------------- /test/can-render-org-files.t: -------------------------------------------------------------------------------- 1 | Install the package 2 | 3 | $ PKG=can-render-org-files 4 | $ opam install packages/$PKG --yes > /dev/null 5 | 6 | Generate the can-render-org-files documentation 7 | 8 | $ voodoo-prep 9 | Warning: No universes have been specified: will generate dummy universes 10 | 11 | $ voodoo-do -p $PKG -b 2> /dev/null 12 | 13 | $ voodoo-gen -o output 14 | 0 other versions, 1 packages 15 | Found 1 files 16 | 17 | Generates a status.json file 18 | $ cat output/p/$PKG/1.0/status.json | jq . 19 | { 20 | "failed": false, 21 | "otherdocs": { 22 | "readme": [ 23 | "linked/p/can-render-org-files/1.0/doc/README.org" 24 | ], 25 | "license": [], 26 | "changes": [], 27 | "others": [ 28 | "linked/p/can-render-org-files/1.0/package.json" 29 | ] 30 | } 31 | } 32 | 33 | Converted the README.org file in HTML 34 | $ cat output/p/$PKG/1.0/README.org.html.json | jq '.content' 35 | "

Title 2

" 36 | 37 | Content of automatically generated Index.mld is fine 38 | $ cat output/p/$PKG/1.0/doc/index.html.json | jq . 39 | { 40 | "type": "documentation", 41 | "uses_katex": false, 42 | "breadcrumbs": [ 43 | { 44 | "name": "p", 45 | "href": "../../../index.html", 46 | "kind": "page" 47 | }, 48 | { 49 | "name": "can-render-org-files", 50 | "href": "../../index.html", 51 | "kind": "page" 52 | }, 53 | { 54 | "name": "1.0", 55 | "href": "../index.html", 56 | "kind": "page" 57 | }, 58 | { 59 | "name": "doc", 60 | "href": "#", 61 | "kind": "page" 62 | } 63 | ], 64 | "toc": [], 65 | "source_anchor": null, 66 | "preamble": "

can-render-org-files 1.0

", 67 | "content": "" 68 | } 69 | 70 | Uninstall the package 71 | $ opam remove $PKG --yes > /dev/null 72 | -------------------------------------------------------------------------------- /test/can-render-tables.t: -------------------------------------------------------------------------------- 1 | Install the package 2 | 3 | $ PKG=can-render-tables 4 | $ opam install packages/$PKG --yes > /dev/null 5 | 6 | Generate the can-render-tables documentation 7 | 8 | $ voodoo-prep 9 | Warning: No universes have been specified: will generate dummy universes 10 | 11 | $ voodoo-do -p $PKG -b 2> /dev/null 12 | 13 | $ voodoo-gen -o output 14 | 0 other versions, 1 packages 15 | Found 1 files 16 | 17 | Generates a status.json file 18 | $ cat output/p/$PKG/1.0/status.json | jq . 19 | { 20 | "failed": false, 21 | "otherdocs": { 22 | "readme": [ 23 | "linked/p/can-render-tables/1.0/doc/README.md" 24 | ], 25 | "license": [], 26 | "changes": [], 27 | "others": [ 28 | "linked/p/can-render-tables/1.0/package.json" 29 | ] 30 | } 31 | } 32 | 33 | Generate a README.md file with the tables formatted in HTML 34 | $ cat output/p/$PKG/1.0/README.md.html.json | jq '.content' 35 | "\n\n\n\n\n\n\n\n\n\n\n
x
y
\n" 36 | 37 | Content of Index.mld is fine 38 | $ cat output/p/$PKG/1.0/doc/index.html.json | jq . 39 | { 40 | "type": "documentation", 41 | "uses_katex": false, 42 | "breadcrumbs": [ 43 | { 44 | "name": "p", 45 | "href": "../../../index.html", 46 | "kind": "page" 47 | }, 48 | { 49 | "name": "can-render-tables", 50 | "href": "../../index.html", 51 | "kind": "page" 52 | }, 53 | { 54 | "name": "1.0", 55 | "href": "../index.html", 56 | "kind": "page" 57 | }, 58 | { 59 | "name": "doc", 60 | "href": "#", 61 | "kind": "page" 62 | } 63 | ], 64 | "toc": [], 65 | "source_anchor": null, 66 | "preamble": "

Title

Text

Here is some text that should show up.

", 67 | "content": "" 68 | } 69 | 70 | Uninstall the package 71 | $ opam remove $PKG --yes > /dev/null 72 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps 3 | %{bin:voodoo-prep} 4 | %{bin:voodoo-do} 5 | %{bin:voodoo-gen} 6 | (source_tree packages)) 7 | (enabled_if 8 | (>= %{ocaml_version} 4.08.0))) 9 | 10 | (data_only_dirs packages) 11 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/can-read-library-names.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "can-read-library-names" 3 | version: "1.0" 4 | synopsis: "Test" 5 | description: "Test" 6 | maintainer: ["me"] 7 | authors: ["me"] 8 | homepage: "http://github.com" 9 | bug-reports: "http://github.com" 10 | depends: [ 11 | "dune" 12 | "odoc" {with-doc} 13 | ] 14 | build: [ 15 | ["dune" "subst"] {dev} 16 | [ 17 | "dune" 18 | "build" 19 | "-p" 20 | name 21 | "-j" 22 | jobs 23 | "@install" 24 | "@runtest" {with-test} 25 | "@doc" {with-doc} 26 | ] 27 | ] 28 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name can-read-library-names) 3 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name wrapped) 3 | (public_name can-read-library-names.wrapped)) 4 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib/wrapped_module1.ml: -------------------------------------------------------------------------------- 1 | let x = "hello" -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib/wrapped_module2.ml: -------------------------------------------------------------------------------- 1 | let x = "hello" -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib2/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name singleton) 3 | (public_name can-read-library-names.singleton)) 4 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib2/singleton.ml: -------------------------------------------------------------------------------- 1 | let x = "hello" -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib3/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name unwrapped) 3 | (wrapped false) 4 | (public_name can-read-library-names.unwrapped)) 5 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib3/unwrapped_module1.ml: -------------------------------------------------------------------------------- 1 | let y = "hello" -------------------------------------------------------------------------------- /test/packages/can-read-library-names/lib3/unwrapped_module2.ml: -------------------------------------------------------------------------------- 1 | let y = "hello" -------------------------------------------------------------------------------- /test/packages/can-read-library-names/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_test_project)) 3 | -------------------------------------------------------------------------------- /test/packages/can-read-library-names/test/test_test_project.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-doc/voodoo/dc54397f66abf95c964ea4de0f3a0ff2aec56efe/test/packages/can-read-library-names/test/test_test_project.ml -------------------------------------------------------------------------------- /test/packages/can-render-org-files/README.org: -------------------------------------------------------------------------------- 1 | * Title 1 2 | ** Title 2 3 | -------------------------------------------------------------------------------- /test/packages/can-render-org-files/can-render-org-files.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "can-render-org-files" 3 | version: "1.0" 4 | synopsis: "Test" 5 | description: "Test" 6 | maintainer: ["me"] 7 | authors: ["me"] 8 | homepage: "http://github.com" 9 | bug-reports: "http://github.com" 10 | depends: [ 11 | "dune" 12 | "odoc" {with-doc} 13 | ] 14 | build: [ 15 | ["dune" "subst"] {dev} 16 | [ 17 | "dune" 18 | "build" 19 | "-p" 20 | name 21 | "-j" 22 | jobs 23 | "@install" 24 | "@runtest" {with-test} 25 | "@doc" {with-doc} 26 | ] 27 | ] 28 | -------------------------------------------------------------------------------- /test/packages/can-render-org-files/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lib)) 3 | -------------------------------------------------------------------------------- /test/packages/can-render-org-files/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name can-render-org-files) 3 | -------------------------------------------------------------------------------- /test/packages/can-render-org-files/lib.ml: -------------------------------------------------------------------------------- 1 | let f x = x 2 | -------------------------------------------------------------------------------- /test/packages/can-render-org-files/lib.mli: -------------------------------------------------------------------------------- 1 | val f : 'a -> 'a 2 | (** [f x] returns [x]. *) 3 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/README.md: -------------------------------------------------------------------------------- 1 | # pkg 2 | 3 | | x | 4 | |---| 5 | | y | 6 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/can-render-tables.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "can-render-tables" 3 | version: "1.0" 4 | synopsis: "Test" 5 | description: "Test" 6 | maintainer: ["me"] 7 | authors: ["me"] 8 | homepage: "http://github.com" 9 | bug-reports: "http://github.com" 10 | depends: [ 11 | "dune" 12 | "odoc" {with-doc} 13 | ] 14 | build: [ 15 | ["dune" "subst"] {dev} 16 | [ 17 | "dune" 18 | "build" 19 | "-p" 20 | name 21 | "-j" 22 | jobs 23 | "@install" 24 | "@runtest" {with-test} 25 | "@doc" {with-doc} 26 | ] 27 | ] 28 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/doc/dune: -------------------------------------------------------------------------------- 1 | (documentation 2 | (package can-render-tables)) -------------------------------------------------------------------------------- /test/packages/can-render-tables/doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Title} 2 | 3 | Text 4 | 5 | Here is some text that should show up. -------------------------------------------------------------------------------- /test/packages/can-render-tables/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lib)) 3 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name can-render-tables) 3 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/lib.ml: -------------------------------------------------------------------------------- 1 | let f x = x 2 | -------------------------------------------------------------------------------- /test/packages/can-render-tables/lib.mli: -------------------------------------------------------------------------------- 1 | val f : 'a -> 'a 2 | (** [f x] returns [x]. *) 3 | -------------------------------------------------------------------------------- /test/uninstalled_package.t: -------------------------------------------------------------------------------- 1 | Call voodoo-do on an uninstalled package 2 | 3 | $ voodoo-prep 4 | Warning: No universes have been specified: will generate dummy universes 5 | 6 | $ voodoo-do -p doesnt-exist -b 7 | Failed to find package doesnt-exist 8 | [1] 9 | -------------------------------------------------------------------------------- /test/unit/serialize/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name main) 3 | (package voodoo-lib) 4 | (libraries alcotest voodoo-lib.serialize)) 5 | -------------------------------------------------------------------------------- /test/unit/serialize/main.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Alcotest.run "voodoo-serialize" 3 | [ 4 | Test_string.suite; 5 | Test_fpath.suite; 6 | Test_package_info.Kind.suite; 7 | Test_package_info.Module.suite; 8 | Test_package_info.Library.suite; 9 | Test_package_info.suite; 10 | Test_status.Otherdocs.suite; 11 | Test_status.suite; 12 | ] 13 | -------------------------------------------------------------------------------- /test/unit/serialize/test_fpath.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_serialize.Fpath_ 2 | 3 | let path = Alcotest.testable Fpath.pp Fpath.equal 4 | 5 | let test str = 6 | let test_name = Format.sprintf "%S" str in 7 | ( str, 8 | `Quick, 9 | fun () -> 10 | let expected = Fpath.v str in 11 | let got = of_yojson @@ to_yojson @@ Fpath.v str in 12 | Alcotest.(check path) test_name got expected ) 13 | 14 | let inputs = [ "/"; "xx"; "`"; " "; " "; "\""; "//" ] 15 | let suite = ("Fpath", List.map test inputs) 16 | -------------------------------------------------------------------------------- /test/unit/serialize/test_package_info.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_serialize.Package_info 2 | 3 | module Kind = struct 4 | include Kind 5 | 6 | let kind = Alcotest.testable pp equal 7 | 8 | let test k = 9 | let test_name = Format.asprintf "%a" pp k in 10 | ( test_name, 11 | `Quick, 12 | fun () -> 13 | let expected = k in 14 | let got = of_yojson @@ to_yojson @@ k in 15 | Alcotest.(check kind) test_name got expected ) 16 | 17 | let inputs = 18 | [ 19 | `Module; 20 | `Page; 21 | `LeafPage; 22 | `ModuleType; 23 | `Parameter 1; 24 | `Class; 25 | `ClassType; 26 | `File; 27 | ] 28 | 29 | let suite = ("Package_info.Kind", List.map test inputs) 30 | end 31 | 32 | module Module = struct 33 | include Module 34 | 35 | let module_ = Alcotest.testable pp equal 36 | 37 | let test k = 38 | let test_name = Format.asprintf "%a" pp k in 39 | ( test_name, 40 | `Quick, 41 | fun () -> 42 | let expected = k in 43 | let got = of_yojson @@ to_yojson @@ k in 44 | Alcotest.(check module_) test_name got expected ) 45 | 46 | let inputs = 47 | [ 48 | { name = ""; submodules = []; kind = `Module }; 49 | { 50 | name = "foo"; 51 | submodules = [ { name = "bar"; submodules = []; kind = `Class } ]; 52 | kind = `Page; 53 | }; 54 | ] 55 | 56 | let suite = ("Package_info.Module", List.map test inputs) 57 | end 58 | 59 | module Library = struct 60 | include Library 61 | 62 | let library = Alcotest.testable (pp Module.pp) (equal Module.equal) 63 | 64 | let test k = 65 | let test_name = Format.asprintf "%a" (pp Module.pp) k in 66 | ( test_name, 67 | `Quick, 68 | fun () -> 69 | let expected = k in 70 | let got = 71 | of_yojson Module.of_yojson @@ to_yojson Module.to_yojson @@ k 72 | in 73 | Alcotest.(check library) test_name got expected ) 74 | 75 | let inputs = 76 | [ 77 | { name = ""; modules = []; dependencies = [] }; 78 | { name = "foo"; modules = Module.inputs; dependencies = [ "bar" ] }; 79 | ] 80 | 81 | let suite = ("Package_info.Library", List.map test inputs) 82 | end 83 | 84 | let package_info = Alcotest.testable (pp Module.pp) (equal Module.equal) 85 | 86 | let test x = 87 | let test_name = Format.asprintf "%a" (pp Module.pp) x in 88 | ( test_name, 89 | `Quick, 90 | fun () -> 91 | let expected = x in 92 | let got = of_yojson Module.of_yojson @@ to_yojson Module.to_yojson @@ x in 93 | Alcotest.(check package_info) test_name got expected ) 94 | 95 | let inputs = [ { libraries = [] }; { libraries = Library.inputs } ] 96 | let suite = ("Package_info", List.map test inputs) 97 | -------------------------------------------------------------------------------- /test/unit/serialize/test_status.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_serialize.Status 2 | 3 | module Otherdocs = struct 4 | include Otherdocs 5 | 6 | let otherdocs = Alcotest.testable pp equal 7 | 8 | let test k = 9 | let test_name = Format.asprintf "%a" pp k in 10 | ( test_name, 11 | `Quick, 12 | fun () -> 13 | let expected = k in 14 | let got = of_yojson @@ to_yojson @@ k in 15 | Alcotest.(check otherdocs) test_name got expected ) 16 | 17 | let dummy = 18 | { 19 | readme = [ Fpath.v "/a" ]; 20 | license = [ Fpath.v "/b" ]; 21 | changes = [ Fpath.v "/c" ]; 22 | others = [ Fpath.v "/d" ]; 23 | } 24 | 25 | let inputs = [ empty; dummy ] 26 | let suite = ("Status.Otherdocs", List.map test inputs) 27 | end 28 | 29 | let status = Alcotest.testable pp equal 30 | 31 | let test x = 32 | let test_name = Format.asprintf "%a" pp x in 33 | ( test_name, 34 | `Quick, 35 | fun () -> 36 | let expected = x in 37 | let got = of_yojson @@ to_yojson @@ x in 38 | Alcotest.(check status) test_name got expected ) 39 | 40 | let inputs = 41 | [ 42 | { failed = true; otherdocs = Otherdocs.empty }; 43 | { failed = false; otherdocs = Otherdocs.dummy }; 44 | ] 45 | 46 | let suite = ("Status", List.map test inputs) 47 | -------------------------------------------------------------------------------- /test/unit/serialize/test_string.ml: -------------------------------------------------------------------------------- 1 | open Voodoo_serialize.String_ 2 | 3 | let test str = 4 | let test_name = Format.sprintf "%S" str in 5 | ( str, 6 | `Quick, 7 | fun () -> 8 | let expected = str in 9 | let got = of_yojson @@ to_yojson str in 10 | Alcotest.(check string) test_name got expected ) 11 | 12 | let inputs = [ ""; "xx"; "`"; " "; " "; "\"" ] 13 | let suite = ("String", List.map test inputs) 14 | -------------------------------------------------------------------------------- /voodoo-do.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml.org's package documentation generator (compilation step)" 4 | description: 5 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-do runs the compilation step." 6 | maintainer: ["Thibaut Mattio" "Sabine Schmaltz"] 7 | authors: ["Jon Ludlam" "Jules Aguillon" "Lucas Pluvinage"] 8 | license: "ISC" 9 | homepage: "https://github.com/ocaml-doc/voodoo" 10 | bug-reports: "https://github.com/ocaml-doc/voodoo/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "voodoo-lib" 14 | "odoc" {>= "2.4.1"} 15 | "bos" 16 | "astring" 17 | "cmdliner" 18 | "yojson" {>= "1.6.0"} 19 | ] 20 | build: [ 21 | ["dune" "subst"] {dev} 22 | [ 23 | "dune" 24 | "build" 25 | "-p" 26 | name 27 | "-j" 28 | jobs 29 | "@install" 30 | "@runtest" {with-test} 31 | "@doc" {with-doc} 32 | ] 33 | ] 34 | dev-repo: "git+https://github.com/ocaml-doc/voodoo.git" 35 | -------------------------------------------------------------------------------- /voodoo-gen.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml.org's package documentation generator (generation step)" 4 | description: 5 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-gen generates the package documentation." 6 | maintainer: ["Thibaut Mattio" "Sabine Schmaltz"] 7 | authors: ["Jon Ludlam" "Jules Aguillon" "Lucas Pluvinage"] 8 | license: "ISC" 9 | homepage: "https://github.com/ocaml-doc/voodoo" 10 | bug-reports: "https://github.com/ocaml-doc/voodoo/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "omd" {= "2.0.0~alpha3"} 14 | "voodoo-lib" 15 | "odoc" {>= "2.4.1"} 16 | "conf-pandoc" 17 | "astring" 18 | "cmdliner" 19 | "yojson" {>= "1.6.0"} 20 | "bos" 21 | "sexplib" 22 | "fpath" 23 | "conf-jq" {with-test} 24 | ] 25 | build: [ 26 | ["dune" "subst"] {dev} 27 | [ 28 | "dune" 29 | "build" 30 | "-p" 31 | name 32 | "-j" 33 | jobs 34 | "@install" 35 | "@runtest" {with-test} 36 | "@doc" {with-doc} 37 | ] 38 | ] 39 | dev-repo: "git+https://github.com/ocaml-doc/voodoo.git" 40 | -------------------------------------------------------------------------------- /voodoo-lib.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml.org's package documentation generator (library)" 4 | description: 5 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-lib is the base library." 6 | maintainer: ["Thibaut Mattio" "Sabine Schmaltz"] 7 | authors: ["Jon Ludlam" "Jules Aguillon" "Lucas Pluvinage"] 8 | license: "ISC" 9 | homepage: "https://github.com/ocaml-doc/voodoo" 10 | bug-reports: "https://github.com/ocaml-doc/voodoo/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "alcotest" {with-test & >= "0.7.0"} 14 | "bos" 15 | "astring" 16 | "fpath" 17 | "sexplib" 18 | "yojson" {>= "1.6.0"} 19 | "odoc" {with-doc} 20 | ] 21 | build: [ 22 | ["dune" "subst"] {dev} 23 | [ 24 | "dune" 25 | "build" 26 | "-p" 27 | name 28 | "-j" 29 | jobs 30 | "@install" 31 | "@runtest" {with-test} 32 | "@doc" {with-doc} 33 | ] 34 | ] 35 | dev-repo: "git+https://github.com/ocaml-doc/voodoo.git" 36 | -------------------------------------------------------------------------------- /voodoo-prep.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml.org's package documentation generator (preparation step)" 4 | description: 5 | "Voodoo is an odoc driver used to generate OCaml.org's package documentation. voodoo-prep runs the preparation step." 6 | maintainer: ["Thibaut Mattio" "Sabine Schmaltz"] 7 | authors: ["Jon Ludlam" "Jules Aguillon" "Lucas Pluvinage"] 8 | license: "ISC" 9 | homepage: "https://github.com/ocaml-doc/voodoo" 10 | bug-reports: "https://github.com/ocaml-doc/voodoo/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "cmdliner" 14 | "fpath" 15 | "bos" 16 | "opam-format" {>= "2.0.0"} 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "subst"] {dev} 21 | [ 22 | "dune" 23 | "build" 24 | "-p" 25 | name 26 | "-j" 27 | jobs 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ] 33 | dev-repo: "git+https://github.com/ocaml-doc/voodoo.git" 34 | --------------------------------------------------------------------------------