├── .depend ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .merlin ├── .ocamlformat ├── .vscode ├── settings.json └── tasks.json ├── Changes.md ├── LICENSE ├── Makefile ├── Readme.md ├── examples └── example-project │ ├── bsconfig.json │ ├── package-lock.json │ ├── package.json │ ├── src │ ├── B.re │ ├── Embeded.md │ ├── Hello.re │ ├── Json.re │ ├── ModuleWithDocComment.res │ ├── More.re │ ├── More.rei │ ├── Other.re │ ├── Serde.ml │ ├── SomeFile.ml │ ├── TransformHelpers.re │ └── ZZ.res │ └── types.json ├── lib └── README.md ├── package-lock.json ├── package.json ├── src ├── BuildSystem.ml ├── Complete.current ├── EditorSupportCommands.ml ├── Files.ml ├── FindFiles.ml ├── Hover.ml ├── Infix.ml ├── Log.ml ├── MarkdownOfOCamldoc.ml ├── ModuleResolution.ml ├── NewCompletions.ml ├── Packages.ml ├── PartialParser.ml ├── PrepareUtils.ml ├── PrintType.ml ├── ProcessAttributes.ml ├── ProcessCmt.ml ├── ProcessExtra.ml ├── Process_406.ml ├── Process_406.mli ├── Protocol.ml ├── Query.ml ├── References.ml ├── RescriptEditorSupport.ml ├── Shared.ml ├── SharedTypes.ml ├── State.ml ├── TopTypes.ml ├── Uri2.ml ├── Utils.ml └── vendor │ ├── Json.ml │ ├── odoc_parser │ ├── LICENSE.md │ ├── Readme.md │ ├── ast.ml │ ├── comment.ml │ ├── error.ml │ ├── helpers.ml │ ├── lang.ml │ ├── location_.ml │ ├── odoc_lexer.ml │ ├── odoc_lexer.mli │ ├── odoc_lexer.mll │ ├── parse_error.ml │ ├── parser_.ml │ ├── parser_.mli │ ├── paths.ml │ ├── paths.mli │ ├── paths_types.ml │ ├── root.ml │ ├── root.mli │ ├── semantics.ml │ ├── semantics.mli │ ├── syntax.ml │ ├── syntax.mli │ └── token.ml │ ├── omd │ ├── Readme.md │ ├── html_characters.ml │ ├── omd.ml │ ├── omd.mli │ ├── omd_backend.ml │ ├── omd_backend.mli │ ├── omd_html.ml │ ├── omd_lexer.ml │ ├── omd_lexer.mli │ ├── omd_parser.ml │ ├── omd_parser.mli │ ├── omd_representation.ml │ ├── omd_representation.mli │ ├── omd_types.ml │ ├── omd_utils.ml │ ├── omd_utils.mli │ ├── omd_xtxt.ml │ └── omd_xtxt.mli │ └── res_outcome_printer │ ├── res_comment.ml │ ├── res_comment.mli │ ├── res_doc.ml │ ├── res_doc.mli │ ├── res_minibuffer.ml │ ├── res_minibuffer.mli │ ├── res_outcome_printer.ml │ └── res_token.ml ├── test.sh └── tests ├── bsconfig.json ├── package-lock.json ├── package.json └── src ├── Auto.res ├── Complete.res ├── Definition.res ├── Hover.res ├── Jsx.res └── expected ├── Auto.res.txt ├── Complete.res.txt ├── Definition.res.txt ├── Hover.res.txt └── Jsx.res.txt /.depend: -------------------------------------------------------------------------------- 1 | src/BuildSystem.cmx : src/ModuleResolution.cmx src/Log.cmx src/Infix.cmx \ 2 | src/Files.cmx 3 | src/EditorSupportCommands.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \ 4 | src/State.cmx src/SharedTypes.cmx src/Shared.cmx src/References.cmx \ 5 | src/Protocol.cmx src/NewCompletions.cmx src/Hover.cmx src/Files.cmx 6 | src/Files.cmx : 7 | src/FindFiles.cmx : src/Utils.cmx src/SharedTypes.cmx \ 8 | src/ModuleResolution.cmx src/Log.cmx src/vendor/Json.cmx src/Infix.cmx \ 9 | src/Files.cmx src/BuildSystem.cmx 10 | src/Hover.cmx : src/Utils.cmx src/SharedTypes.cmx src/Shared.cmx \ 11 | src/References.cmx src/Query.cmx 12 | src/Infix.cmx : src/Log.cmx src/Files.cmx 13 | src/Log.cmx : 14 | src/MarkdownOfOCamldoc.cmx : src/vendor/odoc_parser/root.cmx \ 15 | src/vendor/odoc_parser/paths.cmx src/vendor/odoc_parser/parser_.cmx \ 16 | src/vendor/omd/omd.cmx src/Log.cmx src/vendor/odoc_parser/location_.cmx \ 17 | src/vendor/odoc_parser/error.cmx src/vendor/odoc_parser/comment.cmx 18 | src/ModuleResolution.cmx : src/Infix.cmx src/Files.cmx 19 | src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \ 20 | src/State.cmx src/SharedTypes.cmx src/Shared.cmx src/Query.cmx \ 21 | src/Protocol.cmx src/PartialParser.cmx src/Log.cmx src/Infix.cmx \ 22 | src/Hover.cmx 23 | src/Packages.cmx : src/Uri2.cmx src/TopTypes.cmx src/SharedTypes.cmx \ 24 | src/Log.cmx src/vendor/Json.cmx src/Infix.cmx src/FindFiles.cmx \ 25 | src/Files.cmx src/BuildSystem.cmx 26 | src/PartialParser.cmx : src/SharedTypes.cmx src/Infix.cmx 27 | src/PrepareUtils.cmx : 28 | src/PrintType.cmx : src/vendor/res_outcome_printer/res_outcome_printer.cmx \ 29 | src/vendor/res_outcome_printer/res_doc.cmx 30 | src/ProcessAttributes.cmx : src/SharedTypes.cmx src/PrepareUtils.cmx 31 | src/ProcessCmt.cmx : src/Utils.cmx src/SharedTypes.cmx \ 32 | src/ProcessAttributes.cmx src/Infix.cmx 33 | src/ProcessExtra.cmx : src/Utils.cmx src/SharedTypes.cmx src/Shared.cmx \ 34 | src/Query.cmx src/ProcessCmt.cmx src/ProcessAttributes.cmx src/Log.cmx 35 | src/Process_406.cmx : src/SharedTypes.cmx src/Shared.cmx \ 36 | src/ProcessExtra.cmx src/ProcessCmt.cmx src/PrintType.cmx \ 37 | src/Process_406.cmi 38 | src/Process_406.cmi : src/Uri2.cmx src/SharedTypes.cmx 39 | src/Protocol.cmx : 40 | src/Query.cmx : src/SharedTypes.cmx src/Log.cmx src/Infix.cmx 41 | src/References.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \ 42 | src/Query.cmx src/Log.cmx src/Infix.cmx 43 | src/RescriptEditorSupport.cmx : src/EditorSupportCommands.cmx 44 | src/Shared.cmx : src/PrintType.cmx src/Files.cmx 45 | src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx \ 46 | src/Infix.cmx 47 | src/State.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \ 48 | src/SharedTypes.cmx src/Process_406.cmx src/Packages.cmx \ 49 | src/vendor/omd/omd.cmx src/MarkdownOfOCamldoc.cmx src/Log.cmx \ 50 | src/Infix.cmx src/FindFiles.cmx src/Files.cmx src/BuildSystem.cmx 51 | src/TopTypes.cmx : src/Uri2.cmx src/SharedTypes.cmx 52 | src/Uri2.cmx : 53 | src/Utils.cmx : src/Protocol.cmx 54 | src/vendor/Json.cmx : 55 | src/vendor/odoc_parser/ast.cmx : src/vendor/odoc_parser/paths.cmx \ 56 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/comment.cmx 57 | src/vendor/odoc_parser/comment.cmx : src/vendor/odoc_parser/paths.cmx \ 58 | src/vendor/odoc_parser/location_.cmx 59 | src/vendor/odoc_parser/error.cmx : src/vendor/odoc_parser/location_.cmx 60 | src/vendor/odoc_parser/helpers.cmx : src/vendor/odoc_parser/paths.cmx 61 | src/vendor/odoc_parser/lang.cmx : src/vendor/odoc_parser/root.cmx \ 62 | src/vendor/odoc_parser/paths.cmx src/vendor/odoc_parser/comment.cmx 63 | src/vendor/odoc_parser/location_.cmx : 64 | src/vendor/odoc_parser/odoc_lexer.cmx : src/vendor/odoc_parser/token.cmx \ 65 | src/vendor/odoc_parser/parse_error.cmx \ 66 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/error.cmx \ 67 | src/vendor/odoc_parser/odoc_lexer.cmi 68 | src/vendor/odoc_parser/odoc_lexer.cmi : src/vendor/odoc_parser/token.cmx \ 69 | src/vendor/odoc_parser/location_.cmx 70 | src/vendor/odoc_parser/parse_error.cmx : \ 71 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/error.cmx 72 | src/vendor/odoc_parser/parser_.cmx : src/vendor/odoc_parser/syntax.cmx \ 73 | src/vendor/odoc_parser/semantics.cmx \ 74 | src/vendor/odoc_parser/odoc_lexer.cmx \ 75 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/error.cmx \ 76 | src/vendor/odoc_parser/ast.cmx src/vendor/odoc_parser/parser_.cmi 77 | src/vendor/odoc_parser/parser_.cmi : src/vendor/odoc_parser/paths.cmi \ 78 | src/vendor/odoc_parser/error.cmx src/vendor/odoc_parser/comment.cmx \ 79 | src/vendor/odoc_parser/ast.cmx 80 | src/vendor/odoc_parser/paths.cmx : src/vendor/odoc_parser/root.cmx \ 81 | src/vendor/odoc_parser/paths_types.cmx src/vendor/odoc_parser/paths.cmi 82 | src/vendor/odoc_parser/paths.cmi : src/vendor/odoc_parser/root.cmi \ 83 | src/vendor/odoc_parser/paths_types.cmx 84 | src/vendor/odoc_parser/paths_types.cmx : src/vendor/odoc_parser/root.cmx 85 | src/vendor/odoc_parser/root.cmx : src/vendor/odoc_parser/root.cmi 86 | src/vendor/odoc_parser/root.cmi : 87 | src/vendor/odoc_parser/semantics.cmx : src/vendor/odoc_parser/token.cmx \ 88 | src/vendor/odoc_parser/paths.cmx src/vendor/odoc_parser/parse_error.cmx \ 89 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/error.cmx \ 90 | src/vendor/odoc_parser/comment.cmx src/vendor/odoc_parser/ast.cmx \ 91 | src/vendor/odoc_parser/semantics.cmi 92 | src/vendor/odoc_parser/semantics.cmi : src/vendor/odoc_parser/paths.cmi \ 93 | src/vendor/odoc_parser/error.cmx src/vendor/odoc_parser/comment.cmx \ 94 | src/vendor/odoc_parser/ast.cmx 95 | src/vendor/odoc_parser/syntax.cmx : src/vendor/odoc_parser/token.cmx \ 96 | src/vendor/odoc_parser/parse_error.cmx \ 97 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/helpers.cmx \ 98 | src/vendor/odoc_parser/error.cmx src/vendor/odoc_parser/comment.cmx \ 99 | src/vendor/odoc_parser/ast.cmx src/vendor/odoc_parser/syntax.cmi 100 | src/vendor/odoc_parser/syntax.cmi : src/vendor/odoc_parser/token.cmx \ 101 | src/vendor/odoc_parser/location_.cmx src/vendor/odoc_parser/error.cmx \ 102 | src/vendor/odoc_parser/ast.cmx 103 | src/vendor/odoc_parser/token.cmx : src/vendor/odoc_parser/comment.cmx 104 | src/vendor/omd/html_characters.cmx : 105 | src/vendor/omd/omd.cmx : src/vendor/omd/omd_representation.cmx \ 106 | src/vendor/omd/omd_parser.cmx src/vendor/omd/omd_lexer.cmx \ 107 | src/vendor/omd/omd_backend.cmx src/vendor/omd/omd.cmi 108 | src/vendor/omd/omd.cmi : src/vendor/omd/omd_representation.cmi 109 | src/vendor/omd/omd_backend.cmx : src/vendor/omd/omd_utils.cmx \ 110 | src/vendor/omd/omd_representation.cmx src/vendor/omd/omd_backend.cmi 111 | src/vendor/omd/omd_backend.cmi : src/vendor/omd/omd_utils.cmi \ 112 | src/vendor/omd/omd_representation.cmi 113 | src/vendor/omd/omd_html.cmx : 114 | src/vendor/omd/omd_lexer.cmx : src/vendor/omd/omd_utils.cmx \ 115 | src/vendor/omd/omd_representation.cmx src/vendor/omd/omd_lexer.cmi 116 | src/vendor/omd/omd_lexer.cmi : src/vendor/omd/omd_representation.cmi 117 | src/vendor/omd/omd_parser.cmx : src/vendor/omd/omd_utils.cmx \ 118 | src/vendor/omd/omd_representation.cmx src/vendor/omd/omd_lexer.cmx \ 119 | src/vendor/omd/omd_backend.cmx src/vendor/omd/omd_parser.cmi 120 | src/vendor/omd/omd_parser.cmi : src/vendor/omd/omd_utils.cmi \ 121 | src/vendor/omd/omd_representation.cmi 122 | src/vendor/omd/omd_representation.cmx : src/vendor/omd/omd_utils.cmx \ 123 | src/vendor/omd/omd_representation.cmi 124 | src/vendor/omd/omd_representation.cmi : 125 | src/vendor/omd/omd_types.cmx : 126 | src/vendor/omd/omd_utils.cmx : src/vendor/omd/omd_utils.cmi 127 | src/vendor/omd/omd_utils.cmi : 128 | src/vendor/omd/omd_xtxt.cmx : src/vendor/omd/omd_xtxt.cmi 129 | src/vendor/omd/omd_xtxt.cmi : 130 | src/vendor/res_outcome_printer/res_comment.cmx : \ 131 | src/vendor/res_outcome_printer/res_comment.cmi 132 | src/vendor/res_outcome_printer/res_comment.cmi : 133 | src/vendor/res_outcome_printer/res_doc.cmx : \ 134 | src/vendor/res_outcome_printer/res_minibuffer.cmx \ 135 | src/vendor/res_outcome_printer/res_doc.cmi 136 | src/vendor/res_outcome_printer/res_doc.cmi : 137 | src/vendor/res_outcome_printer/res_minibuffer.cmx : \ 138 | src/vendor/res_outcome_printer/res_minibuffer.cmi 139 | src/vendor/res_outcome_printer/res_minibuffer.cmi : 140 | src/vendor/res_outcome_printer/res_outcome_printer.cmx : \ 141 | src/vendor/res_outcome_printer/res_token.cmx \ 142 | src/vendor/res_outcome_printer/res_doc.cmx 143 | src/vendor/res_outcome_printer/res_token.cmx : \ 144 | src/vendor/res_outcome_printer/res_comment.cmx 145 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | test: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: [macos-latest, ubuntu-latest, windows-latest] 15 | 16 | runs-on: ${{matrix.os}} 17 | 18 | steps: 19 | - uses: actions/checkout@v2.3.4 20 | 21 | - name: Cache OCaml's opam 22 | uses: actions/cache@v2.1.5 23 | with: 24 | path: ~/.opam 25 | key: ${{matrix.os}}-latest-ocaml-4.06.1 26 | 27 | - name: Use OCaml 28 | uses: avsm/setup-ocaml@v1.1.10 29 | with: 30 | ocaml-version: 4.06.1 31 | 32 | - name: Use Node.js 33 | uses: actions/setup-node@v2.1.5 34 | with: 35 | node-version: 14.4.0 36 | 37 | - run: npm ci 38 | 39 | # These 2 runs (or just the second?) are for when you have opam dependencies. We don't. 40 | # Don't add deps. But if you ever do, un-comment these 41 | # - run: opam pin add rescript-editor-support.dev . --no-action 42 | # - run: opam install . --deps-only --with-doc --with-test 43 | 44 | - run: eval $(opam env) && make test 45 | if: matrix.os != 'windows-latest' 46 | # CI windows running the binary somehow stucks. Not sure why. Disable for now. 47 | - run: "& $env:CYGWIN_ROOT\\bin\\ocaml-env exec -- make" 48 | if: matrix.os == 'windows-latest' 49 | 50 | # Also avoids artifacts upload permission loss: 51 | # https://github.com/actions/upload-artifact/tree/ee69f02b3dfdecd58bb31b4d133da38ba6fe3700#permission-loss 52 | - name: Compress files 53 | run: tar -cvf rescript-editor-support.tar -C lib rescript-editor-support.exe 54 | 55 | - uses: actions/upload-artifact@v2 56 | with: 57 | name: ${{matrix.os}}-rescript-editor-support.exe 58 | path: rescript-editor-support.tar 59 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .merlin 3 | !/.merlin 4 | npm-debug.log 5 | *.install 6 | examples/*/lib 7 | tests/lib 8 | node_modules 9 | *.cmi 10 | *.cmt 11 | *.cmti 12 | *.cmx 13 | *.o 14 | lib/* 15 | !lib/README.md 16 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | B src 2 | B src/vendor 3 | B src/vendor/odoc_parser 4 | B src/vendor/omd 5 | B src/vendor/res_outcome_printer 6 | B ../../.opam/4.06.1/lib/ocaml/compiler-libs/ 7 | 8 | S src 9 | S src/vendor 10 | S src/vendor/odoc_parser 11 | S src/vendor/omd 12 | S src/vendor/res_outcome_printer 13 | S ../../.opam/4.06.1/lib/ocaml/compiler-libs/ 14 | 15 | FLG -w +26+27+32+33+39 16 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | cases-exp-indent = 2 2 | space-around-arrays = false 3 | space-around-lists = false 4 | space-around-records = false 5 | space-around-variants = false 6 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "editor.formatOnSave": false, 3 | "git.ignoreLimitWarning": true, 4 | "git.enabled": true, 5 | "editor.codeLens": true, 6 | "editor.tabSize": 2, 7 | "workbench.settings.editor": "json", 8 | "ocaml.sandbox": { 9 | "kind": "global" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "tasks": [ 4 | ] 5 | } -------------------------------------------------------------------------------- /Changes.md: -------------------------------------------------------------------------------- 1 | # master 2 | - Fix issue in jump-to-definition on Windows. (See https://github.com/rescript-lang/rescript-vscode/issues/98) where the wrong URI was generated. 3 | - Don't show file path on hover. 4 | - Add autocomplete for props in JSX components. 5 | - Autocomplete: fix issue where `->` autocomplete was overruling `.`. See https://github.com/rescript-lang/rescript-editor-support/issues/99. 6 | - Add pipe autocomplete for builtin list, array, string, option types. And for string and array literals. 7 | - Fix hover on labels in component functions with compiler version 9.1, and labels with type annotation. 8 | 9 | ## Release 1.0.6 of rescript-vscode 10 | This [commit](https://github.com/rescript-lang/rescript-editor-support/commit/03ee0d97b250474028d4fb08eac81ddb21ccb082) is vendored in [rescript-vscode 1.0.6](https://github.com/rescript-lang/rescript-vscode/releases/tag/1.0.6). 11 | 12 | #### New features 13 | - Add support for autocomplete for pipe-first `foo->`: the type of `foo` is used to determine the module to take completions from. 14 | - Add support for autocomplete for decorators such as `@module` and `@val`. 15 | - Add support for autocomplete of labelled arguments `foo(~label... )`. 16 | - Add support for @deprecated attributes in autocomplete. 17 | - Support for upcoming `rescript` npm package for the compiler. Looks for `rescript` in addition to `bs-platform` in `node_modules`. 18 | 19 | #### Fixes 20 | 21 | - Fix issue for uncurried functions where the internal definition of `Js.Fn.arity` is shown on hover. (See https://github.com/rescript-lang/rescript-editor-support/issues/62). 22 | - Fix type hint when hovering over labeled arguments of components (See https://github.com/rescript-lang/rescript-editor-support/issues/63). 23 | - Fix issue where values declared with type annotation would not show up in autocomplete, and would show no doc comment on hover. (See https://github.com/rescript-lang/rescript-vscode/issues/72). 24 | - Fix hover on definitions inside a react component module, or whenever multiple definitins for the same value exist in the module (See https://github.com/rescript-lang/rescript-editor-support/issues/67). 25 | - Fix autocomplete issue where multiple open's were considered in the wrong priority order (See https://github.com/rescript-lang/rescript-editor-support/issues/72). 26 | - Autocomplete: add support for `open!` in addition to `open`. 27 | 28 | ## Release 1.0.5 of rescript-vscode 29 | This [commit](https://github.com/rescript-lang/rescript-editor-support/commit/6bdd10f6af259edc5f9cbe5b9df06836de3ab865) is vendored in [rescript-vscode 1.0.5](https://github.com/rescript-lang/rescript-vscode/releases/tag/1.0.5). 30 | 31 | - Add support for doc strings when hovering on modules. 32 | - Add support for printing uncurried function types in hover. 33 | - Fix autocomplete issue where `open Foo` would be picked up inside line comments (see https://github.com/rescript-lang/rescript-editor-support/issues/15). 34 | - Don't print parens as in `A()` for 0-ary variants. 35 | - Fix infinite loop in autocomplete that can cause `rescript-editor-support.exe` processes to use up 100% cpu. 36 | - Fix jump to type definition for types defined in an inner module. 37 | 38 | ## Release 1.0.3 of rescript-vscode 39 | This [commit](https://github.com/rescript-lang/rescript-editor-support/commit/214d220d8573f9f0c8d54e623c163e01617bf124) is vendored in [rescript-vscode 1.0.3](https://github.com/rescript-lang/rescript-vscode/releases/tag/1.0.3). 40 | 41 | - Fix type shown when hovering on record fields (see https://github.com/rescript-lang/rescript-vscode/issues/52), and doc comments for records. 42 | - Fix issue where type variables are printed with global renaming when hovering or autocompleting a module (see https://github.com/rescript-lang/rescript-editor-support/issues/38). 43 | - Fix issue where a log file was always created (see https://github.com/rescript-lang/rescript-vscode/issues/47). 44 | - Add support for hover on the id of toplevel module definitions (```module Id = ...```). 45 | 46 | ## Release 1.0.1 of rescript-vscode 47 | This [commit](https://github.com/rescript-lang/rescript-editor-support/commit/232ad609766c415048750c5cc828973a9995f382) is vendored in [rescript-vscode 1.0.1](https://github.com/rescript-lang/rescript-vscode/releases/tag/1.0.1). 48 | 49 | - Support printing inline records. 50 | - Add typedef hover support. 51 | - Always output valid json, even in case of internal error. 52 | - Remove semicolon in module top level preview. 53 | - Support syntax highlight in hover fenced blocks. 54 | - Fix printing of variant arguments. 55 | - Use outcome printer from the syntax to print type declarations. 56 | - Fix issue in command-line parsing on Windows with paths of the form `c:/...:line:column`. 57 | 58 | ## Release 1.0.0 of rescript-vscode 59 | This [commit](https://github.com/rescript-lang/rescript-editor-support/commit/d45f45793a307a3bb87dcac0542fd412669f1b6e) is vendored in [rescript-vscode 1.0.0](https://github.com/rescript-lang/rescript-vscode/releases/tag/1.0.0). 60 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) ReScript 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SHELL = /bin/bash 2 | MAKEFLAGS += --jobs 4 3 | INCLUDES = -I src -I src/vendor/odoc_parser -I src/vendor/omd -I src/vendor/res_outcome_printer -I src/vendor 4 | 5 | OCAMLOPT = ocamlopt.opt 6 | OCAMLFLAGS = -g -w +26+27+32+33+39 -bin-annot -I +compiler-libs $(INCLUDES) 7 | OCAMLDEP = ocamldep.opt 8 | 9 | %.cmi : %.mli 10 | @echo Building $@ 11 | @$(OCAMLOPT) $(OCAMLFLAGS) -c $< 12 | %.cmx : %.ml 13 | @echo Building $@ 14 | @$(OCAMLOPT) $(OCAMLFLAGS) -c $< 15 | 16 | include .depend 17 | depend: 18 | @$(OCAMLDEP) -native $(INCLUDES) `find src -name "*.ml" -o -name "*.mli"` > .depend 19 | 20 | SOURCE_FILES = $(shell $(OCAMLDEP) -sort `find src -name "*.ml"` | sed -E "s/\.ml/.cmx/g") 21 | 22 | lib/rescript-editor-support.exe: $(SOURCE_FILES) 23 | @echo Linking... 24 | @$(OCAMLOPT) $(OCAMLFLAGS) -O2 -o ./lib/rescript-editor-support.exe \ 25 | -I +compiler-libs unix.cmxa str.cmxa ocamlcommon.cmxa $(INCLUDES) $(SOURCE_FILES) 26 | @echo Done! 27 | 28 | build-native: lib/rescript-editor-support.exe depend 29 | 30 | dce: build-native 31 | node_modules/.bin/reanalyze -dce-cmt src -suppress src/vendor 32 | 33 | tests/node_modules/.bin/rescript: 34 | @cd tests && npm install 35 | 36 | tests/lib/.compiler.log: tests/node_modules/.bin/rescript 37 | @cd tests && node_modules/.bin/rescript build -with-deps 38 | 39 | test: dce tests/lib/.compiler.log 40 | ./test.sh 41 | 42 | clean: 43 | git clean -dfx src 44 | 45 | .DEFAULT_GOAL := build-native 46 | 47 | .PHONY: depend clean build-native dce test 48 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # Rescript Editor Support 2 | 3 | **Archived. This repo is now fused with [rescript-vscode](https://github.com/rescript-lang/rescript-vscode/)**. 4 | 5 | This is a private command line binary used by [rescript-vscode](https://github.com/rescript-lang/rescript-vscode) to power a few functionalities such as jump to definition, hover and autocomplete. 6 | 7 | The binary reads the `.cmt` and `.cmti` files and analyses them. 8 | 9 | ## Install 10 | 11 | ``` 12 | opam switch 4.06.1 13 | ``` 14 | 15 | ## Build 16 | 17 | ``` 18 | make 19 | ``` 20 | 21 | The built artifact is in `lib/rescript-editor-support.exe` 22 | 23 | ## Test 24 | 25 | ``` 26 | make test 27 | ``` 28 | 29 | ## Usage 30 | 31 | Run: 32 | 33 | ```sh 34 | lib/rescript-editor-support.exe --help 35 | ``` 36 | 37 | ## History 38 | 39 | This project is based on a fork of [Reason Language Server](https://github.com/jaredly/reason-language-server). 40 | 41 | Distributed under the MIT License (see [LICENSE](./LICENSE)). 42 | -------------------------------------------------------------------------------- /examples/example-project/bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "tryit", 3 | "sources": "src", 4 | "bsc-flags": ["-bs-super-errors", "-open Belt"], 5 | "warnings": { 6 | "number": "-32-26-27-33" 7 | }, 8 | "bs-dependencies": ["reason-react"], 9 | "reason": { "react-jsx": 3 }, 10 | "namespace": "try-it", 11 | "refmt": 3 12 | } -------------------------------------------------------------------------------- /examples/example-project/package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "example-project", 3 | "lockfileVersion": 2, 4 | "requires": true, 5 | "packages": { 6 | "": { 7 | "dependencies": { 8 | "bs-platform": "9.0.2", 9 | "reason-react": "^0.9.1" 10 | } 11 | }, 12 | "node_modules/bs-platform": { 13 | "version": "9.0.2", 14 | "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-9.0.2.tgz", 15 | "integrity": "sha512-Ye9JqJ4Oa7mcjjoOVRYI8Uc2Cf8N7jQLWDcdUplY7996d/YErSR7WitmV7XnSwr4EvdrbwjEsg1NxNjUQv3ChA==", 16 | "hasInstallScript": true, 17 | "bin": { 18 | "bsb": "bsb", 19 | "bsc": "bsc", 20 | "bsrefmt": "bsrefmt", 21 | "bstracing": "lib/bstracing" 22 | } 23 | }, 24 | "node_modules/reason-react": { 25 | "version": "0.9.1", 26 | "resolved": "https://registry.npmjs.org/reason-react/-/reason-react-0.9.1.tgz", 27 | "integrity": "sha512-nlH0O2TDy9KzOLOW+vlEQk4ExHOeciyzFdoLcsmmiit6hx6H5+CVDrwJ+8aiaLT/kqK5xFOjy4PS7PftWz4plA==" 28 | } 29 | }, 30 | "dependencies": { 31 | "bs-platform": { 32 | "version": "9.0.2", 33 | "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-9.0.2.tgz", 34 | "integrity": "sha512-Ye9JqJ4Oa7mcjjoOVRYI8Uc2Cf8N7jQLWDcdUplY7996d/YErSR7WitmV7XnSwr4EvdrbwjEsg1NxNjUQv3ChA==" 35 | }, 36 | "reason-react": { 37 | "version": "0.9.1", 38 | "resolved": "https://registry.npmjs.org/reason-react/-/reason-react-0.9.1.tgz", 39 | "integrity": "sha512-nlH0O2TDy9KzOLOW+vlEQk4ExHOeciyzFdoLcsmmiit6hx6H5+CVDrwJ+8aiaLT/kqK5xFOjy4PS7PftWz4plA==" 40 | } 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /examples/example-project/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "bs-platform": "9.0.2", 4 | "reason-react": "^0.9.1" 5 | }, 6 | "scripts": { 7 | "build": "bsb -make-world", 8 | "start": "bsb -make-world -w", 9 | "clean": "bsb -clean" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /examples/example-project/src/B.re: -------------------------------------------------------------------------------- 1 | 2 | 3 | let x = 12 4 | 5 | 6 | let y = 44 7 | 8 | 9 | let z = 123 10 | -------------------------------------------------------------------------------- /examples/example-project/src/Embeded.md: -------------------------------------------------------------------------------- 1 | # Markdown Embedded Fenced Code Regression Test 2 | 3 | ```re 4 | module Something = { 5 | open Other; 6 | 7 | let m = {name: "Me", age: 0}; 8 | let animal = Things(10); 9 | let other = Things(2); 10 | let me: animals = People("Hie"); 11 | let x = something + 10; 12 | let r = m.name; 13 | 14 | let awesome = 20; 15 | if (true) { 16 | () 17 | } 18 | }; 19 | ``` 20 | 21 | ```reason 22 | module Something = { 23 | open Other; 24 | 25 | let m = {name: "Me", age: 0}; 26 | let animal = Things(10); 27 | let other = Things(2); 28 | let me: animals = People("Hie"); 29 | let x = something + 10; 30 | let r = m.name; 31 | 32 | let awesome = 20; 33 | if (true) { 34 | () 35 | } 36 | }; 37 | ``` 38 | 39 | ```reasonml 40 | module Something = { 41 | open Other; 42 | 43 | let m = {name: "Me", age: 0}; 44 | let animal = Things(10); 45 | let other = Things(2); 46 | let me: animals = People("Hie"); 47 | let x = something + 10; 48 | let r = m.name; 49 | 50 | let awesome = 20; 51 | if (true) { 52 | () 53 | } 54 | }; 55 | ``` -------------------------------------------------------------------------------- /examples/example-project/src/Hello.re: -------------------------------------------------------------------------------- 1 | let someLongName = 10; 2 | 3 | let otherLongName = "string"; 4 | 5 | let x = [%bs.obj {a: 3}]; 6 | 7 | let r = Other.something; 8 | 9 | let l = More.inner + More.n + Other.inner; 10 | 11 | let n = More.n; 12 | 13 | let _ = More.party; 14 | let _ = string_of_bool; 15 | 16 | /* let m = {More.a: 2, b: 32.}; */ 17 | 18 | module Something = { 19 | open Other; 20 | 21 | let m = {name: "Me", age: 0}; 22 | let animal = Things(10); 23 | let other = Things(2); 24 | let me: animals = People("Hie"); 25 | let x = something + 10; 26 | let r = m.name; 27 | 28 | let awesome = 20; 29 | if (true) { 30 | () 31 | } 32 | }; 33 | 34 | open! Something; 35 | 36 | let y = x + 10; 37 | 38 | switch me { 39 | | Things(n) => () 40 | | _ => () 41 | }; 42 | 43 | 44 | let z = x * x; 45 | 46 | let aThing = 10 + Other.something; 47 | 48 | /** Some docs about this **awesome** thing. */ 49 | let awesome = 100 + m.age; 50 | 51 | let thing = "thing"; 52 | 53 | let transform = (x, y) => x ++ Js.Float.toString(y); 54 | 55 | let z = transform("hello ", 5.); 56 | 57 | let zzz = 1; 58 | 59 | let more = 20; 60 | 61 | /** Something here */ 62 | let added = 10 + awesome; 63 | 64 | open Other; 65 | 66 | open Hashtbl; 67 | 68 | /** Some more documentation about this */ 69 | let awesome = x => x + 2; 70 | 71 | let a = [ 72 | "hello", 73 | "my fine" ++ "folks", 74 | "in boonville" 75 | ]; 76 | 77 | let div = (~x, ~y, ~children, ()) => 10; 78 | 79 | let m =
; 83 | 84 | let something = animal => switch animal { 85 | | blank => () 86 | }; 87 | 88 | something(animal); 89 | 90 | let someFunction = (memorableName, {contents}) => { 91 | let innerMemorable = 20; 92 | memorableName + innerMemorable; 93 | }; 94 | 95 | /* let awesome = 10000; */ 96 | 97 | /* let awesome = 111; */ 98 | 99 | let z = 10; 100 | 101 | let z = find; 102 | 103 | let z = later; 104 | 105 | let m = Other.later; 106 | 107 | for (_index in 0 to 10) { 108 | print_endline("hellO"); 109 | }; 110 | 111 | module OneOneOneOne = { 112 | module TwoTwoTwoTwo = { 113 | let xxxxxxxxxx = 10; 114 | }; 115 | }; 116 | let r = OneOneOneOne.TwoTwoTwoTwo.xxxxxxxxxx; 117 | 118 | type awesome = { 119 | one: string, 120 | two: float, 121 | }; 122 | 123 | open OneOneOneOne.TwoTwoTwoTwo; 124 | 125 | include OneOneOneOne.TwoTwoTwoTwo; 126 | 127 | include More; 128 | 129 | let _ = Other.oo.person.name; 130 | 131 | type lots = 132 | | Parties 133 | | Plutocrats(int, float) 134 | | Possums 135 | | Oppossums; 136 | 137 | let y = Some(10 + awesome(3)); 138 | 139 | let z = {contents: 30}; 140 | let party = {one: "one", two: 2.}; 141 | 142 | let {one, two} = party; 143 | 144 | let thing = () => { 145 | 34 + 43; 146 | }; 147 | 148 | type more = awesome; 149 | 150 | let {contents} = z; 151 | 152 | switch (y) { 153 | | Some(u) => () 154 | | None => () 155 | }; 156 | 157 | /* let x = [%raw " hello"]; */ 158 | 159 | let awesome = "hello"; 160 | 161 | 162 | type shortReference = (string, list(string), string); 163 | 164 | type reference = { 165 | uri: string, 166 | moduleName: string, 167 | modulePath: list(string), 168 | name: string, 169 | }; 170 | 171 | type typeSource = 172 | | Builtin(string) 173 | | Public(reference) 174 | | NotFound; 175 | 176 | type lockfile = { 177 | version: int, 178 | pastVersions: Belt.HashMap.Int.t( 179 | list(( 180 | shortReference, 181 | int 182 | )) 183 | ), 184 | current: list(( 185 | shortReference, 186 | int 187 | )) 188 | }; -------------------------------------------------------------------------------- /examples/example-project/src/ModuleWithDocComment.res: -------------------------------------------------------------------------------- 1 | @@ocaml.doc("This comment is for the **toplevel** module.") 2 | 3 | @ocaml.doc("This comment is for the first **nested** module.") 4 | module Nested = { 5 | let x = "123" 6 | 7 | @ocaml.doc("This comment is for the inner **nested-again** module.") 8 | module NestedAgain = { 9 | let y = 123 10 | } 11 | } 12 | 13 | module M = Nested.NestedAgain 14 | -------------------------------------------------------------------------------- /examples/example-project/src/More.re: -------------------------------------------------------------------------------- 1 | /** Toplevel docs */; 2 | 3 | /** Some contents */ 4 | let contnets = "here"; 5 | 6 | let inner = 20; 7 | 8 | let n = 10; 9 | 10 | let party = 30; 11 | 12 | let awesome = 200; -------------------------------------------------------------------------------- /examples/example-project/src/More.rei: -------------------------------------------------------------------------------- 1 | 2 | let contnets: string; 3 | let inner: int; 4 | let n: int; 5 | let party: int -------------------------------------------------------------------------------- /examples/example-project/src/Other.re: -------------------------------------------------------------------------------- 1 | 2 | /* let later = 10; */ 3 | 4 | /* Ok testing things */ 5 | 6 | let something = 10; 7 | 8 | type person = {name: string, age: int}; 9 | 10 | type animals = Things(int) | People(string) | Mouse; 11 | 12 | let inner = 10; 13 | /* More.outer; */ 14 | 15 | 16 | let m = Things(1); 17 | 18 | /* working on things. */ 19 | 20 | 21 | let z = {name: "hi", age: 20}; 22 | 23 | let later = 20; 24 | 25 | let concat = (~first, ~second) => first + second; 26 | 27 | type other = {person, height: float}; 28 | let oo = {person: z, height: 34.2}; 29 | 30 | let show = o => { 31 | let m = o.height; 32 | }; 33 | -------------------------------------------------------------------------------- /examples/example-project/src/SomeFile.ml: -------------------------------------------------------------------------------- 1 | let x = 10 2 | 3 | let y = 20 4 | 5 | let m x y = 6 | let z = x + y in 7 | z 8 | -------------------------------------------------------------------------------- /examples/example-project/src/TransformHelpers.re: -------------------------------------------------------------------------------- 1 | 2 | let deserialize_Belt__HashMapInt__t = (transformer, t) => { 3 | assert(false) 4 | }; 5 | 6 | let deserialize_Belt_HashMapInt____t = (a, b) => assert(false); 7 | 8 | let deserialize_Belt__HashMap__Int__t = (a, b) => assert(false); 9 | 10 | let serialize_Belt_HashMapInt____t = (a, b) => assert(false); 11 | 12 | let serialize_Belt__HashMap__Int__t = (a, b) => assert(false); 13 | 14 | let serialize_Belt_HashMapInt____t = (transformer, t) => { 15 | assert(false) 16 | }; 17 | -------------------------------------------------------------------------------- /examples/example-project/src/ZZ.res: -------------------------------------------------------------------------------- 1 | let a = 12 2 | 3 | let b = [1, 2, 3, a] 4 | 5 | let c =
6 | 7 | let s = React.string 8 | 9 | module M = { 10 | @react.component 11 | let make = (~x) => React.string(x) 12 | } 13 | 14 | let d = 15 | 16 | module J = { 17 | @react.component 18 | export make = (~children: React.element) => React.null 19 | } 20 | 21 | let z = {React.string("")} {React.string("")} 22 | 23 | type inline = 24 | | A({x: int, y: string}) 25 | | B({x: int, y: string}) 26 | | C({ 27 | x: int, 28 | y: string, 29 | z: string, 30 | w: string, 31 | x0: string, 32 | q1: string, 33 | q2: string, 34 | q3: string, 35 | q4: string, 36 | }) 37 | | D({x: int, y: string}) 38 | | E({x: int, y: string}) 39 | | F 40 | 41 | module MSig: { 42 | type rec t = A(list) 43 | and s = list 44 | 45 | let x: int 46 | } = { 47 | type rec t = A(list) 48 | and s = list 49 | 50 | let x = 14 51 | } 52 | 53 | module Impl = { 54 | type rec t = A(list) 55 | and s = list 56 | 57 | type w = int 58 | 59 | let x = 14 60 | } 61 | 62 | module Impl2 = { 63 | include Impl 64 | } 65 | 66 | module D = MSig 67 | module E = Impl 68 | module F = Impl2 69 | 70 | @ocaml.doc("str docstring") 71 | type str = string 72 | 73 | @ocaml.doc("gr docstring") 74 | type gr = {x: int, s: str} 75 | 76 | let testRecordFields = (gr: gr) => { 77 | let str = gr.s 78 | str 79 | } 80 | 81 | @ocaml.doc("vr docstring") 82 | type vr = V1 | V2 83 | 84 | let v1 = V1 85 | 86 | module DoubleNested = ModuleWithDocComment.Nested.NestedAgain 87 | 88 | let uncurried = (. x) => x + 1 89 | 90 | module Inner = { 91 | type tInner = int 92 | let vInner = 34 93 | } 94 | 95 | type typeInner = Inner.tInner 96 | 97 | let valueInner = Inner.vInner 98 | 99 | @ocaml.doc("Doc comment for functionWithTypeAnnotation") 100 | let functionWithTypeAnnotation: unit => int = () => 1 101 | 102 | module HoverInsideModuleWithComponent = { 103 | let x = 2 // check that hover on x works 104 | 105 | @react.component 106 | let make = () => React.null 107 | } 108 | 109 | module Lib = { 110 | let foo = (~age, ~name) => name ++ string_of_int(age) 111 | let next = (~number=0, ~year) => number + year 112 | } 113 | 114 | @ocaml.doc("This module is commented") @deprecated("This module is deprecated") 115 | module Dep: { 116 | @ocaml.doc("Some doc comment") @deprecated("Use customDouble instead") 117 | let customDouble: int => int 118 | 119 | let customDouble2: int => int 120 | } = { 121 | let customDouble = foo => foo * 2 122 | let customDouble2 = foo => foo * 2 123 | } 124 | 125 | let cc = Dep.customDouble(11) 126 | 127 | module O = { 128 | module Comp = { 129 | @react.component 130 | let make = (~first="", ~kas=11, ~foo=3, ~second, ~v) => 131 | React.string(first ++ second ++ string_of_int(foo)) 132 | } 133 | } 134 | 135 | let comp = 136 | 137 | let lll = List.make(3, 4) 138 | 139 | let abc = "abc" 140 | 141 | let arr = [1, 2, 3] 142 | 143 | let some7 = Some(7) 144 | 145 | 146 | -------------------------------------------------------------------------------- /examples/example-project/types.json: -------------------------------------------------------------------------------- 1 | { 2 | "output": "src/Serde.ml", 3 | "engine": "rex-json", 4 | "entries": [ 5 | { 6 | "file": "src/Hello.re", 7 | "type": "lockfile" 8 | } 9 | ], 10 | "custom": [ 11 | {"module": "Belt_HashMapInt", "path": [], "name": "t", "args": 1} 12 | ] 13 | } -------------------------------------------------------------------------------- /lib/README.md: -------------------------------------------------------------------------------- 1 | We store a few dev-time binaries here. 2 | -------------------------------------------------------------------------------- /package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "rescript-editor-support", 3 | "version": "1.0.0", 4 | "lockfileVersion": 2, 5 | "requires": true, 6 | "packages": { 7 | "": { 8 | "version": "1.0.0", 9 | "license": "MIT", 10 | "devDependencies": { 11 | "reanalyze": "^2.15.0" 12 | } 13 | }, 14 | "node_modules/reanalyze": { 15 | "version": "2.15.0", 16 | "resolved": "https://registry.npmjs.org/reanalyze/-/reanalyze-2.15.0.tgz", 17 | "integrity": "sha512-FUN/pqgTKs5i+kzi9Mje5deahZHKniOQDyig5UseozDiK81eW77A4iRyN+3UsnontG6K6mAdUcXCU9NpEqZFug==", 18 | "dev": true, 19 | "hasInstallScript": true, 20 | "bin": { 21 | "reanalyze": "reanalyze.exe" 22 | } 23 | } 24 | }, 25 | "dependencies": { 26 | "reanalyze": { 27 | "version": "2.15.0", 28 | "resolved": "https://registry.npmjs.org/reanalyze/-/reanalyze-2.15.0.tgz", 29 | "integrity": "sha512-FUN/pqgTKs5i+kzi9Mje5deahZHKniOQDyig5UseozDiK81eW77A4iRyN+3UsnontG6K6mAdUcXCU9NpEqZFug==", 30 | "dev": true 31 | } 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "rescript-editor-support", 3 | "version": "1.0.0", 4 | "keywords": [ 5 | "rescript", 6 | "lsp", 7 | "ide" 8 | ], 9 | "private": true, 10 | "repository": { 11 | "url": "https://github.com/rescript-lang/rescript-editor-support", 12 | "type": "git" 13 | }, 14 | "description": "Core editor analysis for ReScript's editor plugins", 15 | "author": "Cristiano Calcagno", 16 | "license": "MIT", 17 | "devDependencies": { 18 | "reanalyze": "^2.15.0" 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /src/BuildSystem.ml: -------------------------------------------------------------------------------- 1 | let namespacedName namespace name = 2 | match namespace with 3 | | None -> name 4 | | Some namespace -> name ^ "-" ^ namespace 5 | 6 | open Infix 7 | 8 | let getBsPlatformDir rootPath = 9 | let result = 10 | ModuleResolution.resolveNodeModulePath ~startPath:rootPath "bs-platform" 11 | in 12 | let result = 13 | if result = None then 14 | ModuleResolution.resolveNodeModulePath ~startPath:rootPath "rescript" 15 | else result 16 | in 17 | match result with 18 | | Some path -> Ok path 19 | | None -> 20 | let message = "bs-platform could not be found" in 21 | Log.log message; 22 | Error message 23 | 24 | let getCompiledBase root = Files.ifExists (root /+ "lib" /+ "bs") 25 | 26 | let getStdlib base = 27 | match getBsPlatformDir base with 28 | | Error e -> Error e 29 | | Ok bsPlatformDir -> Ok (bsPlatformDir /+ "lib" /+ "ocaml") 30 | -------------------------------------------------------------------------------- /src/Complete.current: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rescript-lang/rescript-editor-support/093d67e9514108a1c4c1ea722ad2b280e92443d6/src/Complete.current -------------------------------------------------------------------------------- /src/EditorSupportCommands.ml: -------------------------------------------------------------------------------- 1 | let dumpLocations state ~package ~file ~extra = 2 | let locations = 3 | extra.SharedTypes.locations 4 | |> List.filter (fun (l, _) -> not l.Location.loc_ghost) 5 | in 6 | locations 7 | |> List.map (fun ((location : Location.t), loc) -> 8 | let hoverText = 9 | Hover.newHover ~file 10 | ~getModule:(State.fileForModule state ~package) 11 | loc 12 | in 13 | let hover = 14 | match hoverText with None -> "" | Some s -> String.escaped s 15 | in 16 | let uriLocOpt = 17 | References.definitionForLoc ~pathsForModule:package.pathsForModule 18 | ~file ~getUri:(State.fileForUri state) 19 | ~getModule:(State.fileForModule state ~package) 20 | loc 21 | in 22 | let def = 23 | match uriLocOpt with 24 | | None -> Protocol.null 25 | | Some (uri2, loc) -> 26 | Protocol.stringifyLocation 27 | {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc} 28 | in 29 | Protocol.stringifyRange (Utils.cmtLocToRange location) 30 | ^ "\n Hover: " ^ hover ^ "\n Definition: " ^ def) 31 | |> String.concat "\n\n" 32 | 33 | let dump files = 34 | Shared.cacheTypeToString := true; 35 | let state = TopTypes.empty () in 36 | files 37 | |> List.iter (fun path -> 38 | let filePath = Files.maybeConcat (Unix.getcwd ()) path in 39 | let uri = Uri2.fromPath filePath in 40 | let result = 41 | match State.getFullFromCmt ~state ~uri with 42 | | Error message -> 43 | prerr_endline message; 44 | "[]" 45 | | Ok (package, {file; extra}) -> 46 | dumpLocations state ~package ~file ~extra 47 | in 48 | print_endline result) 49 | 50 | let complete ~path ~line ~col ~currentFile = 51 | let state = TopTypes.empty () in 52 | let filePath = Files.maybeConcat (Unix.getcwd ()) path in 53 | let uri = Uri2.fromPath filePath in 54 | let result = 55 | match State.getFullFromCmt ~state ~uri with 56 | | Error message -> 57 | prerr_endline message; 58 | "[]" 59 | | Ok (package, full) -> 60 | let maybeText = Files.readFile currentFile in 61 | NewCompletions.computeCompletions ~full ~maybeText ~package 62 | ~pos:(line, col) ~state 63 | |> List.map Protocol.stringifyCompletionItem 64 | |> Protocol.array 65 | in 66 | print_endline result 67 | 68 | let hover state ~file ~line ~col ~extra ~package = 69 | let open TopTypes in 70 | let locations = 71 | extra.SharedTypes.locations 72 | |> List.filter (fun (l, _) -> not l.Location.loc_ghost) 73 | in 74 | let pos = Utils.protocolLineColToCmtLoc ~line ~col in 75 | match References.locForPos ~extra:{extra with locations} pos with 76 | | None -> Protocol.null 77 | | Some (_, loc) -> ( 78 | let locIsModule = 79 | match loc with 80 | | SharedTypes.LModule _ | TopLevelModule _ -> true 81 | | TypeDefinition _ | Typed _ | Constant _ | Explanation _ -> false 82 | in 83 | let uriLocOpt = 84 | References.definitionForLoc ~pathsForModule:package.pathsForModule ~file 85 | ~getUri:(State.fileForUri state) 86 | ~getModule:(State.fileForModule state ~package) 87 | loc 88 | in 89 | let skipZero = 90 | match uriLocOpt with 91 | | None -> false 92 | | Some (_, loc) -> 93 | let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} = 94 | pos_lnum = 1 && pos_cnum - pos_bol = 0 95 | in 96 | (* Skip if range is all zero, unless it's a module *) 97 | (not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end 98 | in 99 | if skipZero then Protocol.null 100 | else 101 | let hoverText = 102 | Hover.newHover ~file ~getModule:(State.fileForModule state ~package) loc 103 | in 104 | match hoverText with 105 | | None -> Protocol.null 106 | | Some s -> Protocol.stringifyHover {contents = s} ) 107 | 108 | let hover ~path ~line ~col = 109 | let state = TopTypes.empty () in 110 | let filePath = Files.maybeConcat (Unix.getcwd ()) path in 111 | let uri = Uri2.fromPath filePath in 112 | let result = 113 | match State.getFullFromCmt ~state ~uri with 114 | | Error message -> Protocol.stringifyHover {contents = message} 115 | | Ok (package, {file; extra}) -> 116 | hover state ~file ~line ~col ~extra ~package 117 | in 118 | print_endline result 119 | 120 | let definition state ~file ~line ~col ~extra ~package = 121 | let open TopTypes in 122 | let locations = 123 | extra.SharedTypes.locations 124 | |> List.filter (fun (l, _) -> not l.Location.loc_ghost) 125 | in 126 | let pos = Utils.protocolLineColToCmtLoc ~line ~col in 127 | match References.locForPos ~extra:{extra with locations} pos with 128 | | None -> Protocol.null 129 | | Some (_, loc) -> ( 130 | let locIsModule = 131 | match loc with 132 | | SharedTypes.LModule _ | TopLevelModule _ -> true 133 | | TypeDefinition _ | Typed _ | Constant _ | Explanation _ -> false 134 | in 135 | let uriLocOpt = 136 | References.definitionForLoc ~pathsForModule:package.pathsForModule ~file 137 | ~getUri:(State.fileForUri state) 138 | ~getModule:(State.fileForModule state ~package) 139 | loc 140 | in 141 | match uriLocOpt with 142 | | None -> Protocol.null 143 | | Some (uri2, loc) -> 144 | let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} = 145 | pos_lnum = 1 && pos_cnum - pos_bol = 0 146 | in 147 | (* Skip if range is all zero, unless it's a module *) 148 | let skipZero = 149 | (not locIsModule) && posIsZero loc.loc_start && posIsZero loc.loc_end 150 | in 151 | if skipZero then Protocol.null 152 | else 153 | Protocol.stringifyLocation 154 | {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc} ) 155 | 156 | let definition ~path ~line ~col = 157 | let state = TopTypes.empty () in 158 | let filePath = Files.maybeConcat (Unix.getcwd ()) path in 159 | let uri = Uri2.fromPath filePath in 160 | let result = 161 | match State.getFullFromCmt ~state ~uri with 162 | | Error _message -> Protocol.null 163 | | Ok (package, {file; extra}) -> 164 | definition state ~file ~line ~col ~extra ~package 165 | in 166 | print_endline result 167 | 168 | let test ~path = 169 | Uri2.stripPath := true; 170 | match Files.readFile path with 171 | | None -> assert false 172 | | Some text -> 173 | let lines = text |> String.split_on_char '\n' in 174 | let processLine i line = 175 | if Str.string_match (Str.regexp "^//[ ]*\\^") line 0 then 176 | let matched = Str.matched_string line in 177 | let len = line |> String.length in 178 | let mlen = String.length matched in 179 | let rest = String.sub line mlen (len - mlen) in 180 | let line = i - 1 in 181 | let col = mlen - 1 in 182 | if mlen >= 3 then ( 183 | ( match String.sub rest 0 3 with 184 | | "def" -> 185 | print_endline 186 | ( "Definition " ^ path ^ " " ^ string_of_int line ^ ":" 187 | ^ string_of_int col ); 188 | definition ~path ~line ~col 189 | | "hov" -> 190 | print_endline 191 | ( "Hover " ^ path ^ " " ^ string_of_int line ^ ":" 192 | ^ string_of_int col ); 193 | 194 | hover ~path ~line ~col 195 | | "com" -> 196 | print_endline 197 | ( "Complete " ^ path ^ " " ^ string_of_int line ^ ":" 198 | ^ string_of_int col ); 199 | let currentFile, cout = Filename.open_temp_file "def" "txt" in 200 | lines 201 | |> List.iteri (fun j l -> 202 | let lineToOutput = 203 | if j == i then String.sub rest 3 (len - mlen - 3) else l 204 | in 205 | Printf.fprintf cout "%s\n" lineToOutput); 206 | let line = line + 1 in 207 | let col = len - mlen - 3 in 208 | close_out cout; 209 | complete ~path ~line ~col ~currentFile; 210 | Sys.remove currentFile 211 | | _ -> () ); 212 | print_newline () ) 213 | in 214 | lines |> List.iteri processLine 215 | -------------------------------------------------------------------------------- /src/Files.ml: -------------------------------------------------------------------------------- 1 | let split str string = Str.split (Str.regexp_string str) string 2 | 3 | let removeExtraDots path = 4 | Str.global_replace (Str.regexp_string "/./") "/" path 5 | |> Str.global_replace (Str.regexp {|^\./\.\./|}) "../" 6 | 7 | (* Win32 & MacOS are case-insensitive *) 8 | let pathEq = 9 | match Sys.os_type = "Linux" with 10 | | true -> fun a b -> a = b 11 | | false -> fun a b -> String.lowercase_ascii a = String.lowercase_ascii b 12 | 13 | let pathStartsWith text prefix = 14 | String.length prefix <= String.length text 15 | && pathEq (String.sub text 0 (String.length prefix)) prefix 16 | 17 | let sliceToEnd str pos = String.sub str pos (String.length str - pos) 18 | 19 | let relpath base path = 20 | if pathStartsWith path base then 21 | let baselen = String.length base in 22 | let rest = String.sub path baselen (String.length path - baselen) in 23 | if rest = "" then "." ^ Filename.dir_sep 24 | else if rest.[0] = Filename.dir_sep.[0] then 25 | if String.length rest > 1 && rest.[1] = '.' then sliceToEnd rest 1 26 | else "." ^ rest 27 | else if rest.[0] = '.' then rest 28 | else "." ^ Filename.dir_sep ^ rest 29 | else 30 | let rec loop bp pp = 31 | match (bp, pp) with 32 | | "." :: ra, _ -> loop ra pp 33 | | _, "." :: rb -> loop bp rb 34 | | a :: ra, b :: rb when pathEq a b -> loop ra rb 35 | | _ -> (bp, pp) 36 | in 37 | let base, path = 38 | loop (split Filename.dir_sep base) (split Filename.dir_sep path) 39 | in 40 | String.concat Filename.dir_sep 41 | ( ( match base = [] with 42 | | true -> ["."] 43 | | false -> List.map (fun _ -> "..") base ) 44 | @ path ) 45 | |> removeExtraDots 46 | 47 | let maybeStat path = 48 | try Some (Unix.stat path) with Unix.Unix_error (Unix.ENOENT, _, _) -> None 49 | 50 | let getMtime path = 51 | match maybeStat path with Some {Unix.st_mtime} -> Some st_mtime | _ -> None 52 | 53 | let readFile ~filename = 54 | try 55 | (* windows can't use open_in *) 56 | let chan = open_in_bin filename in 57 | let content = really_input_string chan (in_channel_length chan) in 58 | close_in_noerr chan; 59 | Some content 60 | with 61 | | _ -> None 62 | 63 | let exists path = match maybeStat path with None -> false | Some _ -> true 64 | 65 | let ifExists path = match exists path with true -> Some path | false -> None 66 | 67 | let readDirectory dir = 68 | let maybeGet handle = 69 | try Some (Unix.readdir handle) with End_of_file -> None 70 | in 71 | let rec loop handle = 72 | match maybeGet handle with 73 | | None -> 74 | Unix.closedir handle; 75 | [] 76 | | Some name 77 | when name = Filename.current_dir_name || name = Filename.parent_dir_name 78 | -> 79 | loop handle 80 | | Some name -> name :: loop handle 81 | in 82 | match Unix.opendir dir with 83 | | exception Unix.Unix_error (Unix.ENOENT, "opendir", _dir) -> [] 84 | | handle -> loop handle 85 | 86 | let rec collectDirs path = 87 | match maybeStat path with 88 | | None -> [] 89 | | Some {Unix.st_kind = Unix.S_DIR} -> 90 | path 91 | :: ( readDirectory path 92 | |> List.map (fun name -> collectDirs (Filename.concat path name)) 93 | |> List.concat ) 94 | | _ -> [] 95 | 96 | let rec collect ?(checkDir = fun _ -> true) path test = 97 | match maybeStat path with 98 | | None -> [] 99 | | Some {Unix.st_kind = Unix.S_DIR} -> 100 | if checkDir path then 101 | readDirectory path 102 | |> List.map (fun name -> 103 | collect ~checkDir (Filename.concat path name) test) 104 | |> List.concat 105 | else [] 106 | | _ -> ( match test path with true -> [path] | false -> [] ) 107 | 108 | let fileConcat a b = 109 | if 110 | b <> "" 111 | && b.[0] = '.' 112 | && String.length b >= 2 113 | && b.[1] = Filename.dir_sep.[0] 114 | then Filename.concat a (String.sub b 2 (String.length b - 2)) 115 | else Filename.concat a b 116 | 117 | let isFullPath b = 118 | b.[0] = '/' || (Sys.win32 && String.length b > 1 && b.[1] = ':') 119 | 120 | let maybeConcat a b = if b <> "" && isFullPath b then b else fileConcat a b 121 | -------------------------------------------------------------------------------- /src/Hover.ml: -------------------------------------------------------------------------------- 1 | let digConstructor ~env ~getModule path = 2 | match Query.resolveFromCompilerPath ~env ~getModule path with 3 | | `Not_found -> None 4 | | `Stamp stamp -> ( 5 | match Hashtbl.find_opt env.file.stamps.types stamp with 6 | | None -> None 7 | | Some t -> Some (env, t) ) 8 | | `Exported (env, name) -> ( 9 | match Hashtbl.find_opt env.exported.types name with 10 | | None -> None 11 | | Some stamp -> ( 12 | match Hashtbl.find_opt env.file.stamps.types stamp with 13 | | None -> None 14 | | Some t -> Some (env, t) ) ) 15 | | _ -> None 16 | 17 | let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code 18 | 19 | let showModuleTopLevel ~docstring ~name 20 | (topLevel : SharedTypes.moduleItem SharedTypes.declared list) = 21 | let contents = 22 | topLevel 23 | |> List.map (fun item -> 24 | match item.SharedTypes.item with 25 | (* TODO pretty print module contents *) 26 | | SharedTypes.MType ({decl}, recStatus) -> 27 | " " ^ (decl |> Shared.declToString ~recStatus item.name.txt) 28 | | Module _ -> " module " ^ item.name.txt 29 | | MValue typ -> 30 | " let " ^ item.name.txt ^ ": " ^ (typ |> Shared.typeToString)) (* TODO indent *) 31 | |> String.concat "\n" 32 | in 33 | let full = "module " ^ name ^ " = {" ^ "\n" ^ contents ^ "\n}" in 34 | let doc = 35 | match docstring with 36 | | [] -> "" 37 | | _ :: _ -> "\n" ^ (docstring |> String.concat "\n") ^ "\n" 38 | in 39 | Some (doc ^ codeBlock full) 40 | 41 | let showModule ~docstring ~(file : SharedTypes.file) ~name 42 | (declared : SharedTypes.moduleKind SharedTypes.declared option) = 43 | match declared with 44 | | None -> showModuleTopLevel ~docstring ~name file.contents.topLevel 45 | | Some {item = Structure {topLevel}} -> 46 | showModuleTopLevel ~docstring ~name topLevel 47 | | Some {item = Ident _} -> Some "Unable to resolve module reference" 48 | 49 | let newHover ~(file : SharedTypes.file) ~getModule loc = 50 | match loc with 51 | | SharedTypes.Explanation text -> Some text 52 | | TypeDefinition (name, decl, _stamp) -> 53 | let typeDef = Shared.declToString name decl in 54 | Some (codeBlock typeDef) 55 | | LModule (Definition (stamp, _tip)) | LModule (LocalReference (stamp, _tip)) 56 | -> ( 57 | match Hashtbl.find_opt file.stamps.modules stamp with 58 | | None -> None 59 | | Some md -> ( 60 | match References.resolveModuleReference ~file ~getModule md with 61 | | None -> None 62 | | Some (file, declared) -> 63 | let name, docstring = 64 | match declared with 65 | | Some d -> (d.name.txt, d.docstring) 66 | | None -> (file.moduleName, file.contents.docstring) 67 | in 68 | showModule ~docstring ~name ~file declared ) ) 69 | | LModule (GlobalReference (moduleName, path, tip)) -> ( 70 | match getModule moduleName with 71 | | None -> None 72 | | Some file -> ( 73 | let env = Query.fileEnv file in 74 | match Query.resolvePath ~env ~path ~getModule with 75 | | None -> None 76 | | Some (env, name) -> ( 77 | match Query.exportedForTip ~env name tip with 78 | | None -> None 79 | | Some stamp -> ( 80 | match Hashtbl.find_opt file.stamps.modules stamp with 81 | | None -> None 82 | | Some md -> ( 83 | match References.resolveModuleReference ~file ~getModule md with 84 | | None -> None 85 | | Some (file, declared) -> 86 | let name, docstring = 87 | match declared with 88 | | Some d -> (d.name.txt, d.docstring) 89 | | None -> (file.moduleName, file.contents.docstring) 90 | in 91 | showModule ~docstring ~name ~file declared ) ) ) ) ) 92 | | LModule NotFound -> None 93 | | TopLevelModule name -> ( 94 | match getModule name with 95 | | None -> None 96 | | Some file -> 97 | showModule ~docstring:file.contents.docstring ~name:file.moduleName ~file 98 | None ) 99 | | Typed (_, Definition (_, (Field _ | Constructor _))) -> None 100 | | Constant t -> 101 | Some 102 | ( match t with 103 | | Const_int _ -> "int" 104 | | Const_char _ -> "char" 105 | | Const_string _ -> "string" 106 | | Const_float _ -> "float" 107 | | Const_int32 _ -> "int32" 108 | | Const_int64 _ -> "int64" 109 | | Const_nativeint _ -> "int" ) 110 | | Typed (t, locKind) -> 111 | let fromType ~docstring typ = 112 | let typeString = codeBlock (typ |> Shared.typeToString) in 113 | let extraTypeInfo = 114 | let env = Query.fileEnv file in 115 | match typ |> Shared.digConstructor with 116 | | None -> None 117 | | Some path -> ( 118 | match digConstructor ~env ~getModule path with 119 | | None -> None 120 | | Some (_env, {docstring; name = {txt}; item = {decl}}) -> 121 | let isUncurriedInternal = 122 | Utils.startsWith (Path.name path) "Js.Fn.arity" 123 | in 124 | if isUncurriedInternal then None 125 | else Some (decl |> Shared.declToString txt, docstring) ) 126 | in 127 | let typeString, docstring = 128 | match extraTypeInfo with 129 | | None -> (typeString, docstring) 130 | | Some (extra, extraDocstring) -> 131 | (typeString ^ "\n\n" ^ codeBlock extra, extraDocstring) 132 | in 133 | (typeString, docstring) 134 | in 135 | let parts = 136 | match References.definedForLoc ~file ~getModule locKind with 137 | | None -> 138 | let typeString, docstring = t |> fromType ~docstring:[] in 139 | typeString :: docstring 140 | | Some (docstring, res) -> ( 141 | match res with 142 | | `Declared -> 143 | let typeString, docstring = t |> fromType ~docstring in 144 | typeString :: docstring 145 | | `Constructor {cname = {txt}; args} -> 146 | let typeString, docstring = t |> fromType ~docstring in 147 | let argsString = 148 | match args with 149 | | [] -> "" 150 | | _ -> 151 | args 152 | |> List.map (fun (t, _) -> Shared.typeToString t) 153 | |> String.concat ", " |> Printf.sprintf "(%s)" 154 | in 155 | typeString :: codeBlock (txt ^ argsString) :: docstring 156 | | `Field {typ} -> 157 | let typeString, docstring = typ |> fromType ~docstring in 158 | typeString :: docstring ) 159 | in 160 | Some (String.concat "\n\n" parts) 161 | -------------------------------------------------------------------------------- /src/Infix.ml: -------------------------------------------------------------------------------- 1 | (** 2 | * This combines a filter and a map. 3 | * You provide a function that turns an element into an optional of another element, 4 | * and you get a list of all of the present results. 5 | *) 6 | let optMap : ('a -> 'b option) -> 'a list -> 'b list = fun fn items -> 7 | List.fold_left 8 | (fun result item -> 9 | match fn item with None -> result | Some res -> res :: result) 10 | [] items 11 | 12 | let ( |! ) o d = match o with None -> failwith d | Some v -> v 13 | 14 | let ( |? ) o d = match o with None -> d | Some v -> v 15 | 16 | let ( |?? ) o d = match o with None -> d | Some v -> Some v 17 | 18 | let ( |?> ) o fn = match o with None -> None | Some v -> fn v 19 | 20 | let ( |?>> ) o fn = match o with None -> None | Some v -> Some (fn v) 21 | 22 | let fold o d f = match o with None -> d | Some v -> f v 23 | 24 | let logIfAbsent message x = 25 | match x with 26 | | None -> 27 | Log.log message; 28 | None 29 | | _ -> x 30 | 31 | let ( /+ ) = Files.fileConcat 32 | -------------------------------------------------------------------------------- /src/Log.ml: -------------------------------------------------------------------------------- 1 | let spamError = ref false 2 | 3 | let log msg = 4 | if !spamError then ( 5 | output_string stderr (msg ^ "\n"); 6 | flush stderr ) 7 | -------------------------------------------------------------------------------- /src/MarkdownOfOCamldoc.ml: -------------------------------------------------------------------------------- 1 | open Comment 2 | 3 | let withStyle style contents = 4 | match style with 5 | | `Bold -> Omd.Bold contents 6 | | `Italic -> Omd.Emph contents 7 | | `Emphasis -> Omd.Emph contents 8 | | `Superscript -> Omd.Raw "Superscript" 9 | | `Subscript -> Omd.Raw "Subscript" 10 | 11 | let stripLoc fn item = fn item.Location_.value 12 | 13 | let whiteLeft text = 14 | let ln = String.length text in 15 | let rec loop i = 16 | match i >= ln with 17 | | true -> i - 1 18 | | false -> ( match text.[i] = ' ' with true -> loop (i + 1) | false -> i ) 19 | in 20 | loop 0 21 | 22 | let sliceToEnd text num = 23 | let ln = String.length text in 24 | if ln <= num then "" else String.sub text num (ln - num) 25 | 26 | let stripLeft text = 27 | let lines = Str.split (Str.regexp_string "\n") text in 28 | let rec loop lines = 29 | match lines with 30 | | [] -> 0 31 | | [one] -> whiteLeft one 32 | | one :: more -> min (whiteLeft one) (loop more) 33 | in 34 | let min = loop (lines |> List.filter (fun x -> String.trim x <> "")) in 35 | String.concat "\n" (List.map (fun line -> sliceToEnd line min) lines) 36 | 37 | let makeHeader level content = 38 | match level with 39 | | `Title -> Omd.H1 content 40 | | `Section -> Omd.H2 content 41 | | `Subsection -> Omd.H3 content 42 | | `Subsubsection -> Omd.H4 content 43 | 44 | (* [ `Module | `ModuleType | `Type 45 | | `Constructor | `Field | `Extension 46 | | `Exception | `Value | `Class | `ClassType 47 | | `Method | `InstanceVariable | `Label | `Page ] *) 48 | let handleRef reference = 49 | match reference with 50 | | Paths.Reference.Root (name, _tag) -> name 51 | | Paths.Reference.Resolved _ -> "resolved..." 52 | | Paths.Reference.Dot (_, name) -> name 53 | | Paths.Reference.Module (_, name) -> name 54 | | Paths.Reference.ModuleType (_, name) -> name 55 | | Paths.Reference.Type (_, name) -> name 56 | | Paths.Reference.Constructor (_, name) -> name 57 | | Paths.Reference.Field (_, name) -> name 58 | | Paths.Reference.Extension (_, name) -> name 59 | | Paths.Reference.Exception (_, name) -> name 60 | | Paths.Reference.Value (_, name) -> name 61 | | Paths.Reference.Class (_, name) -> name 62 | | Paths.Reference.ClassType (_, name) -> name 63 | | Paths.Reference.Method (_, name) -> name 64 | | _ -> "(unhandled reference)" 65 | 66 | let rec showPath (path : Path.module_) = 67 | match path with 68 | | Path.Resolved _resolved -> "" 69 | | Path.Root name -> name 70 | | Path.Forward name -> name 71 | | Path.Dot (inner, name) -> showPath inner ^ "." ^ name 72 | | Path.Apply (one, two) -> showPath one ^ "(" ^ showPath two ^ ")" 73 | 74 | let convertItem item = 75 | let rec convertItem item = 76 | match item.Location_.value with 77 | | `Heading (level, _label, content) -> 78 | makeHeader level (List.map convertLink content) 79 | | `Tag (`Author string) -> Omd.Text ("Author: " ^ string) 80 | | `Tag (`Deprecated contents) -> 81 | Omd.Paragraph 82 | (Omd.Text "Deprecated: " :: List.map (stripLoc convertNestable) contents) 83 | | `Tag (`Param (name, contents)) -> 84 | Omd.Paragraph 85 | ( Omd.Text ("Param: " ^ name) 86 | :: List.map (stripLoc convertNestable) contents ) 87 | | `Tag (`Raise (name, contents)) -> 88 | Omd.Paragraph 89 | ( Omd.Text ("Raises: " ^ name) 90 | :: List.map (stripLoc convertNestable) contents ) 91 | | `Tag (`Before (version, contents)) -> 92 | Omd.Paragraph 93 | ( Omd.Text ("Before: " ^ version) 94 | :: List.map (stripLoc convertNestable) contents ) 95 | | `Tag (`Return contents) -> 96 | Omd.Paragraph 97 | (Omd.Text "Returns: " :: List.map (stripLoc convertNestable) contents) 98 | | `Tag (`See (_, link, contents)) -> 99 | Omd.Paragraph 100 | [ 101 | Omd.Text "See: "; 102 | Omd.Url (link, List.map (stripLoc convertNestable) contents, ""); 103 | ] 104 | | `Tag (`Since versionString) -> Omd.Text ("Since: " ^ versionString) 105 | | `Tag (`Version versionString) -> Omd.Text ("Version: " ^ versionString) 106 | | `Tag `Open -> Omd.Text "Open" 107 | | `Tag `Closed -> Omd.Text "Closed" 108 | | `Tag `Inline -> Omd.Text "Inline" 109 | | `Tag (`Canonical (path, _reference)) -> 110 | (* output_string(stderr, "Warning: Unhandled tag 'Canonical' in ocamldoc (please tell the rescript-editor-support maintainers)\n"); *) 111 | Omd.Text (showPath path) (* ++ ", " ++ handleRef(reference)) *) 112 | | `Tag _ -> 113 | output_string stderr 114 | "Warning: Unhandled tag in ocamldoc (please tell the \ 115 | rescript-editor-support maintainers)\n"; 116 | Omd.Text "Unhandled tag" 117 | | #nestable_block_element as item -> convertNestable item 118 | and convertNestable item = 119 | match item with 120 | | `Example (lang, contents) -> 121 | let newLang = 122 | match String.trim lang = "" with 123 | | true -> "ml" 124 | | false -> 125 | let parts = Str.split (Str.regexp_string ";") (String.trim lang) in 126 | if 127 | List.mem "ml" parts || List.mem "ocaml" parts || List.mem "re" parts 128 | || List.mem "reason" parts 129 | then lang 130 | else lang ^ ";ml" 131 | in 132 | Omd.Code_block (newLang, stripLeft contents) 133 | | `Doc contents -> Omd.Paragraph [Omd.Text ("@doc " ^ contents)] 134 | | `Paragraph inline -> Omd.Paragraph (List.map convertInline inline) 135 | | `Code_block text -> Omd.Code_block ("ml", stripLeft text) 136 | | `Verbatim text -> Omd.Raw text (* TODO *) 137 | | `Modules _ -> 138 | Log.log "Unhandled modules"; 139 | Omd.Raw "!!!! Modules please" 140 | | `List (`Ordered, children) -> 141 | Omd.Ol (List.map (List.map (stripLoc convertNestable)) children) 142 | | `List (`Unordered, children) -> 143 | Omd.Ul (List.map (List.map (stripLoc convertNestable)) children) 144 | and convertInline item = 145 | match item.Location_.value with 146 | | `Link (href, content) -> Omd.Url (href, List.map convertLink content, "") 147 | | `Styled (style, contents) -> 148 | withStyle style (List.map convertInline contents) 149 | | `Reference (someref, _link) -> 150 | let text = handleRef someref in 151 | Omd.Text text 152 | (* Omd.Url("#TODO-ref", [Omd.Text("REFERENCE"), ...List.map(convertLink, link)], "") *) 153 | | #leaf_inline_element as rest -> convertLeaf rest 154 | and convertLink item = 155 | match item.Location_.value with 156 | | `Styled (style, contents) -> 157 | withStyle style (List.map convertLink contents) 158 | | #leaf_inline_element as rest -> convertLeaf rest 159 | and convertLeaf (item : Comment.leaf_inline_element) = 160 | match item with 161 | | `Space -> Omd.Text " " 162 | | `Word text -> Omd.Text text 163 | | `Code_span text -> Omd.Code ("", text) 164 | in 165 | convertItem item 166 | 167 | let convert text = 168 | try 169 | let res = 170 | Parser_.parse_comment ~permissive:true ~sections_allowed:`All 171 | ~containing_definition: 172 | (Paths.Identifier.Root 173 | ({Root.package = "hi"; file = Page "hi"; digest = "hi"}, "What")) 174 | ~location:Lexing.dummy_pos ~text 175 | in 176 | match res.result with 177 | | Error.Ok docs -> List.map convertItem docs 178 | | Error message -> 179 | [Omd.Text ("failed to parse: " ^ Error.to_string message)] 180 | with exn -> 181 | [Omd.Text ("Error (invalid syntax?) while parsing ocamldoc: " ^ Printexc.to_string exn)] 182 | -------------------------------------------------------------------------------- /src/ModuleResolution.ml: -------------------------------------------------------------------------------- 1 | open Infix 2 | 3 | let rec resolveNodeModulePath ~startPath name = 4 | let path = startPath /+ "node_modules" /+ name in 5 | match startPath with 6 | | "/" -> ( match Files.exists path with true -> Some path | false -> None ) 7 | | _ -> ( 8 | match Files.exists path with 9 | | true -> Some path 10 | | false -> 11 | resolveNodeModulePath ~startPath:(Filename.dirname startPath) name ) 12 | -------------------------------------------------------------------------------- /src/Packages.ml: -------------------------------------------------------------------------------- 1 | open Infix 2 | open TopTypes 3 | 4 | (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *) 5 | let makePathsForModule (localModules : (string * SharedTypes.paths) list) 6 | (dependencyModules : (string * SharedTypes.paths) list) = 7 | let pathsForModule = Hashtbl.create 30 in 8 | dependencyModules 9 | |> List.iter (fun (modName, paths) -> 10 | Hashtbl.replace pathsForModule modName paths); 11 | localModules 12 | |> List.iter (fun (modName, paths) -> 13 | Hashtbl.replace pathsForModule modName paths); 14 | pathsForModule 15 | 16 | let newBsPackage rootPath = 17 | let path = rootPath /+ "bsconfig.json" in 18 | match Files.readFile path with 19 | | None -> Error ("Unable to read " ^ path) 20 | | Some raw -> ( 21 | let config = Json.parse raw in 22 | Log.log {|📣 📣 NEW BSB PACKAGE 📣 📣|}; 23 | (* failwith("Wat"); *) 24 | Log.log ("- location: " ^ rootPath); 25 | let compiledBase = BuildSystem.getCompiledBase rootPath in 26 | match FindFiles.findDependencyFiles ~debug:true rootPath config with 27 | | Error e -> Error e 28 | | Ok (dependencyDirectories, dependencyModules) -> ( 29 | match compiledBase with 30 | | None -> 31 | Error 32 | "You need to run bsb first so that rescript-editor-support can \ 33 | access the compiled artifacts.\n\ 34 | Once you've run bsb, restart the language server." 35 | | Some compiledBase -> 36 | Ok 37 | (let namespace = FindFiles.getNamespace config in 38 | let localSourceDirs = 39 | FindFiles.getSourceDirectories ~includeDev:true rootPath config 40 | in 41 | Log.log 42 | ("Got source directories " ^ String.concat " - " localSourceDirs); 43 | let localModules = 44 | FindFiles.findProjectFiles ~debug:true namespace rootPath 45 | localSourceDirs compiledBase 46 | (* 47 | |> List.map(((name, paths)) => (switch (namespace) { 48 | | None => name 49 | | Some(n) => name ++ "-" ++ n }, paths)); *) 50 | in 51 | Log.log 52 | ("-- All local modules found: " 53 | ^ string_of_int (List.length localModules)); 54 | localModules 55 | |> List.iter (fun (name, paths) -> 56 | Log.log name; 57 | match paths with 58 | | SharedTypes.Impl (cmt, _) -> Log.log ("impl " ^ cmt) 59 | | Intf (cmi, _) -> Log.log ("intf " ^ cmi) 60 | | _ -> Log.log "Both"); 61 | let pathsForModule = 62 | makePathsForModule localModules dependencyModules 63 | in 64 | let opens_from_namespace = 65 | match namespace with 66 | | None -> [] 67 | | Some namespace -> 68 | let cmt = (compiledBase /+ namespace) ^ ".cmt" in 69 | Log.log ("############ Namespaced as " ^ namespace ^ " at " ^ cmt); 70 | Hashtbl.add pathsForModule namespace (Impl (cmt, None)); 71 | [FindFiles.nameSpaceToName namespace] 72 | in 73 | Log.log ("Dependency dirs " ^ String.concat " " dependencyDirectories); 74 | let opens_from_bsc_flags = 75 | match Json.get "bsc-flags" config |?> Json.array with 76 | | Some l -> 77 | List.fold_left 78 | (fun opens item -> 79 | match item |> Json.string with 80 | | None -> opens 81 | | Some s -> ( 82 | let parts = String.split_on_char ' ' s in 83 | match parts with 84 | | "-open" :: name :: _ -> name :: opens 85 | | _ -> opens)) 86 | [] l 87 | | None -> [] 88 | in 89 | let opens = 90 | List.rev_append opens_from_bsc_flags opens_from_namespace 91 | in 92 | Log.log ("Opens from bsconfig: " ^ (opens |> String.concat " ")); 93 | let interModuleDependencies = 94 | Hashtbl.create (List.length localModules) 95 | in 96 | { 97 | rootPath; 98 | localModules = localModules |> List.map fst; 99 | dependencyModules = dependencyModules |> List.map fst; 100 | pathsForModule; 101 | opens; 102 | namespace; 103 | interModuleDependencies; 104 | }))) 105 | 106 | let findRoot ~uri packagesByRoot = 107 | let path = Uri2.toPath uri in 108 | let rec loop path = 109 | if path = "/" then None 110 | else if Hashtbl.mem packagesByRoot path then Some (`Root path) 111 | else if Files.exists (path /+ "bsconfig.json") then Some (`Bs path) 112 | else loop (Filename.dirname path) 113 | in 114 | loop (Filename.dirname path) 115 | 116 | let getPackage ~uri state = 117 | if Hashtbl.mem state.rootForUri uri then 118 | Ok (Hashtbl.find state.packagesByRoot (Hashtbl.find state.rootForUri uri)) 119 | else 120 | match findRoot ~uri state.packagesByRoot with 121 | | None -> Error "No root directory found" 122 | | Some root -> ( 123 | match 124 | match root with 125 | | `Root rootPath -> 126 | Hashtbl.replace state.rootForUri uri rootPath; 127 | Ok 128 | (Hashtbl.find state.packagesByRoot 129 | (Hashtbl.find state.rootForUri uri)) 130 | | `Bs rootPath -> ( 131 | match newBsPackage rootPath with 132 | | Error e -> Error e 133 | | Ok package -> 134 | Hashtbl.replace state.rootForUri uri package.rootPath; 135 | Hashtbl.replace state.packagesByRoot package.rootPath package; 136 | Ok package) 137 | with 138 | | Error e -> Error e 139 | | Ok package -> Ok package) 140 | -------------------------------------------------------------------------------- /src/PartialParser.ml: -------------------------------------------------------------------------------- 1 | let rec findBack text char i = 2 | if i < 0 then i 3 | else if text.[i] = char && (i = 0 || text.[i - 1] <> '/') then i - 1 4 | else findBack text char (i - 1) 5 | 6 | let rec findOpenComment text i = 7 | if i < 1 then 0 8 | else if text.[i] = '*' && text.[i - 1] = '/' then i - 2 9 | else findOpenComment text (i - 1) 10 | 11 | let rec findBackSkippingCommentsAndStrings text char pair i level = 12 | let loop = findBackSkippingCommentsAndStrings text char pair in 13 | if i < 0 then 0 14 | else if text.[i] = char then 15 | if level = 0 then i - 1 else loop (i - 1) (level - 1) 16 | else if text.[i] = pair then loop (i - 1) (level + 1) 17 | else 18 | match text.[i] with 19 | | '"' -> loop (findBack text '"' (i - 1)) level 20 | | '/' when i >= 1 && text.[i - 1] = '*' -> 21 | loop (findOpenComment text (i - 2)) level 22 | | _ -> loop (i - 1) level 23 | 24 | let rec skipWhite text i = 25 | if i < 0 then 0 26 | else 27 | match text.[i] with ' ' | '\n' | '\t' -> skipWhite text (i - 1) | _ -> i 28 | 29 | let rec startOfLident text i = 30 | if i < 0 then 0 31 | else 32 | match text.[i] with 33 | | 'a' .. 'z' | 'A' .. 'Z' | '.' | '_' | '0' .. '9' -> 34 | startOfLident text (i - 1) 35 | | _ -> i + 1 36 | 37 | (* foo(... ~arg) from ~arg find foo *) 38 | let findCallFromArgument text offset = 39 | let rec loop ~i ~nClosed = 40 | if i > 0 then 41 | match text.[i] with 42 | | '(' when nClosed > 0 -> loop ~i:(i - 1) ~nClosed:(nClosed - 1) 43 | | '(' -> 44 | let i1 = skipWhite text (i - 1) in 45 | let i0 = startOfLident text i1 in 46 | let funLident = String.sub text i0 (i1 - i0 + 1) in 47 | Str.split (Str.regexp_string ".") funLident 48 | | ')' -> loop ~i:(i - 1) ~nClosed:(nClosed + 1) 49 | | _ -> loop ~i:(i - 1) ~nClosed 50 | else [] 51 | in 52 | loop ~i:offset ~nClosed:0 53 | 54 | (* Figure out whether id should be autocompleted as component prop. *) 55 | (* Find JSX context ctx for component M to autocomplete id (already parsed) as a prop. *) 56 | (* ctx ::= 0 then 63 | match text.[i] with 64 | | '}' -> ( 65 | let i1 = findBackSkippingCommentsAndStrings text '{' '}' (i - 1) 0 in 66 | match i1 > 0 with true -> beforeValue i1 | false -> None) 67 | | ')' -> ( 68 | let i1 = findBackSkippingCommentsAndStrings text '(' ')' (i - 1) 0 in 69 | match i1 > 0 with true -> beforeValue i1 | false -> None) 70 | | ']' -> ( 71 | let i1 = findBackSkippingCommentsAndStrings text '[' ']' (i - 1) 0 in 72 | match i1 > 0 with true -> beforeValue i1 | false -> None) 73 | | '"' -> ( 74 | let i1 = findBack text '"' (i - 1) in 75 | match i1 > 0 with true -> beforeValue i1 | false -> None) 76 | | _ -> 77 | let i1 = startOfLident text i in 78 | let ident = String.sub text i1 (i - i1 + 1) in 79 | if i1 >= 1 && ident <> "" then 80 | match ident.[0] with 81 | | 'A' .. 'Z' when i1 >= 1 && text.[i1 - 1] = '<' -> Some ident 82 | | _ -> beforeIdent (i1 - 1) 83 | else None 84 | else None 85 | and beforeIdent i = 86 | let i = skipWhite text i in 87 | if i > 0 then 88 | match text.[i] with 89 | | '?' -> fromEquals (i - 1) 90 | | '=' -> fromEquals i 91 | | _ -> loop (i - 1) 92 | else None 93 | and beforeValue i = 94 | let i = skipWhite text i in 95 | if i > 0 then 96 | match text.[i] with '?' -> fromEquals (i - 1) | _ -> fromEquals i 97 | else None 98 | and fromEquals i = 99 | let i = skipWhite text i in 100 | if i > 0 then 101 | match text.[i] with 102 | | '=' -> ( 103 | let i = skipWhite text (i - 1) in 104 | let i1 = startOfLident text i in 105 | let ident = String.sub text i1 (i - i1 + 1) in 106 | match ident = "" with true -> None | false -> loop (i1 - 1)) 107 | | _ -> None 108 | else None 109 | in 110 | loop offset 111 | 112 | type pipe = PipeId of string | PipeArray | PipeString 113 | 114 | type completable = 115 | | Cdecorator of string (** e.g. @module *) 116 | | Clabel of string list * string 117 | (** e.g. (["M", "foo"], "label") for M.foo(...~label...) *) 118 | | Cpath of string list (** e.g. ["M", "foo"] for M.foo *) 119 | | Cjsx of string list * string 120 | (** E.g. (["M", "Comp"], "id") for foo" *) 122 | 123 | let isLowercaseIdent id = 124 | let rec loop i = 125 | if i < 0 then true 126 | else 127 | match id.[i] with 128 | | ('a' .. 'z' | '_') when i = 0 -> true 129 | | ('a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_') when i > 0 -> loop (i - 1) 130 | | _ -> false 131 | in 132 | loop (String.length id - 1) 133 | 134 | let findCompletable text offset = 135 | let mkPath s = 136 | let len = String.length s in 137 | let parts = Str.split (Str.regexp_string ".") s in 138 | let parts = 139 | match s.[len - 1] = '.' with true -> parts @ [""] | false -> parts 140 | in 141 | match parts with 142 | | [id] when String.lowercase_ascii id = id -> ( 143 | match findJsxContext text (offset - len - 1) with 144 | | None -> Cpath parts 145 | | Some componentName -> 146 | Cjsx (Str.split (Str.regexp_string ".") componentName, id)) 147 | | _ -> Cpath parts 148 | in 149 | let mkPipe off partialName = 150 | let off = skipWhite text off in 151 | let rec loop i = 152 | match i < 0 with 153 | | true -> Some (PipeId (String.sub text 0 (i - 1))) 154 | | false -> ( 155 | match text.[i] with 156 | | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '.' | '_' -> loop (i - 1) 157 | | '"' when i == off -> Some PipeString 158 | | ']' when i == off -> Some PipeArray 159 | | _ -> Some (PipeId (String.sub text (i + 1) (off - i)))) 160 | in 161 | match loop off with 162 | | None -> None 163 | | Some lhs -> Some (Cpipe (lhs, partialName)) 164 | in 165 | 166 | let suffix i = String.sub text (i + 1) (offset - (i + 1)) in 167 | let rec loop i = 168 | match i < 0 with 169 | | true -> Some (mkPath (suffix i)) 170 | | false -> ( 171 | match text.[i] with 172 | | '>' when i > 0 && text.[i - 1] = '-' -> 173 | let rest = suffix i in 174 | if isLowercaseIdent rest then mkPipe (i - 2) rest 175 | else Some (mkPath rest) 176 | | '~' -> 177 | let labelPrefix = suffix i in 178 | let funPath = findCallFromArgument text (i - 1) in 179 | Some (Clabel (funPath, labelPrefix)) 180 | | '@' -> Some (Cdecorator (suffix i)) 181 | | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '.' | '_' -> loop (i - 1) 182 | | _ -> ( 183 | match i = offset - 1 with 184 | | true -> None 185 | | false -> Some (mkPath (suffix i)))) 186 | in 187 | if offset > String.length text || offset = 0 then None else loop (offset - 1) 188 | 189 | (* Check if the position is inside a `//` comment *) 190 | let rec insideLineComment text offset = 191 | if offset <= 0 || text.[offset] = '\n' then false 192 | else if offset > 0 && text.[offset] = '/' && text.[offset - 1] = '/' then true 193 | else insideLineComment text (offset - 1) 194 | 195 | let findOpens text offset = 196 | let opens = ref [] in 197 | let pathOfModuleOpen o = 198 | let rec loop items = 199 | match items with 200 | | [] -> SharedTypes.Tip "place holder" 201 | | one :: rest -> Nested (one, loop rest) 202 | in 203 | loop (o |> Str.split (Str.regexp_string ".")) 204 | in 205 | let add o = opens := (o |> pathOfModuleOpen) :: !opens in 206 | let maybeOpen i0 = 207 | let rec loop i = 208 | if i < 4 then 0 209 | else 210 | match text.[i] with 211 | | 'a' .. 'z' | 'A' .. 'Z' | '.' | '_' | '0' .. '9' -> loop (i - 1) 212 | | ' ' | '!' -> 213 | let at = skipWhite text (i - 1) in 214 | let at = 215 | if at >= 0 && text.[at] = '!' then 216 | (* handle open! *) 217 | skipWhite text (at - 1) 218 | else at 219 | in 220 | if 221 | at >= 3 222 | && text.[at - 3] = 'o' 223 | && text.[at - 2] = 'p' 224 | && text.[at - 1] = 'e' 225 | && text.[at] = 'n' 226 | && not (insideLineComment text (at - 4)) 227 | then ( 228 | add (String.sub text (i + 1) (i0 + 1 - (i + 1))); 229 | at - 4) 230 | else at 231 | | _ -> i 232 | in 233 | loop (i0 - 1) 234 | in 235 | let rec loop i = 236 | if i > 1 then 237 | match text.[i] with 238 | | '}' -> loop (findBackSkippingCommentsAndStrings text '{' '}' (i - 1) 0) 239 | | ']' -> loop (findBackSkippingCommentsAndStrings text '[' ']' (i - 1) 0) 240 | | ')' -> loop (findBackSkippingCommentsAndStrings text '(' ')' (i - 1) 0) 241 | | '"' -> loop (findBack text '"' (i - 1)) 242 | | 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' -> loop (maybeOpen i) 243 | | '(' when text.[i - 1] = '.' -> ( 244 | match text.[i - 2] with 245 | | 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' -> 246 | let i0 = startOfLident text (i - 3) in 247 | add (String.sub text i0 (i - i0 - 1)) 248 | | _ -> loop (i - 1)) 249 | | _ -> 250 | if i > 1 && text.[i] = '/' && text.[i - 1] = '*' then 251 | loop (findOpenComment text (i - 2)) 252 | else loop (i - 1) 253 | in 254 | loop (offset - 1) |> ignore; 255 | !opens 256 | 257 | let offsetOfLine text line = 258 | let ln = String.length text in 259 | let rec loop i lno = 260 | match i >= ln with 261 | | true -> None 262 | | false -> ( 263 | match text.[i] with 264 | | '\n' -> ( 265 | match lno = line - 1 with 266 | | true -> Some (i + 1) 267 | | false -> loop (i + 1) (lno + 1)) 268 | | _ -> loop (i + 1) lno) 269 | in 270 | match line = 0 with true -> Some 0 | false -> loop 0 0 271 | 272 | let positionToOffset text (line, character) = 273 | let open Infix in 274 | offsetOfLine text line |?>> fun bol -> bol + character 275 | -------------------------------------------------------------------------------- /src/PrepareUtils.ml: -------------------------------------------------------------------------------- 1 | let findStars line = 2 | let l = String.length line in 3 | let rec loop i = 4 | if i >= l - 1 then None 5 | else if line.[i] = '*' && line.[i + 1] = ' ' then Some (i + 2) 6 | else if line.[i] <> ' ' then None 7 | else loop (i + 1) 8 | in 9 | loop 0 10 | 11 | let combine one two = 12 | match (one, two) with 13 | | None, None -> None 14 | | Some a, None -> Some a 15 | | None, Some b -> Some b 16 | | Some a, Some b -> ( match a = b with true -> Some a | false -> Some 0 ) 17 | 18 | let trimFirst num string = 19 | let length = String.length string in 20 | match length > num with 21 | | true -> String.sub string num (length - num) 22 | | false -> "" 23 | 24 | let cleanOffStars doc = 25 | let lines = Str.split (Str.regexp_string "\n") doc in 26 | let rec loop lines = 27 | match lines with 28 | | [] -> None 29 | | [one] -> ( 30 | match String.trim one = "" with true -> None | false -> findStars one ) 31 | | one :: rest -> ( 32 | match String.trim one = "" with 33 | | true -> loop rest 34 | | false -> combine (findStars one) (loop rest) ) 35 | in 36 | let num = loop lines in 37 | match num with 38 | | None | Some 0 -> doc 39 | | Some num -> ( 40 | match lines with 41 | | [] | [_] -> doc 42 | | one :: rest -> 43 | (if findStars one <> None then trimFirst num one else String.trim one) 44 | ^ "\n" 45 | ^ String.concat "\n" (rest |> List.map (trimFirst num)) ) 46 | -------------------------------------------------------------------------------- /src/PrintType.ml: -------------------------------------------------------------------------------- 1 | let printExpr typ = 2 | Printtyp.reset_names (); 3 | Res_doc.toString ~width:60 4 | (Res_outcome_printer.printOutTypeDoc (Printtyp.tree_of_typexp false typ)) 5 | 6 | let printDecl ~recStatus name decl = 7 | Printtyp.reset_names (); 8 | Res_doc.toString ~width:60 9 | (Res_outcome_printer.printOutSigItemDoc 10 | (Printtyp.tree_of_type_declaration (Ident.create name) decl recStatus)) 11 | -------------------------------------------------------------------------------- /src/ProcessAttributes.ml: -------------------------------------------------------------------------------- 1 | open SharedTypes 2 | 3 | (* TODO should I hang on to location? *) 4 | let rec findDocAttribute attributes = 5 | let open Parsetree in 6 | match attributes with 7 | | [] -> None 8 | | ( {Asttypes.txt = "ocaml.doc"}, 9 | PStr 10 | [ 11 | { 12 | pstr_desc = 13 | Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (doc, _))}, _); 14 | }; 15 | ] ) 16 | :: _ -> 17 | Some (PrepareUtils.cleanOffStars doc) 18 | | _ :: rest -> findDocAttribute rest 19 | 20 | let rec findDeprecatedAttribute attributes = 21 | let open Parsetree in 22 | match attributes with 23 | | [] -> None 24 | | ( {Asttypes.txt = "deprecated"}, 25 | PStr 26 | [ 27 | { 28 | pstr_desc = 29 | Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (msg, _))}, _); 30 | }; 31 | ] ) 32 | :: _ -> 33 | Some msg 34 | | ({Asttypes.txt = "deprecated"}, _) :: _ -> Some "" 35 | | _ :: rest -> findDeprecatedAttribute rest 36 | 37 | let newDeclared ~item ~scope ~extent ~name ~stamp ~modulePath ~processDoc 38 | exported attributes = 39 | { 40 | name; 41 | stamp; 42 | extentLoc = extent; 43 | scopeLoc = scope; 44 | exported; 45 | modulePath; 46 | deprecated = findDeprecatedAttribute attributes; 47 | docstring = 48 | ( match findDocAttribute attributes with 49 | | None -> [] 50 | | Some d -> processDoc d ); 51 | item; 52 | (* scopeType = Let; *) 53 | (* scopeStart = env.scopeStart; *) 54 | } 55 | -------------------------------------------------------------------------------- /src/Process_406.ml: -------------------------------------------------------------------------------- 1 | open SharedTypes 2 | 3 | let fileForCmt ~moduleName ~uri cmt processDoc = 4 | match Shared.tryReadCmt cmt with 5 | | Error e -> Error e 6 | | Ok infos -> Ok (ProcessCmt.forCmt ~moduleName ~uri processDoc infos) 7 | 8 | let fullForCmt ~moduleName ~uri cmt processDoc = 9 | match Shared.tryReadCmt cmt with 10 | | Error e -> Error e 11 | | Ok infos -> 12 | let file = ProcessCmt.forCmt ~moduleName ~uri processDoc infos in 13 | let extra = ProcessExtra.forCmt ~file infos in 14 | Ok {file; extra} 15 | 16 | module PrintType = PrintType 17 | -------------------------------------------------------------------------------- /src/Process_406.mli: -------------------------------------------------------------------------------- 1 | val fileForCmt : 2 | moduleName:string -> 3 | uri:Uri2.t -> 4 | string -> 5 | (string -> string list) -> 6 | (SharedTypes.file, string) result 7 | 8 | val fullForCmt : 9 | moduleName:string -> 10 | uri:Uri2.t -> 11 | string -> 12 | (string -> string list) -> 13 | (SharedTypes.full, string) result 14 | -------------------------------------------------------------------------------- /src/Protocol.ml: -------------------------------------------------------------------------------- 1 | let array l = "[" ^ (String.concat ", " l) ^ "]" 2 | 3 | type position = { 4 | line: int; 5 | character: int; 6 | } 7 | 8 | type range = { 9 | start: position; 10 | end_: position; 11 | } 12 | 13 | type markupContent = { 14 | kind: string; 15 | value: string; 16 | } 17 | 18 | type completionItem = { 19 | label: string; 20 | kind: int; 21 | tags: int list; 22 | detail: string; 23 | documentation: markupContent; 24 | } 25 | 26 | type hover = { 27 | contents: string; 28 | } 29 | 30 | type location = { 31 | uri: string; 32 | range: range; 33 | } 34 | 35 | let stringifyPosition p = 36 | Printf.sprintf {|{"line": %i, "character": %i}|} p.line p.character 37 | 38 | let stringifyRange r = 39 | Printf.sprintf {|{"start": %s, "end": %s}|} 40 | (stringifyPosition r.start) 41 | (stringifyPosition r.end_) 42 | 43 | let stringifyMarkupContent (m: markupContent) = 44 | Printf.sprintf {|{"kind": "%s", "value": "%s"}|} 45 | m.kind (String.escaped m.value) 46 | 47 | let stringifyCompletionItem c = 48 | Printf.sprintf {|{ 49 | "label": "%s", 50 | "kind": %i, 51 | "tags": %s, 52 | "detail": "%s", 53 | "documentation": %s 54 | }|} 55 | (String.escaped c.label) 56 | c.kind 57 | (c.tags |> List.map string_of_int |> array) 58 | (String.escaped c.detail) 59 | (stringifyMarkupContent c.documentation) 60 | 61 | let stringifyHover h = 62 | Printf.sprintf {|{"contents": "%s"}|} 63 | (String.escaped h.contents) 64 | 65 | let stringifyLocation h = 66 | Printf.sprintf {|{"uri": "%s", "range": %s}|} 67 | (String.escaped h.uri) 68 | (stringifyRange h.range) 69 | 70 | let null = "null" 71 | -------------------------------------------------------------------------------- /src/Query.ml: -------------------------------------------------------------------------------- 1 | open SharedTypes 2 | 3 | type queryEnv = {file : file; exported : exported} 4 | 5 | let fileEnv file = {file; exported = file.contents.exported} 6 | 7 | let tupleOfLexing {Lexing.pos_lnum; pos_cnum; pos_bol} = 8 | (pos_lnum - 1, pos_cnum - pos_bol) 9 | 10 | let locationIsBefore {Location.loc_start} pos = tupleOfLexing loc_start <= pos 11 | 12 | let findInScope pos name stamps = 13 | (* Log.log("Find " ++ name ++ " with " ++ string_of_int(Hashtbl.length(stamps)) ++ " stamps"); *) 14 | Hashtbl.fold 15 | (fun _stamp declared result -> 16 | if declared.name.txt = name then 17 | (* Log.log("a stamp " ++ Utils.showLocation(declared.scopeLoc) ++ " " ++ string_of_int(l) ++ "," ++ string_of_int(c)); *) 18 | if locationIsBefore declared.scopeLoc pos then 19 | match result with 20 | | None -> Some declared 21 | | Some current -> 22 | if 23 | current.name.loc.loc_start.pos_cnum 24 | < declared.name.loc.loc_start.pos_cnum 25 | then Some declared 26 | else result 27 | else result 28 | else 29 | (* Log.log("wrong name " ++ declared.name.txt); *) 30 | result 31 | ) 32 | stamps None 33 | 34 | let rec joinPaths modulePath path = 35 | match modulePath with 36 | | Path.Pident ident -> (ident.stamp, ident.name, path) 37 | | Papply (fnPath, _argPath) -> joinPaths fnPath path 38 | | Pdot (inner, name, _) -> joinPaths inner (Nested (name, path)) 39 | 40 | let rec makePath modulePath = 41 | match modulePath with 42 | | Path.Pident ident when ident.stamp == 0 -> `GlobalMod ident.name 43 | | Pident ident -> `Stamp ident.stamp 44 | | Papply (fnPath, _argPath) -> makePath fnPath 45 | | Pdot (inner, name, _) -> `Path (joinPaths inner (Tip name)) 46 | 47 | let makeRelativePath basePath otherPath = 48 | let rec loop base other tip = 49 | if Path.same base other then Some tip 50 | else 51 | match other with 52 | | Pdot (inner, name, _) -> loop basePath inner (Nested (name, tip)) 53 | | _ -> None 54 | in 55 | match otherPath with 56 | | Path.Pdot (inner, name, _) -> loop basePath inner (Tip name) 57 | | _ -> None 58 | 59 | let rec resolvePathInner ~env ~path = 60 | match path with 61 | | Tip name -> Some (`Local (env, name)) 62 | | Nested (subName, subPath) -> ( 63 | match Hashtbl.find_opt env.exported.modules subName with 64 | | None -> None 65 | | Some stamp -> ( 66 | match Hashtbl.find_opt env.file.stamps.modules stamp with 67 | | None -> None 68 | | Some {item = kind} -> findInModule ~env kind subPath ) ) 69 | 70 | and findInModule ~env kind path = 71 | match kind with 72 | | Structure {exported} -> resolvePathInner ~env:{env with exported} ~path 73 | | Ident modulePath -> ( 74 | let stamp, moduleName, fullPath = joinPaths modulePath path in 75 | if stamp = 0 then Some (`Global (moduleName, fullPath)) 76 | else 77 | match Hashtbl.find_opt env.file.stamps.modules stamp with 78 | | None -> None 79 | | Some {item = kind} -> findInModule ~env kind fullPath ) 80 | 81 | (* let rec findSubModule = (~env, ~getModule) *) 82 | 83 | let rec resolvePath ~env ~path ~getModule = 84 | match resolvePathInner ~env ~path with 85 | | None -> None 86 | | Some result -> ( 87 | match result with 88 | | `Local (env, name) -> Some (env, name) 89 | | `Global (moduleName, fullPath) -> ( 90 | match getModule moduleName with 91 | | None -> None 92 | | Some file -> resolvePath ~env:(fileEnv file) ~path:fullPath ~getModule ) 93 | ) 94 | 95 | let resolveFromStamps ~env ~path ~getModule ~pos = 96 | match path with 97 | | Tip name -> Some (env, name) 98 | | Nested (name, inner) -> ( 99 | (* Log.log("Finding from stamps " ++ name); *) 100 | match findInScope pos name env.file.stamps.modules with 101 | | None -> None 102 | | Some declared -> ( 103 | (* Log.log("found it"); *) 104 | match findInModule ~env declared.item inner with 105 | | None -> None 106 | | Some res -> ( 107 | match res with 108 | | `Local (env, name) -> Some (env, name) 109 | | `Global (moduleName, fullPath) -> ( 110 | match getModule moduleName with 111 | | None -> None 112 | | Some file -> 113 | resolvePath ~env:(fileEnv file) ~path:fullPath ~getModule ) ) ) ) 114 | 115 | open Infix 116 | 117 | let fromCompilerPath ~env path = 118 | match makePath path with 119 | | `Stamp stamp -> `Stamp stamp 120 | | `Path (0, moduleName, path) -> `Global (moduleName, path) 121 | | `GlobalMod name -> `GlobalMod name 122 | | `Path (stamp, _moduleName, path) -> ( 123 | let res = 124 | match Hashtbl.find_opt env.file.stamps.modules stamp with 125 | | None -> None 126 | | Some {item = kind} -> findInModule ~env kind path 127 | in 128 | match res with 129 | | None -> `Not_found 130 | | Some (`Local (env, name)) -> `Exported (env, name) 131 | | Some (`Global (moduleName, fullPath)) -> `Global (moduleName, fullPath) ) 132 | 133 | let resolveModuleFromCompilerPath ~env ~getModule path = 134 | match fromCompilerPath ~env path with 135 | | `Global (moduleName, path) -> ( 136 | match getModule moduleName with 137 | | None -> None 138 | | Some file -> ( 139 | let env = fileEnv file in 140 | match resolvePath ~env ~getModule ~path with 141 | | None -> None 142 | | Some (env, name) -> ( 143 | match Hashtbl.find_opt env.exported.modules name with 144 | | None -> None 145 | | Some stamp -> ( 146 | match Hashtbl.find_opt env.file.stamps.modules stamp with 147 | | None -> None 148 | | Some declared -> Some (env, Some declared) ) ) ) ) 149 | | `Stamp stamp -> ( 150 | match Hashtbl.find_opt env.file.stamps.modules stamp with 151 | | None -> None 152 | | Some declared -> Some (env, Some declared) ) 153 | | `GlobalMod moduleName -> ( 154 | match getModule moduleName with 155 | | None -> None 156 | | Some file -> 157 | let env = fileEnv file in 158 | Some (env, None) ) 159 | | `Not_found -> None 160 | | `Exported (env, name) -> ( 161 | match Hashtbl.find_opt env.exported.modules name with 162 | | None -> None 163 | | Some stamp -> ( 164 | match Hashtbl.find_opt env.file.stamps.modules stamp with 165 | | None -> None 166 | | Some declared -> Some (env, Some declared) ) ) 167 | 168 | let resolveFromCompilerPath ~env ~getModule path = 169 | match fromCompilerPath ~env path with 170 | | `Global (moduleName, path) -> ( 171 | let res = 172 | match getModule moduleName with 173 | | None -> None 174 | | Some file -> 175 | let env = fileEnv file in 176 | resolvePath ~env ~getModule ~path 177 | in 178 | match res with 179 | | None -> `Not_found 180 | | Some (env, name) -> `Exported (env, name) ) 181 | | `Stamp stamp -> `Stamp stamp 182 | | `GlobalMod _ -> `Not_found 183 | | `Not_found -> `Not_found 184 | | `Exported (env, name) -> `Exported (env, name) 185 | 186 | let declaredForExportedTip ~(stamps : stamps) ~(exported : exported) name tip = 187 | match tip with 188 | | Value -> 189 | Hashtbl.find_opt exported.values name |?> fun stamp -> 190 | Hashtbl.find_opt stamps.values stamp |?>> fun x -> {x with item = ()} 191 | | Field _ | Constructor _ | Type -> 192 | Hashtbl.find_opt exported.types name |?> fun stamp -> 193 | Hashtbl.find_opt stamps.types stamp |?>> fun x -> {x with item = ()} 194 | | Module -> 195 | Hashtbl.find_opt exported.modules name |?> fun stamp -> 196 | Hashtbl.find_opt stamps.modules stamp |?>> fun x -> {x with item = ()} 197 | 198 | let declaredForTip ~stamps stamp tip = 199 | match tip with 200 | | Value -> 201 | Hashtbl.find_opt stamps.values stamp |?>> fun x -> {x with item = ()} 202 | | Field _ | Constructor _ | Type -> 203 | Hashtbl.find_opt stamps.types stamp |?>> fun x -> {x with item = ()} 204 | | Module -> 205 | Hashtbl.find_opt stamps.modules stamp |?>> fun x -> {x with item = ()} 206 | 207 | let getField file stamp name = 208 | match Hashtbl.find_opt file.stamps.types stamp with 209 | | None -> None 210 | | Some {item = {kind}} -> ( 211 | match kind with 212 | | Record fields -> fields |> List.find_opt (fun f -> f.fname.txt = name) 213 | | _ -> None ) 214 | 215 | let getConstructor file stamp name = 216 | match Hashtbl.find_opt file.stamps.types stamp with 217 | | None -> None 218 | | Some {item = {kind}} -> ( 219 | match kind with 220 | | Variant constructors -> ( 221 | match 222 | constructors |> List.find_opt (fun const -> const.cname.txt = name) 223 | with 224 | | None -> None 225 | | Some const -> Some const ) 226 | | _ -> None ) 227 | 228 | let exportedForTip ~env name tip = 229 | match tip with 230 | | Value -> Hashtbl.find_opt env.exported.values name 231 | | Field _ | Constructor _ | Type -> Hashtbl.find_opt env.exported.types name 232 | | Module -> Hashtbl.find_opt env.exported.modules name 233 | 234 | let rec getSourceUri ~env ~getModule path = 235 | match path with 236 | | File (uri, _moduleName) -> uri 237 | | NotVisible -> env.file.uri 238 | | IncludedModule (path, inner) -> ( 239 | Log.log "INCLUDED MODULE"; 240 | match resolveModuleFromCompilerPath ~env ~getModule path with 241 | | None -> 242 | Log.log "NOT FOUND"; 243 | getSourceUri ~env ~getModule inner 244 | | Some (env, _declared) -> env.file.uri ) 245 | | ExportedModule (_, inner) -> getSourceUri ~env ~getModule inner 246 | -------------------------------------------------------------------------------- /src/RescriptEditorSupport.ml: -------------------------------------------------------------------------------- 1 | module StringSet = Set.Make (String) 2 | 3 | let parseArgs args = 4 | match args with 5 | | [] -> assert false 6 | | _ :: args -> 7 | let opts, pos = 8 | args |> List.rev 9 | |> List.fold_left 10 | (fun (set, pos) arg -> 11 | if arg <> "" && arg.[0] = '-' then (set |> StringSet.add arg, pos) 12 | else (set, arg :: pos)) 13 | (StringSet.empty, []) 14 | in 15 | (opts, pos) 16 | 17 | let hasOpt opts name = opts |> StringSet.mem name 18 | 19 | let hasOpts opts names = names |> List.exists (opts |> hasOpt) 20 | 21 | let help = 22 | {| 23 | **Private CLI For rescript-vscode usage only** 24 | 25 | Examples: 26 | rescript-editor-support.exe dump src/MyFile.res src/MyFile2.res 27 | rescript-editor-support.exe complete src/MyFile.res 0 4 currentContent.res 28 | rescript-editor-support.exe hover src/MyFile.res 10 2 29 | rescript-editor-support.exe definition src/MyFile.res 9 3 30 | 31 | Options: 32 | dump: debugging. definition and hover for Foo.res and Foo2.res: 33 | 34 | rescript-editor-support.exe dump src/Foo.res src/Foo2.res 35 | 36 | complete: compute autocomplete for Foo.res at line 0 and column 4, 37 | where Foo.res is being edited and the editor content is in file current.res. 38 | 39 | rescript-editor-support.exe complete src/Foo.res 0 4 current.res 40 | 41 | hover: get inferred type for Foo.res at line 10 column 2: 42 | 43 | rescript-editor-support.exe hover src/Foo.res 10 2 44 | 45 | definition: get inferred type for Foo.res at line 10 column 2: 46 | 47 | rescript-editor-support.exe definition src/Foo.res 10 2 48 | |} 49 | 50 | let showHelp () = prerr_endline help 51 | 52 | let main () = 53 | match parseArgs (Sys.argv |> Array.to_list) with 54 | | opts, _ when hasOpts opts ["-h"; "--help"] -> showHelp () 55 | | _opts, "dump" :: files -> EditorSupportCommands.dump files 56 | | _opts, ["complete"; path; line; col; currentFile] -> 57 | EditorSupportCommands.complete ~path ~line:(int_of_string line) 58 | ~col:(int_of_string col) ~currentFile 59 | | _opts, ["hover"; path; line; col] -> 60 | EditorSupportCommands.hover ~path ~line:(int_of_string line) 61 | ~col:(int_of_string col) 62 | | _opts, ["definition"; path; line; col] -> 63 | EditorSupportCommands.definition ~path ~line:(int_of_string line) 64 | ~col:(int_of_string col) 65 | | _opts, ["test"; path] -> EditorSupportCommands.test ~path 66 | | _ -> 67 | showHelp (); 68 | exit 1 69 | 70 | ;; 71 | main () 72 | -------------------------------------------------------------------------------- /src/Shared.ml: -------------------------------------------------------------------------------- 1 | let tryReadCmt cmt = 2 | if not (Files.exists cmt) then Error ("Cmt file does not exist " ^ cmt) 3 | else 4 | match Cmt_format.read_cmt cmt with 5 | | exception Cmi_format.Error err -> 6 | Error 7 | ( "Failed to load " ^ cmt ^ " as a cmt w/ ocaml version " ^ "406" 8 | ^ ", error: " 9 | ^ 10 | ( Cmi_format.report_error Format.str_formatter err; 11 | Format.flush_str_formatter () ) ) 12 | | exception err -> 13 | Error 14 | ( "Invalid cmt format " ^ cmt 15 | ^ " - probably wrong ocaml version, expected " ^ Config.version ^ " : " 16 | ^ Printexc.to_string err ) 17 | | x -> Ok x 18 | 19 | (** TODO move to the Process_ stuff *) 20 | let rec dig typ = 21 | match typ.Types.desc with 22 | | Types.Tlink inner -> dig inner 23 | | Types.Tsubst inner -> dig inner 24 | | Types.Tpoly (inner, _) -> dig inner 25 | | _ -> typ 26 | 27 | let digConstructor expr = 28 | let expr = dig expr in 29 | match expr.desc with 30 | | Tconstr (path, _args, _memo) -> Some path 31 | | _ -> None 32 | 33 | let declToString ?(recStatus = Types.Trec_not) name t = 34 | PrintType.printDecl ~recStatus name t 35 | 36 | let cacheTypeToString = ref false 37 | 38 | let typeTbl = Hashtbl.create 1 39 | 40 | let typeToString (t : Types.type_expr) = 41 | match 42 | match !cacheTypeToString with 43 | | true -> Hashtbl.find_opt typeTbl (t.id, t) 44 | | false -> None 45 | with 46 | | None -> 47 | let s = PrintType.printExpr t in 48 | Hashtbl.replace typeTbl (t.id, t) s; 49 | s 50 | | Some s -> s 51 | -------------------------------------------------------------------------------- /src/SharedTypes.ml: -------------------------------------------------------------------------------- 1 | type filePath = string 2 | 3 | type paths = 4 | | Impl of filePath * filePath option 5 | | Intf of filePath * filePath 6 | (* .cm(t)i, .mli, .cmt, .rei *) 7 | | IntfAndImpl of filePath * filePath * filePath * filePath 8 | 9 | open Infix 10 | 11 | let showPaths paths = 12 | match paths with 13 | | Impl (cmt, src) -> Printf.sprintf "Impl(%s, %s)" cmt (src |? "nil") 14 | | Intf (cmti, src) -> Printf.sprintf "Intf(%s, %s)" cmti src 15 | | IntfAndImpl (cmti, srci, cmt, src) -> 16 | Printf.sprintf "IntfAndImpl(%s, %s, %s, %s)" cmti srci cmt src 17 | 18 | let getSrc p = 19 | match p with 20 | | Impl (_, s) -> s 21 | | Intf (_, s) | IntfAndImpl (_, s, _, _) -> Some s 22 | 23 | let getCmt ?(interface = true) p = 24 | match p with 25 | | Impl (c, _) | Intf (c, _) -> c 26 | | IntfAndImpl (cint, _, cimpl, _) -> ( 27 | match interface with true -> cint | false -> cimpl) 28 | 29 | type visibilityPath = 30 | | File of Uri2.t * string 31 | | NotVisible 32 | | IncludedModule of Path.t * visibilityPath 33 | | ExportedModule of string * visibilityPath 34 | 35 | type 't declared = { 36 | name : string Location.loc; 37 | extentLoc : Location.t; 38 | scopeLoc : Location.t; 39 | stamp : int; 40 | modulePath : visibilityPath; 41 | exported : bool; 42 | deprecated : string option; 43 | docstring : string list; 44 | item : 't; 45 | (* TODO: maybe add a uri? *) 46 | (* scopeType: scope, *) 47 | (* scopeStart: (int, int), *) 48 | } 49 | 50 | let emptyDeclared name = 51 | { 52 | name = Location.mknoloc name; 53 | extentLoc = Location.none; 54 | scopeLoc = Location.none; 55 | stamp = 0; 56 | modulePath = NotVisible; 57 | exported = false; 58 | deprecated = None; 59 | docstring = []; 60 | item = (); 61 | } 62 | 63 | type field = {stamp : int; fname : string Location.loc; typ : Types.type_expr} 64 | 65 | type constructor = { 66 | stamp : int; 67 | cname : string Location.loc; 68 | args : (Types.type_expr * Location.t) list; 69 | res : Types.type_expr option; 70 | } 71 | 72 | module Type = struct 73 | type kind = 74 | | Abstract of (Path.t * Types.type_expr list) option 75 | | Open 76 | | Tuple of Types.type_expr list 77 | | Record of field list 78 | | Variant of constructor list 79 | 80 | type t = {kind : kind; decl : Types.type_declaration} 81 | end 82 | 83 | (* type scope = 84 | | File 85 | | Switch 86 | | Module 87 | | Let 88 | | LetRec; *) 89 | 90 | type 't namedMap = (string, 't) Hashtbl.t 91 | 92 | type namedStampMap = int namedMap 93 | 94 | type exported = { 95 | types : namedStampMap; 96 | values : namedStampMap; 97 | modules : namedStampMap; 98 | (* constructors: namedStampMap, *) 99 | (* classes: namedStampMap, 100 | classTypes: namedStampMap, *) 101 | } 102 | 103 | let initExported () = 104 | { 105 | types = Hashtbl.create 10; 106 | values = Hashtbl.create 10; 107 | modules = Hashtbl.create 10 (* constructors: Hashtbl.create(10), *); 108 | } 109 | 110 | type moduleItem = 111 | | MValue of Types.type_expr 112 | | MType of Type.t * Types.rec_status 113 | | Module of moduleKind 114 | 115 | and moduleContents = { 116 | docstring : string list; 117 | exported : exported; 118 | topLevel : moduleItem declared list; 119 | } 120 | 121 | and moduleKind = Ident of Path.t | Structure of moduleContents 122 | 123 | type 't stampMap = (int, 't) Hashtbl.t 124 | 125 | type stamps = { 126 | types : Type.t declared stampMap; 127 | values : Types.type_expr declared stampMap; 128 | modules : moduleKind declared stampMap; 129 | constructors : constructor declared stampMap; 130 | } 131 | 132 | let initStamps () = 133 | { 134 | types = Hashtbl.create 10; 135 | values = Hashtbl.create 10; 136 | modules = Hashtbl.create 10; 137 | constructors = Hashtbl.create 10; 138 | } 139 | 140 | type file = { 141 | uri : Uri2.t; 142 | stamps : stamps; 143 | moduleName : string; 144 | contents : moduleContents; 145 | } 146 | 147 | let emptyFile moduleName uri = 148 | { 149 | uri; 150 | stamps = initStamps (); 151 | moduleName; 152 | contents = {docstring = []; exported = initExported (); topLevel = []}; 153 | } 154 | 155 | type tip = Value | Type | Field of string | Constructor of string | Module 156 | 157 | let tipToString tip = 158 | match tip with 159 | | Value -> "Value" 160 | | Type -> "Type" 161 | | Field f -> "Field(" ^ f ^ ")" 162 | | Constructor a -> "Constructor(" ^ a ^ ")" 163 | | Module -> "Module" 164 | 165 | type path = Tip of string | Nested of string * path 166 | 167 | let rec pathToString path = 168 | match path with 169 | | Tip name -> name 170 | | Nested (name, inner) -> name ^ "." ^ pathToString inner 171 | 172 | type locKind = 173 | | LocalReference of int * tip 174 | | GlobalReference of string * path * tip 175 | | NotFound 176 | | Definition of int * tip 177 | 178 | type loc = 179 | | Typed of Types.type_expr * locKind 180 | | Constant of Asttypes.constant 181 | | LModule of locKind 182 | | TopLevelModule of string 183 | | TypeDefinition of string * Types.type_declaration * int 184 | | Explanation of string 185 | 186 | type openTracker = { 187 | path : Path.t; 188 | loc : Location.t; 189 | extent : Location.t; 190 | mutable used : (path * tip * Location.t) list; 191 | } 192 | 193 | type extra = { 194 | internalReferences : (int, Location.t list) Hashtbl.t; 195 | externalReferences : (string, (path * tip * Location.t) list) Hashtbl.t; 196 | mutable locations : (Location.t * loc) list; 197 | (* This is the "open location", like the location... 198 | or maybe the >> location of the open ident maybe *) 199 | (* OPTIMIZE: using a stack to come up with this would cut the computation time of this considerably. *) 200 | opens : (Location.t, openTracker) Hashtbl.t; 201 | } 202 | (** These are the bits of info that we need to make in-app stuff awesome *) 203 | 204 | type full = {extra : extra; file : file} 205 | 206 | let initExtra () = 207 | { 208 | internalReferences = Hashtbl.create 10; 209 | externalReferences = Hashtbl.create 10; 210 | locations = []; 211 | opens = Hashtbl.create 10; 212 | } 213 | 214 | let hashList h = Hashtbl.fold (fun a b c -> (a, b) :: c) h [] 215 | 216 | let locKindToString = function 217 | | LocalReference (_, tip) -> "(LocalReference " ^ tipToString tip ^ ")" 218 | | GlobalReference _ -> "GlobalReference" 219 | | NotFound -> "NotFound" 220 | | Definition (_, tip) -> "(Definition " ^ tipToString tip ^ ")" 221 | 222 | let locToString = function 223 | | Typed (e, locKind) -> 224 | "Typed " ^ Shared.typeToString e ^ " " ^ locKindToString locKind 225 | | Constant _ -> "Constant" 226 | | LModule _ -> "LModule" 227 | | TopLevelModule _ -> "TopLevelModule" 228 | | TypeDefinition _ -> "TypeDefinition" 229 | | Explanation _ -> "Explanation" 230 | 231 | let locationToString ({Location.loc_start; loc_end}, loc) = 232 | let pos1 = Utils.cmtPosToPosition loc_start in 233 | let pos2 = Utils.cmtPosToPosition loc_end in 234 | Printf.sprintf "%d:%d-%d:%d %s" pos1.line pos1.character pos2.line 235 | pos2.character (locToString loc) 236 | 237 | (* for debugging *) 238 | let _ = locationToString -------------------------------------------------------------------------------- /src/State.ml: -------------------------------------------------------------------------------- 1 | open Infix 2 | open TopTypes 3 | 4 | let isMl path = 5 | Filename.check_suffix path ".ml" || Filename.check_suffix path ".mli" 6 | 7 | let odocToMd text = MarkdownOfOCamldoc.convert text 8 | 9 | let compose fn1 fn2 arg = fn1 arg |> fn2 10 | 11 | let converter src = 12 | let mlToOutput s = [compose odocToMd Omd.to_markdown s] in 13 | fold src mlToOutput (fun src -> 14 | match isMl src with true -> mlToOutput | false -> fun x -> [x]) 15 | 16 | let newDocsForCmt ~moduleName cmtCache changed cmt src = 17 | let uri = Uri2.fromPath (src |? cmt) in 18 | match Process_406.fileForCmt ~moduleName ~uri cmt (converter src) with 19 | | Error e -> 20 | Log.log e; 21 | None 22 | | Ok file -> 23 | Hashtbl.replace cmtCache cmt (changed, file); 24 | Some file 25 | 26 | let docsForCmt ~moduleName cmt src state = 27 | if Hashtbl.mem state.cmtCache cmt then 28 | let mtime, docs = Hashtbl.find state.cmtCache cmt in 29 | (* TODO: I should really throttle this mtime checking to like every 50 ms or so *) 30 | match Files.getMtime cmt with 31 | | None -> 32 | Log.log 33 | ("\226\154\160\239\184\143 cannot get docs for nonexistant cmt " ^ cmt); 34 | None 35 | | Some changed -> 36 | if changed > mtime then 37 | newDocsForCmt ~moduleName state.cmtCache changed cmt src 38 | else Some docs 39 | else 40 | match Files.getMtime cmt with 41 | | None -> 42 | Log.log 43 | ("\226\154\160\239\184\143 cannot get docs for nonexistant cmt " ^ cmt); 44 | None 45 | | Some changed -> newDocsForCmt ~moduleName state.cmtCache changed cmt src 46 | 47 | open Infix 48 | 49 | let getFullFromCmt ~state ~uri = 50 | let path = Uri2.toPath uri in 51 | match Packages.getPackage uri state with 52 | | Error e -> Error e 53 | | Ok package -> ( 54 | let moduleName = 55 | BuildSystem.namespacedName package.namespace (FindFiles.getName path) 56 | in 57 | match Hashtbl.find_opt package.pathsForModule moduleName with 58 | | Some paths -> ( 59 | let cmt = SharedTypes.getCmt ~interface:(Utils.endsWith path "i") paths in 60 | match Process_406.fullForCmt ~moduleName ~uri cmt (fun x -> [x]) with 61 | | Error e -> Error e 62 | | Ok full -> 63 | Hashtbl.replace package.interModuleDependencies moduleName 64 | (SharedTypes.hashList full.extra.externalReferences |> List.map fst); 65 | Ok (package, full)) 66 | | None -> Error ("can't find module " ^ moduleName)) 67 | 68 | let docsForModule modname state ~package = 69 | if Hashtbl.mem package.pathsForModule modname then ( 70 | let paths = Hashtbl.find package.pathsForModule modname in 71 | (* TODO: do better *) 72 | let cmt = SharedTypes.getCmt paths in 73 | let src = SharedTypes.getSrc paths in 74 | Log.log ("FINDING docs for module " ^ SharedTypes.showPaths paths); 75 | Log.log ("FINDING " ^ cmt ^ " src " ^ (src |? "")); 76 | match docsForCmt ~moduleName:modname cmt src state with 77 | | None -> None 78 | | Some docs -> Some (docs, src)) 79 | else ( 80 | Log.log ("No path for module " ^ modname); 81 | None) 82 | 83 | let fileForUri state uri = 84 | match getFullFromCmt ~state ~uri with 85 | | Error e -> Error e 86 | | Ok (_package, {extra; file}) -> Ok (file, extra) 87 | 88 | let fileForModule state ~package modname = 89 | match docsForModule modname state ~package with 90 | | None -> None 91 | | Some (file, _) -> Some file 92 | -------------------------------------------------------------------------------- /src/TopTypes.ml: -------------------------------------------------------------------------------- 1 | (* Aliases to make the intents clearer *) 2 | type uri = Uri2.t 3 | 4 | type filePath = string 5 | 6 | type moduleName = string 7 | 8 | (* Here are the things that will be different between jbuilder things *) 9 | type package = { 10 | rootPath : filePath; 11 | (* Depend on bsb having already run *) 12 | localModules : moduleName list; 13 | interModuleDependencies : (moduleName, moduleName list) Hashtbl.t; 14 | dependencyModules : moduleName list; 15 | pathsForModule : (moduleName, SharedTypes.paths) Hashtbl.t; 16 | namespace : string option; 17 | opens : string list; 18 | } 19 | 20 | type state = { 21 | packagesByRoot : (string, package) Hashtbl.t; 22 | rootForUri : (uri, string) Hashtbl.t; 23 | cmtCache : (filePath, float * SharedTypes.file) Hashtbl.t; 24 | } 25 | 26 | let empty () = 27 | { 28 | packagesByRoot = Hashtbl.create 1; 29 | rootForUri = Hashtbl.create 30; 30 | cmtCache = Hashtbl.create 30; 31 | } 32 | -------------------------------------------------------------------------------- /src/Uri2.ml: -------------------------------------------------------------------------------- 1 | module Uri : sig 2 | type t 3 | 4 | val fromPath : string -> t 5 | 6 | val stripPath : bool ref 7 | 8 | val toPath : t -> string 9 | 10 | val toString : t -> string 11 | end = struct 12 | type t = {path : string; uri : string} 13 | 14 | let stripPath = ref false (* for use in tests *) 15 | 16 | let pathToUri path = 17 | if Sys.os_type = "Unix" then "file://" ^ path 18 | else 19 | "file://" 20 | ^ ( Str.global_replace (Str.regexp_string "\\") "/" path 21 | |> Str.substitute_first (Str.regexp "^\\([a-zA-Z]\\):") (fun text -> 22 | let name = Str.matched_group 1 text in 23 | "/" ^ String.lowercase_ascii name ^ "%3A") ) 24 | 25 | let fromPath path = {path; uri = pathToUri path} 26 | 27 | let toPath {path} = path 28 | 29 | let toString {uri} = if !stripPath then Filename.basename uri else uri 30 | end 31 | 32 | include Uri 33 | -------------------------------------------------------------------------------- /src/Utils.ml: -------------------------------------------------------------------------------- 1 | let topLoc fname = 2 | { 3 | Location.loc_start = 4 | {Lexing.pos_fname = fname; pos_lnum = 1; pos_bol = 0; pos_cnum = 0}; 5 | Location.loc_end = 6 | {Lexing.pos_fname = fname; pos_lnum = 1; pos_bol = 0; pos_cnum = 0}; 7 | loc_ghost = false; 8 | } 9 | 10 | (** 11 | * `startsWith(string, prefix)` 12 | * true if the string starts with the prefix 13 | *) 14 | let startsWith s prefix = 15 | if prefix = "" then true 16 | else 17 | let p = String.length prefix in 18 | p <= String.length s && String.sub s 0 p = prefix 19 | 20 | let endsWith s suffix = 21 | if suffix = "" then true 22 | else 23 | let p = String.length suffix in 24 | let l = String.length s in 25 | p <= String.length s && String.sub s (l - p) p = suffix 26 | 27 | let protocolLineColToCmtLoc ~line ~col = (line + 1, col) 28 | 29 | let cmtPosToPosition {Lexing.pos_lnum; pos_cnum; pos_bol} = Protocol.{ 30 | line = pos_lnum - 1; 31 | character = pos_cnum - pos_bol; 32 | } 33 | 34 | let cmtLocToRange {Location.loc_start; loc_end} = Protocol.{ 35 | start = cmtPosToPosition loc_start; 36 | end_ = cmtPosToPosition loc_end; 37 | } 38 | 39 | let locWithinLoc inner outer = 40 | let open Location in 41 | inner.loc_start.pos_cnum >= outer.loc_start.pos_cnum 42 | && inner.loc_end.pos_cnum <= outer.loc_end.pos_cnum 43 | 44 | let endOfLocation loc length = 45 | let open Location in 46 | { 47 | loc with 48 | loc_start = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - length}; 49 | } 50 | 51 | let chopLocationEnd loc length = 52 | let open Location in 53 | { 54 | loc with 55 | loc_end = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - length}; 56 | } 57 | 58 | (** An optional List.find *) 59 | let rec find fn items = 60 | match items with 61 | | [] -> None 62 | | one :: rest -> ( 63 | match fn one with None -> find fn rest | Some x -> Some x) 64 | 65 | let dedup items = 66 | let m = Hashtbl.create (List.length items) in 67 | items 68 | |> List.filter (fun a -> 69 | if Hashtbl.mem m a then false 70 | else ( 71 | Hashtbl.add m a (); 72 | true)) 73 | 74 | let tupleOfLexing {Lexing.pos_lnum; pos_cnum; pos_bol} = 75 | (pos_lnum - 1, pos_cnum - pos_bol) 76 | 77 | (** 78 | Check if pos is within the location, but be fuzzy about when the location ends. 79 | If it's within 5 lines, go with it. 80 | *) 81 | let locationContainsFuzzy {Location.loc_start; loc_end} (l, c) = 82 | tupleOfLexing loc_start <= (l, c) && tupleOfLexing loc_end >= (l - 5, c) 83 | 84 | let filterMap f = 85 | let rec aux accu = function 86 | | [] -> List.rev accu 87 | | x :: l -> ( 88 | match f x with None -> aux accu l | Some v -> aux (v :: accu) l) 89 | in 90 | aux [] 91 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Thomas Refis trefis@janestreet.com Copyright (c) 2014, 2015 Leo White leo@lpw25.net Copyright (c) 2015 David Sheets sheets@alum.mit.edu 2 | 3 | Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. 4 | 5 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -------------------------------------------------------------------------------- /src/vendor/odoc_parser/Readme.md: -------------------------------------------------------------------------------- 1 | The source code in this directory was taken, with some modifications from the `odoc` project (https://github.com/ocaml/odoc/tree/master/src/parser). 2 | 3 | It is under the ISC license. -------------------------------------------------------------------------------- /src/vendor/odoc_parser/ast.ml: -------------------------------------------------------------------------------- 1 | module Path = Paths.Path 2 | module Reference = Paths.Reference 3 | module Identifier = Paths.Identifier 4 | module Comment = Comment 5 | 6 | type 'a with_location = 'a Location_.with_location 7 | 8 | 9 | 10 | type reference_kind = [ `Simple | `With_text ] 11 | 12 | type inline_element = [ 13 | | `Space 14 | | `Word of string 15 | | `Code_span of string 16 | | `Styled of Comment.style * (inline_element with_location) list 17 | | `Reference of 18 | reference_kind * Reference.any * (inline_element with_location) list 19 | | `Link of string * (inline_element with_location) list 20 | ] 21 | 22 | type nestable_block_element = [ 23 | | `Paragraph of (inline_element with_location) list 24 | | `Code_block of string 25 | | `Example of string * string 26 | | `Doc of string 27 | | `Verbatim of string 28 | | `Modules of Reference.module_ list 29 | | `List of 30 | [ `Unordered | `Ordered ] * 31 | ((nestable_block_element with_location) list) list 32 | ] 33 | 34 | type tag = [ 35 | | `Author of string 36 | | `Deprecated of (nestable_block_element with_location) list 37 | | `Param of string * (nestable_block_element with_location) list 38 | | `Raise of string * (nestable_block_element with_location) list 39 | | `Return of (nestable_block_element with_location) list 40 | | `See of 41 | [ `Url | `File | `Document ] * 42 | string * 43 | (nestable_block_element with_location) list 44 | | `Since of string 45 | | `Before of string * (nestable_block_element with_location) list 46 | | `Version of string 47 | | `Canonical of Path.module_ * Reference.module_ 48 | | `Inline 49 | | `Open 50 | | `Closed 51 | ] 52 | 53 | type block_element = [ 54 | | nestable_block_element 55 | | `Heading of int * string option * (inline_element with_location) list 56 | | `Tag of tag 57 | ] 58 | 59 | type docs = (block_element with_location) list 60 | 61 | 62 | 63 | type sections_allowed = [ `All | `No_titles | `None ] 64 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/comment.ml: -------------------------------------------------------------------------------- 1 | module Path = Paths.Path 2 | module Reference = Paths.Reference 3 | module Identifier = Paths.Identifier 4 | 5 | type 'a with_location = 'a Location_.with_location 6 | 7 | 8 | 9 | type style = [ 10 | | `Bold 11 | | `Italic 12 | | `Emphasis 13 | | `Superscript 14 | | `Subscript 15 | ] 16 | 17 | type leaf_inline_element = [ 18 | | `Space 19 | | `Word of string 20 | | `Code_span of string 21 | ] 22 | 23 | type non_link_inline_element = [ 24 | | leaf_inline_element 25 | | `Styled of style * (non_link_inline_element with_location) list 26 | ] 27 | 28 | (* The cross-referencer stores section heading text, and sometimes pastes it 29 | into link contents. This type alias is provided for use by the 30 | cross-referencer. *) 31 | type link_content = (non_link_inline_element with_location) list 32 | 33 | type inline_element = [ 34 | | leaf_inline_element 35 | | `Styled of style * (inline_element with_location) list 36 | | `Reference of Reference.any * link_content 37 | | `Link of string * link_content 38 | ] 39 | 40 | type nestable_block_element = [ 41 | | `Paragraph of (inline_element with_location) list 42 | | `Code_block of string 43 | | `Example of string * string 44 | | `Doc of string 45 | | `Verbatim of string 46 | | `Modules of Reference.module_ list 47 | | `List of 48 | [ `Unordered | `Ordered ] * 49 | ((nestable_block_element with_location) list) list 50 | ] 51 | 52 | type tag = [ 53 | | `Author of string 54 | | `Deprecated of (nestable_block_element with_location) list 55 | | `Param of string * (nestable_block_element with_location) list 56 | | `Raise of string * (nestable_block_element with_location) list 57 | | `Return of (nestable_block_element with_location) list 58 | | `See of 59 | [ `Url | `File | `Document ] * 60 | string * 61 | (nestable_block_element with_location) list 62 | | `Since of string 63 | | `Before of string * (nestable_block_element with_location) list 64 | | `Version of string 65 | | `Canonical of Path.module_ * Reference.module_ 66 | | `Inline 67 | | `Open 68 | | `Closed 69 | ] 70 | 71 | type heading_level = [ 72 | | `Title 73 | | `Section 74 | | `Subsection 75 | | `Subsubsection 76 | ] 77 | 78 | type block_element = [ 79 | | nestable_block_element 80 | | `Heading of heading_level * Identifier.label * link_content 81 | | `Tag of tag 82 | ] 83 | 84 | type docs = (block_element with_location) list 85 | 86 | type docs_or_stop = [ 87 | | `Docs of docs 88 | | `Stop 89 | ] 90 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/error.ml: -------------------------------------------------------------------------------- 1 | type full_location_payload = { 2 | location : Location_.span; 3 | message : string; 4 | } 5 | 6 | type filename_only_payload = { 7 | file : string; 8 | message : string; 9 | } 10 | 11 | type t = [ 12 | | `With_full_location of full_location_payload 13 | | `With_filename_only of filename_only_payload 14 | ] 15 | 16 | type 'a with_warnings = { 17 | result : 'a; 18 | warnings : t list; 19 | } 20 | 21 | let make : string -> Location_.span -> t = fun message location -> 22 | `With_full_location {location; message} 23 | 24 | let filename_only : string -> string -> t = fun message file -> 25 | `With_filename_only {file; message} 26 | 27 | let format = fun format -> 28 | (Printf.ksprintf make) format 29 | 30 | let to_string : t -> string = function 31 | | `With_full_location {location; message} -> 32 | let location_string = 33 | if location.start.line = location.end_.line then 34 | Printf.sprintf "line %i, characters %i-%i" 35 | location.start.line 36 | location.start.column 37 | location.end_.column 38 | else 39 | Printf.sprintf "line %i, character %i to line %i, character %i" 40 | location.start.line 41 | location.start.column 42 | location.end_.line 43 | location.end_.column 44 | in 45 | Printf.sprintf "File \"%s\", %s:\n%s" location.file location_string message 46 | 47 | | `With_filename_only {file; message} -> 48 | Printf.sprintf "File \"%s\":\n%s" file message 49 | 50 | exception Conveyed_by_exception of t 51 | 52 | type ('a, 'b) result = | Ok of 'a | Error of 'b 53 | 54 | let raise_exception : t -> _ = fun error -> 55 | raise (Conveyed_by_exception error) 56 | 57 | let to_exception : ('a, t) result -> 'a = function 58 | | Ok v -> v 59 | | Error error -> raise_exception error 60 | 61 | let catch : (unit -> 'a) -> ('a, t) result = fun f -> 62 | try Ok (f ()) 63 | with Conveyed_by_exception error -> Error error 64 | 65 | (* TODO This is a temporary measure until odoc is ported to handle warnings 66 | throughout. *) 67 | let shed_warnings : 'a with_warnings -> 'a = fun with_warnings -> 68 | with_warnings.warnings 69 | |> List.iter (fun warning -> warning |> to_string |> prerr_endline); 70 | with_warnings.result 71 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/lang.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Leo White 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Paths 18 | 19 | (** {3 Modules} *) 20 | 21 | module rec Module : sig 22 | 23 | type expansion = 24 | | AlreadyASig 25 | | Signature of Signature.t 26 | | Functor of FunctorArgument.t option list * Signature.t 27 | 28 | type decl = 29 | | Alias of Path.module_ 30 | | ModuleType of ModuleType.expr 31 | 32 | type t = 33 | { id: Identifier.module_; 34 | doc: Comment.docs; 35 | type_: decl; 36 | canonical : (Path.module_ * Reference.module_) option; 37 | hidden : bool; 38 | display_type : decl option; 39 | expansion: expansion option; 40 | } 41 | 42 | module Equation : sig 43 | 44 | type t = decl 45 | 46 | end 47 | 48 | end = Module 49 | 50 | and FunctorArgument : sig 51 | type t = { 52 | id : Identifier.module_; 53 | expr : ModuleType.expr; 54 | expansion: Module.expansion option; 55 | } 56 | end = FunctorArgument 57 | 58 | (** {3 Modules Types} *) 59 | 60 | and ModuleType : sig 61 | 62 | type substitution = 63 | | ModuleEq of Fragment.module_ * Module.Equation.t 64 | | TypeEq of Fragment.type_ * TypeDecl.Equation.t 65 | | ModuleSubst of Fragment.module_ * Path.module_ 66 | | TypeSubst of Fragment.type_ * TypeDecl.Equation.t 67 | 68 | type expr = 69 | | Path of Path.module_type 70 | | Signature of Signature.t 71 | | Functor of FunctorArgument.t option * expr 72 | | With of expr * substitution list 73 | | TypeOf of Module.decl 74 | 75 | type t = 76 | { id: Identifier.module_type; 77 | doc: Comment.docs; 78 | expr: expr option; 79 | expansion: Module.expansion option; 80 | } 81 | 82 | end = ModuleType 83 | 84 | (** {3 Signatures} *) 85 | 86 | and Signature : sig 87 | 88 | type item = 89 | | Module of Module.t 90 | | ModuleType of ModuleType.t 91 | | Type of TypeDecl.t 92 | | TypExt of Extension.t 93 | | Exception of Exception.t 94 | | Value of Value.t 95 | | External of External.t 96 | | Class of Class.t 97 | | ClassType of ClassType.t 98 | | Include of Include.t 99 | | Comment of Comment.docs_or_stop 100 | 101 | type t = item list 102 | 103 | end = Signature 104 | 105 | (** {3 Includes} *) 106 | 107 | and Include : sig 108 | type expansion = { 109 | resolved: bool; 110 | content: Signature.t; 111 | } 112 | 113 | type t = 114 | { parent: Identifier.signature; 115 | doc: Comment.docs; 116 | decl: Module.decl; 117 | expansion: expansion; } 118 | 119 | end = Include 120 | 121 | (** {3 Type Declarations} *) 122 | 123 | and TypeDecl : sig 124 | 125 | module Field : sig 126 | 127 | type t = 128 | { id: Identifier.field; 129 | doc: Comment.docs; 130 | mutable_ : bool; 131 | type_: TypeExpr.t; } 132 | 133 | end 134 | 135 | module Constructor : sig 136 | type argument = 137 | | Tuple of TypeExpr.t list 138 | | Record of Field.t list 139 | 140 | type t = 141 | { id: Identifier.constructor; 142 | doc: Comment.docs; 143 | args: argument; 144 | res: TypeExpr.t option; } 145 | 146 | end 147 | 148 | 149 | module Representation : sig 150 | 151 | type t = 152 | | Variant of Constructor.t list 153 | | Record of Field.t list 154 | | Extensible 155 | 156 | end 157 | 158 | type variance = 159 | | Pos 160 | | Neg 161 | 162 | type param_desc = 163 | | Any 164 | | Var of string 165 | 166 | type param = param_desc * variance option 167 | 168 | module Equation : sig 169 | 170 | type t = 171 | { params: param list; 172 | private_: bool; 173 | manifest: TypeExpr.t option; 174 | constraints: (TypeExpr.t * TypeExpr.t) list; } 175 | 176 | end 177 | 178 | type t = 179 | { id: Identifier.type_; 180 | doc: Comment.docs; 181 | equation: Equation.t; 182 | representation: Representation.t option; } 183 | 184 | end = TypeDecl 185 | 186 | (** {3 Type extensions} *) 187 | 188 | and Extension : sig 189 | 190 | module Constructor : sig 191 | 192 | type t = 193 | { id: Identifier.extension; 194 | doc: Comment.docs; 195 | args: TypeDecl.Constructor.argument; 196 | res: TypeExpr.t option; } 197 | 198 | end 199 | 200 | type t = 201 | { type_path: Path.type_; 202 | doc: Comment.docs; 203 | type_params: TypeDecl.param list; 204 | private_: bool; 205 | constructors: Constructor.t list; } 206 | 207 | end = Extension 208 | 209 | (** {3 Exception} *) 210 | and Exception : sig 211 | 212 | type t = 213 | { id: Identifier.exception_; 214 | doc: Comment.docs; 215 | args: TypeDecl.Constructor.argument; 216 | res: TypeExpr.t option; } 217 | 218 | end = Exception 219 | 220 | 221 | (** {3 Values} *) 222 | 223 | and Value : sig 224 | 225 | type t = 226 | { id: Identifier.value; 227 | doc: Comment.docs; 228 | type_: TypeExpr.t; } 229 | 230 | end = Value 231 | 232 | (** {3 External values} *) 233 | 234 | and External : sig 235 | 236 | type t = 237 | { id: Identifier.value; 238 | doc: Comment.docs; 239 | type_: TypeExpr.t; 240 | primitives: string list; } 241 | 242 | end = External 243 | 244 | (** {3 Classes} *) 245 | 246 | and Class : sig 247 | 248 | type decl = 249 | | ClassType of ClassType.expr 250 | | Arrow of TypeExpr.label option * TypeExpr.t * decl 251 | 252 | type t = 253 | { id: Identifier.class_; 254 | doc: Comment.docs; 255 | virtual_: bool; 256 | params: TypeDecl.param list; 257 | type_: decl; 258 | expansion: ClassSignature.t option; } 259 | 260 | end = Class 261 | 262 | (** {3 Class Types} *) 263 | 264 | and ClassType : sig 265 | 266 | type expr = 267 | | Constr of Path.class_type * TypeExpr.t list 268 | | Signature of ClassSignature.t 269 | 270 | type t = 271 | { id: Identifier.class_type; 272 | doc: Comment.docs; 273 | virtual_: bool; 274 | params: TypeDecl.param list; 275 | expr: expr; 276 | expansion: ClassSignature.t option; } 277 | 278 | end = ClassType 279 | 280 | (** {3 Class Signatures} *) 281 | 282 | and ClassSignature : sig 283 | 284 | type item = 285 | | Method of Method.t 286 | | InstanceVariable of InstanceVariable.t 287 | | Constraint of TypeExpr.t * TypeExpr.t 288 | | Inherit of ClassType.expr 289 | | Comment of Comment.docs_or_stop 290 | 291 | type t = 292 | { self: TypeExpr.t option; 293 | items: item list; } 294 | 295 | end = ClassSignature 296 | 297 | (** {3 Methods} *) 298 | 299 | and Method : sig 300 | 301 | type t = 302 | { id: Identifier.method_; 303 | doc: Comment.docs; 304 | private_: bool; 305 | virtual_: bool; 306 | type_: TypeExpr.t; } 307 | 308 | end = Method 309 | 310 | (** {3 Instance variables} *) 311 | 312 | and InstanceVariable : sig 313 | 314 | type t = 315 | { id: Identifier.instance_variable; 316 | doc: Comment.docs; 317 | mutable_: bool; 318 | virtual_: bool; 319 | type_: TypeExpr.t; } 320 | 321 | end = InstanceVariable 322 | 323 | (** {3 Type expressions} *) 324 | 325 | and TypeExpr : sig 326 | 327 | module Variant : sig 328 | 329 | type kind = 330 | | Fixed 331 | | Closed of string list 332 | | Open 333 | 334 | type element = 335 | | Type of TypeExpr.t 336 | | Constructor of string * bool * TypeExpr.t list 337 | 338 | type t = 339 | { kind: kind; 340 | elements: element list;} 341 | 342 | end 343 | 344 | module Object : sig 345 | 346 | type method_ = 347 | { name: string; 348 | type_: TypeExpr.t; } 349 | 350 | type field = 351 | | Method of method_ 352 | | Inherit of TypeExpr.t 353 | 354 | type t = 355 | { fields: field list; 356 | open_ : bool; } 357 | 358 | end 359 | 360 | module Package : sig 361 | 362 | type substitution = Fragment.type_ * TypeExpr.t 363 | 364 | type t = 365 | { path: Path.module_type; 366 | substitutions: substitution list; } 367 | 368 | end 369 | 370 | type label = 371 | | Label of string 372 | | Optional of string 373 | 374 | type t = 375 | | Var of string 376 | | Any 377 | | Alias of t * string 378 | | Arrow of label option * t * t 379 | | Tuple of t list 380 | | Constr of Path.type_ * t list 381 | | Variant of TypeExpr.Variant.t 382 | | Object of TypeExpr.Object.t 383 | | Class of Path.class_type * t list 384 | | Poly of string list * t 385 | | Package of TypeExpr.Package.t 386 | 387 | end = TypeExpr 388 | 389 | (** {3 Compilation units} *) 390 | 391 | module rec Compilation_unit : sig 392 | 393 | module Import : sig 394 | 395 | type t = 396 | | Unresolved of string * Digest.t option 397 | | Resolved of Root.t 398 | 399 | end 400 | 401 | module Source : sig 402 | 403 | type t = 404 | { file: string; 405 | build_dir: string; 406 | digest: Digest.t; } 407 | 408 | end 409 | 410 | module Packed : sig 411 | 412 | type item = 413 | { id: Identifier.module_; 414 | path: Path.module_; } 415 | 416 | type t = item list 417 | 418 | end 419 | 420 | type content = 421 | | Module of Signature.t 422 | | Pack of Packed.t 423 | 424 | type t = 425 | { id: Identifier.module_; 426 | doc: Comment.docs; 427 | digest: Digest.t; 428 | imports: Import.t list; 429 | source: Source.t option; 430 | interface: bool; 431 | hidden: bool; 432 | content: content; 433 | expansion: Signature.t option; } 434 | 435 | end = Compilation_unit 436 | 437 | module rec Page : sig 438 | type t = 439 | { name: Identifier.page; 440 | content: Comment.docs; 441 | digest: Digest.t; } 442 | end = Page 443 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/location_.ml: -------------------------------------------------------------------------------- 1 | type point = { 2 | line : int; 3 | column : int; 4 | } 5 | 6 | type span = { 7 | file : string; 8 | start : point; 9 | end_ : point; 10 | } 11 | 12 | type +'a with_location = { 13 | location : span; 14 | value : 'a; 15 | } 16 | 17 | let at : span -> 'a -> 'a with_location = fun location value -> 18 | {location; value} 19 | 20 | let location : 'a with_location -> span = fun {location; _} -> 21 | location 22 | 23 | let value : 'a with_location -> 'a = fun {value; _} -> 24 | value 25 | 26 | let map : ('a -> 'b) -> 'a with_location -> 'b with_location = 27 | fun f annotated -> 28 | {annotated with value = f annotated.value} 29 | 30 | let same : _ with_location -> 'b -> 'b with_location = fun annotated value -> 31 | {annotated with value} 32 | 33 | let span : span list -> span = fun spans -> 34 | match spans with 35 | | [] -> 36 | { 37 | file = "_none_"; 38 | start = { 39 | line = 1; 40 | column = 0; 41 | }; 42 | end_ = { 43 | line = 1; 44 | column = 0; 45 | }; 46 | } 47 | | first::spans -> 48 | let last = List.fold_left (fun _ span -> span) first spans in 49 | { 50 | file = first.file; 51 | start = first.start; 52 | end_ = last.end_; 53 | } 54 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/odoc_lexer.mli: -------------------------------------------------------------------------------- 1 | type input = { 2 | file : string; 3 | offset_to_location : int -> Location_.point; 4 | lexbuf : Lexing.lexbuf; 5 | } 6 | 7 | val token : input -> Lexing.lexbuf -> Token.t Location_.with_location 8 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/parse_error.ml: -------------------------------------------------------------------------------- 1 | module Location = Location_ 2 | module Error = Error 3 | 4 | 5 | 6 | let bad_markup : string -> Location.span -> Error.t = 7 | Error.format "'%s': bad markup" 8 | 9 | let bad_section_level : string -> Location.span -> Error.t = 10 | Error.format "'%s': bad section level (2-4 allowed)" 11 | 12 | let cannot_be_empty : what:string -> Location.span -> Error.t = fun ~what -> 13 | Error.format "%s cannot be empty" what 14 | 15 | let must_begin_on_its_own_line : what:string -> Location.span -> Error.t = 16 | fun ~what -> 17 | Error.format "%s must begin on its own line" what 18 | 19 | let must_be_followed_by_whitespace : what:string -> Location.span -> Error.t = 20 | fun ~what -> 21 | Error.format "%s must be followed by space, a tab, or a new line" what 22 | 23 | let not_allowed 24 | : ?suggestion:string -> what:string -> in_what:string -> Location.span -> 25 | Error.t = 26 | fun ?suggestion ~what ~in_what location -> 27 | let message = Printf.sprintf "%s is not allowed in %s" what in_what in 28 | let message = 29 | match suggestion with 30 | | None -> message 31 | | Some suggestion -> Printf.sprintf "%s\nSuggestion: %s" message suggestion 32 | in 33 | Error.make message location 34 | 35 | let no_leading_whitespace_in_verbatim : Location.span -> Error.t = 36 | Error.make "'{v' must be followed by whitespace" 37 | 38 | let no_trailing_whitespace_in_verbatim : Location.span -> Error.t = 39 | Error.make "'v}' must be preceded by whitespace" 40 | 41 | let only_one_title_allowed : Location.span -> Error.t = 42 | Error.make "only one title-level heading is allowed" 43 | 44 | let sections_not_allowed : Location.span -> Error.t = 45 | Error.make "sections not allowed in this comment" 46 | 47 | let stray_at : Location.span -> Error.t = 48 | Error.make "stray '@'" 49 | 50 | let stray_cr : Location.span -> Error.t = 51 | Error.make "stray '\\r' (carriage return character)" 52 | 53 | let truncated_before : Location.span -> Error.t = 54 | Error.make "'@before' expects version number on the same line" 55 | 56 | let truncated_param : Location.span -> Error.t = 57 | Error.make "'@param' expects parameter name on the same line" 58 | 59 | let truncated_raise : Location.span -> Error.t = 60 | Error.make "'@raise' expects exception constructor on the same line" 61 | 62 | let truncated_see : Location.span -> Error.t = 63 | Error.make "'@see' must be followed by , 'file', or \"document title\"" 64 | 65 | let unknown_tag : string -> Location.span -> Error.t = 66 | Error.format "unknown tag '%s'" 67 | 68 | let unpaired_right_brace : Location.span -> Error.t = 69 | Error.make "unpaired '}' (end of markup)" 70 | 71 | let unpaired_right_bracket : Location.span -> Error.t = 72 | Error.make "unpaired ']' (end of code)" 73 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/parser_.ml: -------------------------------------------------------------------------------- 1 | (* odoc uses an ocamllex lexer. The "engine" for such lexers is the standard 2 | [Lexing] module. 3 | 4 | As the [Lexing] module reads the input, it keeps track of only the byte 5 | offset into the input. It is normally the job of each particular lexer 6 | implementation to decide which character sequences count as newlines, and 7 | keep track of line/column locations. This is usually done by writing several 8 | extra regular expressions, and calling [Lexing.new_line] at the right time. 9 | 10 | Keeping track of newlines like this makes the odoc lexer somewhat too 11 | diffiult to read, however. To factor the aspect of keeping track of newlines 12 | fully out of the odoc lexer, instead of having it keep track of newlines as 13 | it's scanning the input, the input is pre-scanned before feeding it into the 14 | lexer. A table of all the newlines is assembled, and used to convert offsets 15 | into line/column pairs after the lexer emits tokens. 16 | 17 | [offset_to_location ~input ~comment_location offset] converts the byte 18 | [offset], relative to the beginning of a comment, into a location, relative 19 | to the beginning of the file containing the comment. [input] is the comment 20 | text, and [comment_location] is the location of the comment within its file. 21 | The function is meant to be partially applied to its first two arguments, at 22 | which point it creates the table described above. The remaining function is 23 | then passed to the lexer, so it can apply the table to its emitted tokens. *) 24 | let offset_to_location 25 | : input:string -> comment_location:Lexing.position -> 26 | (int -> Location_.point) = 27 | fun ~input ~comment_location -> 28 | 29 | let rec find_newlines line_number input_index newlines_accumulator = 30 | if input_index >= String.length input then 31 | newlines_accumulator 32 | else 33 | (* This is good enough to detect CR-LF also. *) 34 | if input.[input_index] = '\n' then 35 | find_newlines 36 | (line_number + 1) (input_index + 1) 37 | ((line_number + 1, input_index + 1)::newlines_accumulator) 38 | else 39 | find_newlines line_number (input_index + 1) newlines_accumulator 40 | in 41 | 42 | let reversed_newlines : (int * int) list = 43 | find_newlines 1 0 [(1, 0)] in 44 | 45 | fun byte_offset -> 46 | let rec scan_to_last_newline reversed_newlines_prefix = 47 | match reversed_newlines_prefix with 48 | | [] -> 49 | assert false 50 | | (line_in_comment, line_start_offset)::prefix -> 51 | if line_start_offset > byte_offset then 52 | scan_to_last_newline prefix 53 | else 54 | let column_in_comment = byte_offset - line_start_offset in 55 | let line_in_file = 56 | line_in_comment + comment_location.Lexing.pos_lnum - 1 in 57 | let column_in_file = 58 | if line_in_comment = 1 then 59 | column_in_comment + 60 | comment_location.Lexing.pos_cnum - 61 | comment_location.Lexing.pos_bol 62 | else 63 | column_in_comment 64 | in 65 | {Location_.line = line_in_file; column = column_in_file} 66 | in 67 | scan_to_last_newline reversed_newlines 68 | 69 | 70 | 71 | let parse_comment 72 | ~permissive ~sections_allowed ~containing_definition ~location ~text = 73 | 74 | let token_stream = 75 | let lexbuf = Lexing.from_string text in 76 | let offset_to_location = 77 | offset_to_location ~input:text ~comment_location:location in 78 | let input : Odoc_lexer.input = 79 | { 80 | file = location.Lexing.pos_fname; 81 | offset_to_location; 82 | lexbuf; 83 | } 84 | in 85 | Stream.from (fun _token_index -> Some (Odoc_lexer.token input lexbuf)) 86 | in 87 | 88 | match Syntax.parse token_stream with 89 | | Error.Error error -> 90 | {Error.result = Error.Error error; warnings = []} 91 | | Ok ast -> 92 | Semantics.ast_to_comment 93 | ~permissive 94 | ~sections_allowed 95 | ~parent_of_sections:containing_definition 96 | ast 97 | 98 | let errors_to_warnings parsed = 99 | match Error.(parsed.result) with 100 | | Error.Ok _ -> 101 | parsed 102 | 103 | | Error fatal_error -> 104 | { 105 | result = Ok []; 106 | warnings = fatal_error::parsed.warnings; 107 | } 108 | 109 | 110 | 111 | type sections_allowed = Ast.sections_allowed 112 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/parser_.mli: -------------------------------------------------------------------------------- 1 | type sections_allowed = Ast.sections_allowed 2 | 3 | val parse_comment : 4 | permissive:bool -> 5 | sections_allowed:sections_allowed -> 6 | containing_definition:Paths.Identifier.label_parent -> 7 | location:Lexing.position -> 8 | text:string -> 9 | ((Comment.docs, Error.t) Error.result) Error.with_warnings 10 | 11 | (** Converts fatal errors to warnings for now, by emitting a blank comment. This 12 | is a temporary measure, because the code that drives the parser does not yet 13 | have proper error handling written. *) 14 | val errors_to_warnings : 15 | ((Comment.docs, Error.t) Error.result) Error.with_warnings -> 16 | ((Comment.docs, Error.t) Error.result) Error.with_warnings 17 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/root.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Leo White 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | 18 | 19 | let contains_double_underscore s = 20 | let len = String.length s in 21 | let rec aux i = 22 | if i > len - 2 then false else 23 | if s.[i] = '_' && s.[i + 1] = '_' then true 24 | else aux (i + 1) 25 | in 26 | aux 0 27 | 28 | module Package = 29 | struct 30 | type t = string 31 | 32 | module Table = Hashtbl.Make(struct 33 | type nonrec t = t 34 | let equal : t -> t -> bool = (=) 35 | let hash : t -> int = Hashtbl.hash 36 | end) 37 | end 38 | 39 | module Odoc_file = 40 | struct 41 | type m = {name : string; hidden : bool} 42 | type t = 43 | | Page of string 44 | | Compilation_unit of m 45 | 46 | let create_unit ~force_hidden name = 47 | let hidden = force_hidden || contains_double_underscore name in 48 | Compilation_unit {name; hidden} 49 | 50 | let create_page name = Page name 51 | 52 | let name = function 53 | | Page name 54 | | Compilation_unit {name; _} -> name 55 | end 56 | 57 | type t = { 58 | package : Package.t; 59 | file : Odoc_file.t; 60 | digest : Digest.t; 61 | } 62 | 63 | let equal : t -> t -> bool = (=) 64 | let hash : t -> int = Hashtbl.hash 65 | 66 | let to_string t = Printf.sprintf "%s::%s" t.package (Odoc_file.name t.file) 67 | 68 | module Hash_table = 69 | Hashtbl.Make 70 | (struct 71 | type nonrec t = t 72 | let equal = equal 73 | let hash = hash 74 | end) 75 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/root.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Leo White 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** A root can be seen as a unique representative of a odoc file. 18 | 19 | {{!t}Roots} are used by doc-ock (at the root of every resolved 20 | path/identifier/reference) and present at the beginning of every [.odoc] 21 | file. 22 | *) 23 | 24 | module Package : 25 | sig 26 | type t = string 27 | end 28 | 29 | module Odoc_file : 30 | sig 31 | type m = {name : string; hidden : bool} 32 | type t = 33 | | Page of string 34 | | Compilation_unit of m 35 | 36 | val create_unit : force_hidden:bool -> string -> t 37 | val create_page : string -> t 38 | 39 | val name : t -> string 40 | end 41 | 42 | type t = { 43 | package : Package.t; 44 | file : Odoc_file.t; 45 | digest : Digest.t; 46 | } 47 | 48 | val equal : t -> t -> bool 49 | val hash : t -> int 50 | 51 | val to_string : t -> string 52 | 53 | module Hash_table : Hashtbl.S with type key = t 54 | 55 | val contains_double_underscore : string -> bool 56 | (* not the best place for this but. *) 57 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/semantics.mli: -------------------------------------------------------------------------------- 1 | val ast_to_comment : 2 | permissive:bool -> 3 | sections_allowed:Ast.sections_allowed -> 4 | parent_of_sections:Paths.Identifier.label_parent -> 5 | Ast.docs -> 6 | ((Comment.docs, Error.t) Error.result) Error.with_warnings 7 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/syntax.mli: -------------------------------------------------------------------------------- 1 | val parse : 2 | (Token.t Location_.with_location) Stream.t -> 3 | (Ast.docs, Error.t) Error.result 4 | -------------------------------------------------------------------------------- /src/vendor/odoc_parser/token.ml: -------------------------------------------------------------------------------- 1 | (* This module contains the token type, emitted by the lexer, and consumed by 2 | the comment syntax parser. It also contains two functions that format tokens 3 | for error messages. *) 4 | 5 | 6 | 7 | type section_heading = [ 8 | `Begin_section_heading of int * string option 9 | ] 10 | 11 | type tag = [ 12 | | `Tag of [ 13 | | `Author of string 14 | | `Deprecated 15 | | `Param of string 16 | | `Raise of string 17 | | `Return 18 | | `See of [ `Url | `File | `Document ] * string 19 | | `Since of string 20 | | `Before of string 21 | | `Version of string 22 | | `Canonical of string 23 | | `Inline 24 | | `Open 25 | | `Closed 26 | ] 27 | ] 28 | 29 | type t = [ 30 | (* End of input. *) 31 | | `End 32 | 33 | (* Runs of whitespace. [Blank_line] is any run of whitespace that contains two 34 | or more newline characters. [Single_newline] is any run of whitespace that 35 | contains exactly one newline character. [Space] is any run of whitespace 36 | that contains no newline characters. 37 | 38 | It is an important invariant in the parser that no adjacent whitespace 39 | tokens are emitted by the lexer. Otherwise, there would be the need for 40 | unbounded lookahead, a (co-?)ambiguity between 41 | [Single_newline Single_newline] and [Blank_line], and other problems. *) 42 | | `Space 43 | | `Single_newline 44 | | `Blank_line 45 | 46 | (* A right curly brace ([}]), i.e. end of markup. *) 47 | | `Right_brace 48 | 49 | (* Words are anything that is not whitespace or markup. Markup symbols can be 50 | be part of words if escaped. 51 | 52 | Words can contain plus and minus symbols, but those are emitted as [Plus] 53 | and [Minus] tokens. The parser combines plus and minus into words, except 54 | when they appear first on a line, in which case the tokens are list item 55 | bullets. *) 56 | | `Word of string 57 | | `Code_span of string 58 | | `Begin_style of Comment.style 59 | 60 | (* Other inline element markup. *) 61 | | `Simple_reference of string 62 | | `Begin_reference_with_replacement_text of string 63 | | `Simple_link of string 64 | | `Begin_link_with_replacement_text of string 65 | 66 | (* Leaf block element markup. *) 67 | | `Code_block of string 68 | | `Verbatim of string 69 | | `Modules of string 70 | | `Example of (string * string) 71 | | `Doc of string 72 | 73 | (* List markup. *) 74 | | `Begin_list of [ `Unordered | `Ordered ] 75 | | `Begin_list_item of [ `Li | `Dash ] 76 | | `Minus 77 | | `Plus 78 | 79 | | section_heading 80 | | tag 81 | ] 82 | 83 | 84 | 85 | let print : [< t ] -> string = function 86 | | `Begin_style `Bold -> 87 | "'{b'" 88 | | `Begin_style `Italic -> 89 | "'{i'" 90 | | `Begin_style `Emphasis -> 91 | "'{e'" 92 | | `Begin_style `Superscript -> 93 | "'{^'" 94 | | `Begin_style `Subscript -> 95 | "'{_'" 96 | | `Begin_reference_with_replacement_text _ -> 97 | "'{{!'" 98 | | `Begin_link_with_replacement_text _ -> 99 | "'{{:'" 100 | | `Begin_list_item `Li -> 101 | "'{li ...}'" 102 | | `Begin_list_item `Dash -> 103 | "'{- ...}'" 104 | | `Minus -> 105 | "'-'" 106 | | `Plus -> 107 | "'+'" 108 | | `Begin_section_heading (level, label) -> 109 | let label = 110 | match label with 111 | | None -> "" 112 | | Some label -> ":" ^ label 113 | in 114 | Printf.sprintf "'{%i%s'" level label 115 | | `Tag (`Author _) -> 116 | "'@author'" 117 | | `Tag `Deprecated -> 118 | "'@deprecated'" 119 | | (`Example _) -> 120 | "'@example'" 121 | | (`Doc _) -> 122 | "'@doc'" 123 | | `Tag (`Param _) -> 124 | "'@param'" 125 | | `Tag (`Raise _) -> 126 | "'@raise'" 127 | | `Tag `Return -> 128 | "'@return'" 129 | | `Tag (`See _) -> 130 | "'@see'" 131 | | `Tag (`Since _) -> 132 | "'@since'" 133 | | `Tag (`Before _) -> 134 | "'@before'" 135 | | `Tag (`Version _) -> 136 | "'@version'" 137 | | `Tag (`Canonical _) -> 138 | "'@canonical'" 139 | | `Tag `Inline -> 140 | "'@inline'" 141 | | `Tag `Open -> 142 | "'@open'" 143 | | `Tag `Closed -> 144 | "'@closed'" 145 | 146 | (* [`Minus] and [`Plus] are interpreted as if they start list items. Therefore, 147 | for error messages based on [Token.describe] to be accurate, formatted 148 | [`Minus] and [`Plus] should always be plausibly list item bullets. *) 149 | let describe : [< t | `Comment ] -> string = function 150 | | `Word w -> 151 | Printf.sprintf "'%s'" w 152 | | `Code_span _ -> 153 | "'[...]' (code)" 154 | | `Begin_style `Bold -> 155 | "'{b ...}' (boldface text)" 156 | | `Begin_style `Italic -> 157 | "'{i ...}' (italic text)" 158 | | `Begin_style `Emphasis -> 159 | "'{e ...}' (emphasized text)" 160 | | `Begin_style `Superscript -> 161 | "'{^...}' (superscript)" 162 | | `Begin_style `Subscript -> 163 | "'{_...}' (subscript)" 164 | | `Simple_reference _ -> 165 | "'{!...}' (cross-reference)" 166 | | `Begin_reference_with_replacement_text _ -> 167 | "'{{!...} ...}' (cross-reference)" 168 | | `Simple_link _ -> 169 | "'{:...} (external link)'" 170 | | `Begin_link_with_replacement_text _ -> 171 | "'{{:...} ...}' (external link)" 172 | | `End -> 173 | "end of text" 174 | | `Space -> 175 | "whitespace" 176 | | `Single_newline -> 177 | "line break" 178 | | `Blank_line -> 179 | "blank line" 180 | | `Right_brace -> 181 | "'}'" 182 | | `Code_block _ -> 183 | "'{[...]}' (code block)" 184 | | `Verbatim _ -> 185 | "'{v ... v}' (verbatim text)" 186 | | `Modules _ -> 187 | "'{!modules ...}'" 188 | | `Begin_list `Unordered -> 189 | "'{ul ...}' (bulleted list)" 190 | | `Begin_list `Ordered -> 191 | "'{ol ...}' (numbered list)" 192 | | `Begin_list_item `Li -> 193 | "'{li ...}' (list item)" 194 | | `Begin_list_item `Dash -> 195 | "'{- ...}' (list item)" 196 | | `Minus -> 197 | "'-' (bulleted list item)" 198 | | `Plus -> 199 | "'+' (numbered list item)" 200 | | `Begin_section_heading (level, _) -> 201 | Printf.sprintf "'{%i ...}' (section heading)" level 202 | | `Tag (`Author _) -> 203 | "'@author'" 204 | | `Tag `Deprecated -> 205 | "'@deprecated'" 206 | | (`Example _) -> 207 | "'@example'" 208 | | (`Doc _) -> 209 | "'@doc'" 210 | | `Tag (`Param _) -> 211 | "'@param'" 212 | | `Tag (`Raise _) -> 213 | "'@raise'" 214 | | `Tag `Return -> 215 | "'@return'" 216 | | `Tag (`See _) -> 217 | "'@see'" 218 | | `Tag (`Since _) -> 219 | "'@since'" 220 | | `Tag (`Before _) -> 221 | "'@before'" 222 | | `Tag (`Version _) -> 223 | "'@version'" 224 | | `Tag (`Canonical _) -> 225 | "'@canonical'" 226 | | `Tag `Inline -> 227 | "'@inline'" 228 | | `Tag `Open -> 229 | "'@open'" 230 | | `Tag `Closed -> 231 | "'@closed'" 232 | | `Comment -> 233 | "top-level text" 234 | -------------------------------------------------------------------------------- /src/vendor/omd/Readme.md: -------------------------------------------------------------------------------- 1 | The source code in this directory was taken, with some modifications, from the `omd` project (https://github.com/ocaml/omd/tree/master/src). 2 | 3 | It is under the ISC license. -------------------------------------------------------------------------------- /src/vendor/omd/omd.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | module Representation = Omd_representation 9 | 10 | include Omd_representation 11 | include Omd_backend 12 | 13 | let of_input lex ?extensions:e ?default_lang:d s = 14 | let module E = Omd_parser.Default_env(struct end) in 15 | let module Parser = Omd_parser.Make( 16 | struct 17 | include E 18 | let extensions = match e with Some x -> x | None -> E.extensions 19 | let default_lang = match d with Some x -> x | None -> E.default_lang 20 | end 21 | ) in 22 | let md = 23 | Parser.parse (lex s) 24 | in 25 | Parser.make_paragraphs md 26 | 27 | let of_string = of_input Omd_lexer.lex 28 | 29 | let to_html : 30 | ?override:(Omd_representation.element -> string option) -> 31 | ?pindent:bool -> 32 | ?nl2br:bool -> 33 | ?cs:code_stylist -> 34 | t -> 35 | string 36 | = 37 | html_of_md 38 | 39 | let to_text : t -> string = text_of_md 40 | 41 | let to_markdown : t -> string = markdown_of_md 42 | 43 | 44 | let rec set_default_lang lang = function 45 | | Code("", code) :: tl -> Code(lang, code) :: set_default_lang lang tl 46 | | Code_block("", code) :: tl -> Code_block(lang, code) 47 | :: set_default_lang lang tl 48 | (* Recurse on all elements even though code (blocks) are not allowed 49 | everywhere. *) 50 | | H1 t :: tl -> H1(set_default_lang lang t) :: set_default_lang lang tl 51 | | H2 t :: tl -> H2(set_default_lang lang t) :: set_default_lang lang tl 52 | | H3 t :: tl -> H3(set_default_lang lang t) :: set_default_lang lang tl 53 | | H4 t :: tl -> H4(set_default_lang lang t) :: set_default_lang lang tl 54 | | H5 t :: tl -> H5(set_default_lang lang t) :: set_default_lang lang tl 55 | | H6 t :: tl -> H6(set_default_lang lang t) :: set_default_lang lang tl 56 | | Paragraph t :: tl -> Paragraph(set_default_lang lang t) 57 | :: set_default_lang lang tl 58 | | Emph t :: tl -> Emph(set_default_lang lang t) :: set_default_lang lang tl 59 | | Bold t :: tl -> Bold(set_default_lang lang t) :: set_default_lang lang tl 60 | | Ul t :: tl -> Ul(List.map (set_default_lang lang) t) 61 | :: set_default_lang lang tl 62 | | Ol t :: tl -> Ol(List.map (set_default_lang lang) t) 63 | :: set_default_lang lang tl 64 | | Ulp t :: tl -> Ulp(List.map (set_default_lang lang) t) 65 | :: set_default_lang lang tl 66 | | Olp t :: tl -> Olp(List.map (set_default_lang lang) t) 67 | :: set_default_lang lang tl 68 | | Url(href, t, title) :: tl -> Url(href, set_default_lang lang t, title) 69 | :: set_default_lang lang tl 70 | | Blockquote t :: tl -> Blockquote(set_default_lang lang t) 71 | :: set_default_lang lang tl 72 | (* Elements that do not contain Markdown. *) 73 | | (Text _|Code _|Code_block _|Br|Hr|NL|Ref _|Img_ref _|Raw _|Raw_block _ 74 | |Html _|Html_block _|Html_comment _|Img _|X _) as e :: tl -> 75 | e :: set_default_lang lang tl 76 | | [] -> [] 77 | 78 | 79 | (* Table of contents 80 | ***********************************************************************) 81 | 82 | (* Given a list of headers — in the order of the document — go to the 83 | requested subsection. We first seek for the [number]th header at 84 | [level]. *) 85 | let rec find_start headers level number subsections = 86 | match headers with 87 | | [] -> [] 88 | | (H1 _, _, _) :: tl -> deal_with_header 1 headers tl level number subsections 89 | | (H2 _, _, _) :: tl -> deal_with_header 2 headers tl level number subsections 90 | | (H3 _, _, _) :: tl -> deal_with_header 3 headers tl level number subsections 91 | | (H4 _, _, _) :: tl -> deal_with_header 4 headers tl level number subsections 92 | | (H5 _, _, _) :: tl -> deal_with_header 5 headers tl level number subsections 93 | | (H6 _, _, _) :: tl -> deal_with_header 6 headers tl level number subsections 94 | | _ :: _ -> assert false 95 | 96 | and deal_with_header h_level headers tl level number subsections = 97 | if h_level > level then (* Skip, right [level]-header not yet reached. *) 98 | if number = 0 then 99 | (* Assume empty section at [level], do not consume token. *) 100 | (match subsections with 101 | | [] -> headers (* no subsection to find *) 102 | | n :: subsections -> find_start headers (level + 1) n subsections) 103 | else find_start tl level number subsections 104 | else if h_level = level then ( 105 | (* At proper [level]. Have we reached the [number] one? *) 106 | if number <= 1 then ( 107 | match subsections with 108 | | [] -> tl (* no subsection to find *) 109 | | n :: subsections -> find_start tl (level + 1) n subsections 110 | ) 111 | else find_start tl level (number - 1) subsections 112 | ) 113 | else (* h_level < level *) 114 | [] (* Sought [level] has not been found in the current section *) 115 | 116 | (* Assume we are at the start of the headers we are interested in. 117 | Return the list of TOC entries for [min_level] and the [headers] 118 | not used for the TOC entries. *) 119 | let rec make_toc (headers:(element*string*string)list) ~min_level ~max_level = 120 | if min_level > max_level then [], headers 121 | else ( 122 | match headers with 123 | | [] -> [], [] 124 | | (H1 t, id, _) :: tl -> toc_entry headers 1 t id tl ~min_level ~max_level 125 | | (H2 t, id, _) :: tl -> toc_entry headers 2 t id tl ~min_level ~max_level 126 | | (H3 t, id, _) :: tl -> toc_entry headers 3 t id tl ~min_level ~max_level 127 | | (H4 t, id, _) :: tl -> toc_entry headers 4 t id tl ~min_level ~max_level 128 | | (H5 t, id, _) :: tl -> toc_entry headers 5 t id tl ~min_level ~max_level 129 | | (H6 t, id, _) :: tl -> toc_entry headers 6 t id tl ~min_level ~max_level 130 | | _ :: _ -> assert false 131 | ) 132 | and toc_entry headers h_level t id tl ~min_level ~max_level = 133 | if h_level > max_level then (* too deep, skip *) 134 | make_toc tl ~min_level ~max_level 135 | else if h_level < min_level then 136 | (* section we wanted the TOC for is finished, do not comsume the token *) 137 | [], headers 138 | else if h_level = min_level then ( 139 | let sub_toc, tl = make_toc tl ~min_level:(min_level + 1) ~max_level in 140 | let toc_entry = match sub_toc with 141 | | [] -> [Url("#" ^ id, t, ""); NL] 142 | | _ -> [Url("#" ^ id, t, ""); NL; Ul sub_toc; NL] in 143 | let toc, tl = make_toc tl ~min_level ~max_level in 144 | toc_entry :: toc, tl 145 | ) else (* h_level > min_level *) 146 | let sub_toc, tl = make_toc headers ~min_level:(min_level + 1) ~max_level in 147 | let toc, tl = make_toc tl ~min_level ~max_level in 148 | [Ul sub_toc] :: toc, tl 149 | 150 | let toc ?(start=[]) ?(depth=2) md = 151 | if depth < 1 then invalid_arg "Omd.toc: ~depth must be >= 1"; 152 | let headers = Omd_backend.headers_of_md ~remove_header_links:true md in 153 | let headers = match start with 154 | | [] -> headers 155 | | number :: subsections -> 156 | if number < 0 then invalid_arg("Omd.toc: level 1 start must be >= 0"); 157 | find_start headers 1 number subsections in 158 | let len = List.length start in 159 | let toc, _ = make_toc headers 160 | ~min_level:(len + 1) ~max_level:(len + depth) in 161 | match toc with 162 | | [] -> [] 163 | | _ -> [Ul(toc)] 164 | -------------------------------------------------------------------------------- /src/vendor/omd/omd.mli: -------------------------------------------------------------------------------- 1 | (** A markdown parser in OCaml, with no extra dependencies. 2 | 3 | This module represents this entire Markdown library written in 4 | OCaml only. 5 | 6 | Its main purpose is to allow you to use the Markdown library while 7 | keeping you away from the other modules. 8 | 9 | If you want to extend the Markdown parser, you can do it without 10 | accessing any module of this library but this one, and by doing 11 | so, you are free from having to maintain a fork of this library. 12 | 13 | N.B. This module is supposed to be reentrant, 14 | if it's not then please report the bug. *) 15 | 16 | 17 | (************************************************************************) 18 | (** {2 Representation of Markdown documents} *) 19 | 20 | module Representation = Omd_representation 21 | 22 | type t = element list 23 | (** Representation of a Markdown document. *) 24 | 25 | and ref_container = 26 | (< add_ref: string -> string -> string -> unit ; 27 | get_ref : string -> (string*string) option; 28 | get_all : (string * (string * string)) list; 29 | >) 30 | 31 | (** A element of a Markdown document. *) 32 | and element = Omd_representation.element = 33 | | H1 of t (** Header of level 1 *) 34 | | H2 of t (** Header of level 2 *) 35 | | H3 of t (** Header of level 3 *) 36 | | H4 of t (** Header of level 4 *) 37 | | H5 of t (** Header of level 5 *) 38 | | H6 of t (** Header of level 6 *) 39 | | Paragraph of t 40 | (** A Markdown paragraph (must be enabled in {!of_string}) *) 41 | | Text of string (** Text. *) 42 | | Emph of t (** Emphasis (italic) *) 43 | | Bold of t (** Bold *) 44 | | Ul of t list (** Unumbered list *) 45 | | Ol of t list (** Ordered (i.e. numbered) list *) 46 | | Ulp of t list 47 | | Olp of t list 48 | | Code of name * string 49 | (** [Code(lang, code)] represent [code] within the text (Markdown: 50 | `code`). The language [lang] cannot be specified from Markdown, 51 | it can be from {!of_string} though or when programatically 52 | generating Markdown documents. Beware that the [code] is taken 53 | verbatim from Markdown and may contain characters that must be 54 | escaped for HTML. *) 55 | | Code_block of name * string 56 | (** [Code_block(lang, code)]: a code clock (e.g. indented by 4 57 | spaces in the text). The first parameter [lang] is the language 58 | if specified. Beware that the [code] is taken verbatim from 59 | Markdown and may contain characters that must be escaped for 60 | HTML. *) 61 | | Br (** (Forced) line break *) 62 | | Hr (** Horizontal rule *) 63 | | NL (** Newline character. Newline characters that act 64 | like delimiters (e.g. for paragraphs) are removed from the AST. *) 65 | | Url of href * t * title 66 | | Ref of ref_container * name * string * fallback 67 | | Img_ref of ref_container * name * alt * fallback 68 | | Html of name * (string * string option) list * t 69 | | Html_block of name * (string * string option) list * t 70 | | Html_comment of string 71 | (** An HTML comment, including "". *) 72 | | Raw of string 73 | (** Raw: something that shall never be converted *) 74 | | Raw_block of string 75 | (** Raw_block: a block with contents that shall never be converted *) 76 | | Blockquote of t (** Quoted block *) 77 | | Img of alt * src * title 78 | | X of (< (* extension of [element]. *) 79 | name: string; 80 | (* N.B. [to_html] means that htmlentities will not 81 | be applied to its output. *) 82 | to_html: ?indent:int -> (t -> string) -> t -> string option; 83 | to_sexpr: (t -> string) -> t -> string option; 84 | to_t: t -> t option >) 85 | 86 | and fallback = < to_string : string ; to_t : t > 87 | (** Fallback for references in case they refer to non-existant references *) 88 | 89 | and name = string 90 | (** Markdown reference name. *) 91 | 92 | and alt = string 93 | (** HTML img tag attribute. *) 94 | 95 | and src = string 96 | (** HTML attribute. *) 97 | 98 | and href = string 99 | (** HTML attribute. *) 100 | 101 | and title = string 102 | (** HTML attribute. *) 103 | 104 | type code_stylist = lang:string -> string -> string 105 | (** Function that takes a language name and some code and returns 106 | that code with style. *) 107 | 108 | 109 | (************************************************************************) 110 | (** {2 Input and Output} *) 111 | 112 | val of_string : ?extensions:Omd_representation.extensions -> 113 | ?default_lang: name -> 114 | string -> t 115 | (** [of_string s] returns the Markdown representation of the string 116 | [s]. 117 | 118 | @param lang language for blocks of code where it was not 119 | specified. Default: [""]. 120 | 121 | If you want to use a custom lexer or parser, use {!Omd_lexer.lex} 122 | and {!Omd_parser.parse}. *) 123 | 124 | val set_default_lang : name -> t -> t 125 | (** [set_default_lang lang md] return a copy of [md] where the 126 | language of all [Code] or [Code_block] with an empty language is 127 | set to [lang]. *) 128 | 129 | val to_html : 130 | ?override:(Omd_representation.element -> string option) -> 131 | ?pindent:bool -> ?nl2br:bool -> ?cs:code_stylist -> t -> string 132 | (** Translate markdown representation into raw HTML. If you need a 133 | full HTML representation, you mainly have to figure out how to 134 | convert [Html of string] and [Html_block of string] 135 | into your HTML representation. *) 136 | 137 | val to_markdown : t -> string 138 | (** Translate markdown representation into textual markdown. *) 139 | 140 | val to_text : t -> string 141 | (** Translate markdown representation into raw text. *) 142 | 143 | 144 | (************************************************************************) 145 | (** {2 Tansforming Markdown documents} *) 146 | 147 | val toc : ?start:int list -> ?depth:int -> t -> t 148 | (** [toc md] returns [toc] a table of contents for [md]. 149 | 150 | @param start gives the section for which the TOC must be built. 151 | For example [~start:[2;3]] will build the TOC for subsections of 152 | the second [H1] header, and within that section, the third [h2] 153 | header. If a number is [0], it means to look for the first 154 | section at that level but stop if one encounters any other 155 | subsection. If no subsection exists, an empty TOC [[]] will be 156 | returned. Default: [[]] i.e. list all sections, starting with the 157 | first [H1]. 158 | 159 | @param depth the table of contents. Default: [2]. *) 160 | 161 | ;; 162 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_backend.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | type code_stylist = lang:string -> string -> string 9 | (** Function that takes a language name and some code and returns 10 | that code with style. *) 11 | 12 | val default_language : string ref 13 | (** default language for code blocks can be set to any name, 14 | by default it is the empty string *) 15 | 16 | val html_of_md : 17 | ?override:(Omd_representation.element -> string option) -> 18 | ?pindent:bool -> 19 | ?nl2br:bool -> 20 | ?cs:code_stylist -> 21 | Omd_representation.t -> string 22 | (** [html_of_md md] returns a string containing the HTML version of 23 | [md]. Note that [md] uses the internal representation of 24 | Markdown. 25 | 26 | The optional parameter [override] allows to override an precise 27 | behaviour for a constructor of Omd_representation.element, 28 | as in the following example: 29 | 30 | let customized_to_html = 31 | Omd.html_of_md 32 | ~override:(function 33 | | Url (href,s,title) -> 34 | Some(" "" then 37 | " title='" ^ (Omd_utils.htmlentities ~md:true title) ^ "'" 38 | else "") 39 | ^ ">" 40 | ^ Omd_backend.html_of_md s ^ " target='_blank'") 41 | | _ -> None) 42 | *) 43 | 44 | val headers_of_md : 45 | ?remove_header_links:bool -> 46 | Omd_representation.t -> 47 | (Omd_representation.element * string * string) list 48 | (** [headers_of_md md] returns a list of 3-tuples; in each of them the 49 | first element is the header (e.g., [H1(foo)]), the second is the 50 | HTML id (as produced by [html_of_md]), and the third element is 51 | the HTML version of [foo]. The third elements of those 3-tuples 52 | exist because if you use [html_and_headers_of_md], then you have 53 | the guarantee that the HTML version of [foo] is the same for 54 | both the headers and the HTML version of [md]. 55 | If [remove_header_links], then remove links inside headers (h1, h2, ...). 56 | Default value of [remove_header_links]: cf. [html_and_headers_of_md]. 57 | *) 58 | 59 | val html_and_headers_of_md : 60 | ?remove_header_links:bool -> 61 | ?override:(Omd_representation.element -> string option) -> 62 | ?pindent:bool -> 63 | ?nl2br:bool -> 64 | ?cs:code_stylist -> 65 | Omd_representation.t -> 66 | string * 67 | (Omd_representation.element * Omd_utils.StringSet.elt * string) list 68 | (** [html_and_headers_of_md md] is the same as [(html_of_md md, 69 | headers_of_md md)] except that it's two times faster. 70 | If you need both headers and html, don't use [html_of_md] 71 | and [headers_of_md] but this function instead. 72 | If [remove_header_links], then remove links inside headers (h1, h2, ...). 73 | Default value of [remove_header_links]: false. 74 | *) 75 | 76 | val escape_markdown_characters : string -> string 77 | (** [escape_markdown_characters s] returns a string where 78 | markdown-significant characters in [s] have been 79 | backslash-escaped. Note that [escape_markdown_characters] takes a 80 | "raw" string, therefore it doesn't have the whole context in which 81 | the string appears, thus the escaping cannot really be 82 | minimal. However the implementation tries to minimalise the extra 83 | escaping. *) 84 | 85 | val text_of_md : Omd_representation.t -> string 86 | (** [text_of_md md] is basically the same as [html_of_md md] but without 87 | the HTML tags in the output. *) 88 | 89 | val markdown_of_md : Omd_representation.t -> string 90 | (** [markdown_of_md md] is basically the same as [html_of_md md] but 91 | with the output in Markdown syntax rather than HTML. *) 92 | 93 | val sexpr_of_md : Omd_representation.t -> string 94 | (** [sexpr_of_md md] is basically the same as [html_of_md md] but with 95 | the output in s-expressions rather than HTML. This is mainly used 96 | for debugging. *) 97 | 98 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_html.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* OMD: Markdown tool in OCaml *) 3 | (* (c) 2014 by Philippe Wang *) 4 | (* Licence: ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | type html = html_node list 9 | 10 | and html_node = 11 | | Node of nodename * attributes * html 12 | | Data of string 13 | | Rawdata of string 14 | | Comment of string 15 | 16 | and nodename = string 17 | 18 | and attributes = attribute list 19 | 20 | and attribute = string * string option 21 | 22 | let to_string html = 23 | let b = Buffer.create 1024 in 24 | let pp f = Printf.bprintf b f in 25 | let rec loop = function 26 | | Node(nodename, attributes, html) -> 27 | pp "<%s" nodename; 28 | ppa attributes; 29 | pp ">"; 30 | List.iter loop html; 31 | pp "" nodename 32 | | Data s -> pp "%s" s 33 | | Rawdata s -> pp "%s" s 34 | | Comment c -> pp "" c 35 | and ppa attrs = 36 | List.iter 37 | (function 38 | | (a, Some v) -> 39 | if not (String.contains v '\'') then 40 | pp " %s='%s'" a v 41 | else if (not (String.contains v '"')) then 42 | pp " %s=\"%s\"" a v 43 | else 44 | ( 45 | pp " %s=\"" a; 46 | for i = 0 to String.length v - 1 do 47 | match v.[i] with 48 | | '"' -> pp """ 49 | | c -> pp "%c" c 50 | done; 51 | pp "\"" 52 | ) 53 | | a, None -> 54 | Printf.bprintf b " %s=''" a (* HTML5 *) 55 | ) 56 | attrs 57 | in 58 | List.iter loop html; 59 | Buffer.contents b 60 | 61 | 62 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_lexer.mli: -------------------------------------------------------------------------------- 1 | type token = Omd_representation.tok 2 | type t = token list 3 | 4 | val lex : string -> t 5 | (** Translate a raw string into tokens for the parser. To implement 6 | an extension to the lexer, one may process its result before 7 | giving it to the parser. To implement an extension to the 8 | parser, one may extend it using the constructor [Tag] 9 | from type [tok] and/or using the extensions mechanism 10 | of the parser (cf. the optional argument [extensions]). 11 | The main difference is that [Tag] is processed by the parser 12 | in highest priority whereas functions in [extensions] are applied 13 | with lowest priority. *) 14 | 15 | val string_of_tokens : t -> string 16 | (** [string_of_tokens t] return the string corresponding to the token 17 | list [t]. *) 18 | 19 | val length : token -> int 20 | (** [length t] number of characters of the string represented as [t] 21 | (i.e. [String.length(string_of_token t)]). *) 22 | 23 | val string_of_token : token -> string 24 | (** [string_of_token tk] return the string corresponding to the token 25 | [tk]. *) 26 | 27 | val make_space : int -> token 28 | 29 | val split_first : token -> token * token 30 | (** [split_first(Xs n)] returns [(X, X(n-1))] where [X] is a token 31 | carrying an int count. 32 | 33 | @raise Invalid_argument is passed a single token. *) 34 | 35 | 36 | val destring_of_tokens : ?limit:int -> t -> string 37 | (** Converts the tokens to a simple string representation useful for 38 | debugging. *) 39 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_representation.mli: -------------------------------------------------------------------------------- 1 | 2 | module R : Map.S with type key = string 3 | 4 | class ref_container : 5 | object 6 | val mutable c : (string * string) R.t 7 | method add_ref : R.key -> string -> string -> unit 8 | method get_ref : R.key -> (string * string) option 9 | method get_all : (string * (string * string)) list 10 | end 11 | type element = 12 | | H1 of t 13 | | H2 of t 14 | | H3 of t 15 | | H4 of t 16 | | H5 of t 17 | | H6 of t 18 | | Paragraph of t 19 | | Text of string 20 | | Emph of t 21 | | Bold of t 22 | | Ul of t list 23 | | Ol of t list 24 | | Ulp of t list 25 | | Olp of t list 26 | | Code of name * string 27 | | Code_block of name * string 28 | | Br 29 | | Hr 30 | | NL 31 | | Url of href * t * title 32 | | Ref of ref_container * name * string * fallback 33 | | Img_ref of ref_container * name * alt * fallback 34 | | Html of name * (string * string option) list * t 35 | | Html_block of name * (string * string option) list * t 36 | | Html_comment of string 37 | | Raw of string 38 | | Raw_block of string 39 | | Blockquote of t 40 | | Img of alt * src * title 41 | | X of 42 | < name : string; 43 | to_html : ?indent:int -> (t -> string) -> t -> string option; 44 | to_sexpr : (t -> string) -> t -> string option; 45 | to_t : t -> t option > 46 | and fallback = < to_string : string ; to_t : t > 47 | and name = string 48 | and alt = string 49 | and src = string 50 | and href = string 51 | and title = string 52 | and t = element list 53 | 54 | type tok = 55 | Ampersand (* one & *) 56 | | Ampersands of int (* [Ampersands(n)] is (n+2) consecutive occurrences of & *) 57 | | At (* @ *) 58 | | Ats of int (* @@.. *) 59 | | Backquote (* ` *) 60 | | Backquotes of int (* ``.. *) 61 | | Backslash (* \\ *) 62 | | Backslashs of int (* \\\\.. *) 63 | | Bar (* | *) 64 | | Bars of int (* ||.. *) 65 | | Caret (* ^ *) 66 | | Carets of int (* ^^.. *) 67 | | Cbrace (* } *) 68 | | Cbraces of int (* }}.. *) 69 | | Colon (* : *) 70 | | Colons of int (* ::.. *) 71 | | Comma (* , *) 72 | | Commas of int (* ,,.. *) 73 | | Cparenthesis (* ) *) 74 | | Cparenthesiss of int (* )).. *) 75 | | Cbracket (* ] *) 76 | | Cbrackets of int (* ]].. *) 77 | | Dollar (* $ *) 78 | | Dollars of int (* $$.. *) 79 | | Dot (* . *) 80 | | Dots of int (* .... *) 81 | | Doublequote (* \034 *) 82 | | Doublequotes of int (* \034\034.. *) 83 | | Exclamation (* ! *) 84 | | Exclamations of int (* !!.. *) 85 | | Equal (* = *) 86 | | Equals of int (* ==.. *) 87 | | Greaterthan (* > *) 88 | | Greaterthans of int (* >>.. *) 89 | | Hash (* # *) 90 | | Hashs of int (* ##.. *) 91 | | Lessthan (* < *) 92 | | Lessthans of int (* <<.. *) 93 | | Minus (* - *) 94 | | Minuss of int (* --.. *) 95 | | Newline (* \n *) 96 | | Newlines of int (* \n\n.. *) 97 | | Number of string 98 | | Obrace (* { *) 99 | | Obraces of int (* {{.. *) 100 | | Oparenthesis (* ( *) 101 | | Oparenthesiss of int (* ((.. *) 102 | | Obracket (* [ *) 103 | | Obrackets of int (* [[.. *) 104 | | Percent (* % *) 105 | | Percents of int (* %%.. *) 106 | | Plus (* + *) 107 | | Pluss of int (* ++.. *) 108 | | Question (* ? *) 109 | | Questions of int (* ??.. *) 110 | | Quote (* ' *) 111 | | Quotes of int (* ''.. *) 112 | | Semicolon (* ; *) 113 | | Semicolons of int (* ;;.. *) 114 | | Slash (* / *) 115 | | Slashs of int (* //.. *) 116 | | Space (* *) 117 | | Spaces of int (* .. *) 118 | | Star (* * *) 119 | | Stars of int (* **.. *) 120 | | Tab (* \t *) 121 | | Tabs of int (* \t\t.. *) 122 | | Tilde (* ~ *) 123 | | Tildes of int (* ~~.. *) 124 | | Underscore (* _ *) 125 | | Underscores of int (* __.. *) 126 | | Word of string 127 | | Tag of name * extension 128 | (** Lexer's tokens. If you want to use the parser with an extended 129 | lexer, you may use the constructor [Tag] to implement 130 | the parser's extension. In the parser, [Tag] is used (at least) 131 | 3 times in order to represent metadata or to store data. 132 | 133 | The integers carried by constructors means that the represented 134 | character appears (n+2) times. So, [Ampersand(0)] is "&&". 135 | Notably, this allows to use the property that in the match 136 | case [Ampersand _ ->], we know there are at least 2 ampersands. 137 | This is particularly useful for some characters, such as newlines 138 | and spaces. It's not useful for all of them indeed but it has 139 | been designed this way for the sake of uniformity (one doesn't 140 | want to know by heart which constructor have that "at least 2" 141 | property and which haven't). 142 | *) 143 | 144 | and extension = < 145 | parser_extension : t -> tok list -> tok list -> ((t * tok list * tok list) option); 146 | to_string : string 147 | > 148 | (** - [parser_extension] is a method that takes the current state of the 149 | parser's data and returns None if nothing has been changed, 150 | otherwise it returns the new state. The current state of the 151 | parser's data is [(r, p, l)] where [r] is the result so far, [p] 152 | is the list of the previous tokens (it's typically empty or 153 | contains information on how many newlines we've just seen), and 154 | [l] is the remaining tokens to parse. 155 | - and [to_string] is a method that returns directly a string 156 | representation of the object (it's normal if it returns the 157 | empty string). *) 158 | 159 | type extensions = extension list 160 | (** One must use this type to extend the parser. It's a list of 161 | functions of type [extension]. They are processed in order (the 162 | head is applied first), so be careful about it. If you use it 163 | wrong, it will behave wrong. *) 164 | 165 | val empty_extension : extension 166 | (** An empty extension *) 167 | 168 | val loose_compare : t -> t -> int 169 | (** [loose_compare t1 t2] returns [0] if [t1] and [t2] 170 | are equivalent, otherwise it returns another number. *) 171 | 172 | val normalise_md : t -> t 173 | (** [normalise_md md] returns a copy of [md] where some elements 174 | have been factorized. *) 175 | 176 | val visit : (element -> t option) -> t -> t 177 | (** visitor for structures of type t: [visit f md] will return a new 178 | potentially altered copy of [md] that has been created by the 179 | visit of [md] by [f]. 180 | 181 | The function [f] takes each [element] (from [md]) and returns 182 | [Some t] if it has effectively been applied to [element], and 183 | [None] otherwise. When it returns [Some t], [t] replaces [element] 184 | in the copy of [md], and when it returns [None], either [element] 185 | is copied as it is in the copy of [md] or a visited version is 186 | copied instead (well, that depends on if [element] has elements 187 | inside of it or not). 188 | *) 189 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_types.ml: -------------------------------------------------------------------------------- 1 | 2 | type name = string 3 | type url = string 4 | type title = string 5 | type alt = string 6 | 7 | type 'a el = 8 | [ `Text of string 9 | | `Br 10 | | `Emph of 'a 11 | | `Bold of 'a 12 | | `Url of url * 'a * title 13 | | `Img of url * alt * title 14 | | `Code of name * string 15 | | `Html of string 16 | | `Comment of string 17 | ] 18 | 19 | type phrasing_no_NL = phrasing_no_NL el list 20 | 21 | type phrasing = [phrasing el | `NL] list 22 | 23 | type reference 24 | 25 | type flow = 26 | [ phrasing el 27 | | `H1 of phrasing_no_NL 28 | | `H2 of phrasing_no_NL 29 | | `H3 of phrasing_no_NL 30 | | `H4 of phrasing_no_NL 31 | | `H5 of phrasing_no_NL 32 | | `H6 of phrasing_no_NL 33 | | `Hr 34 | | `Paragraph of phrasing 35 | | `Code_block of name * string 36 | | `Html_block of string 37 | | `Ul of t 38 | | `Ol of t 39 | | `Quote of t 40 | | `Ref of reference 41 | | `Img_ref of reference 42 | ] 43 | 44 | and t = flow list 45 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_utils.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013/2014 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | open Printf 9 | 10 | let debug = 11 | let _DEBUG = 12 | try 13 | Some(Sys.getenv "DEBUG") 14 | with _ -> None 15 | and _OMD_DEBUG = 16 | try 17 | Some(Sys.getenv "OMD_DEBUG") 18 | with _ -> None 19 | in 20 | match _DEBUG, _OMD_DEBUG with 21 | | _, Some "false" -> 22 | false 23 | | Some _, None -> 24 | eprintf "omd: debug mode activated because DEBUG is set, \ 25 | you can deactivate the mode by unsetting DEBUG \ 26 | or by setting OMD_DEBUG to the string \"false\".\n%!"; 27 | true 28 | | None, None -> 29 | false 30 | | _, Some _ -> 31 | eprintf "omd: debug mode activated because OMD_DEBUG is set 32 | to a value that isn't the string \"false\".\n%!"; 33 | true 34 | 35 | exception Error of string 36 | 37 | let warn ?(we=false) msg = 38 | if we then 39 | raise (Error msg) 40 | else 41 | eprintf "(OMD) Warning: %s\n%!" msg 42 | 43 | 44 | let trackfix = 45 | try 46 | ignore(Sys.getenv "OMD_FIX"); 47 | eprintf "omd: tracking mode activated: token list are very often checked, \ 48 | it might take a *very* long time if your input is large.\n%!"; 49 | true 50 | with Not_found -> 51 | false 52 | 53 | let _ = if debug then Printexc.record_backtrace true 54 | 55 | let raise = 56 | if debug then 57 | (fun e -> 58 | eprintf "(OMD) Exception raised: %s\n%!" (Printexc.to_string e); 59 | raise e) 60 | else 61 | Pervasives.raise 62 | 63 | module StringSet : sig 64 | include Set.S with type elt = string 65 | val of_list : elt list -> t 66 | end = struct 67 | include Set.Make(String) 68 | let of_list l = List.fold_left (fun r e -> add e r) empty l 69 | end 70 | 71 | 72 | type 'a split = 'a list -> 'a split_action 73 | and 'a split_action = 74 | | Continue 75 | | Continue_with of 'a list * 'a list 76 | | Split of 'a list * 'a list 77 | 78 | 79 | let fsplit_rev ?(excl=(fun _ -> false)) ~(f:'a split) l 80 | : ('a list * 'a list) option = 81 | let rec loop accu = function 82 | | [] -> 83 | begin 84 | match f [] with 85 | | Split(left, right) -> Some(left@accu, right) 86 | | Continue_with(left, tl) -> loop (left@accu) tl 87 | | Continue -> None 88 | end 89 | | e::tl as l -> 90 | if excl l then 91 | None 92 | else match f l with 93 | | Split(left, right) -> Some(left@accu, right) 94 | | Continue_with(left, tl) -> loop (left@accu) tl 95 | | Continue -> loop (e::accu) tl 96 | in loop [] l 97 | 98 | let fsplit ?(excl=(fun _ -> false)) ~f l = 99 | match fsplit_rev ~excl:excl ~f:f l with 100 | | None -> None 101 | | Some(rev, l) -> Some(List.rev rev, l) 102 | 103 | let id_of_string ids s = 104 | let n = String.length s in 105 | let out = Buffer.create 0 in 106 | (* Put [s] into [b], replacing non-alphanumeric characters with dashes. *) 107 | let rec loop started i = 108 | if i = n then () 109 | else 110 | match s.[i] with 111 | | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' as c -> 112 | Buffer.add_char out c ; 113 | loop true (i + 1) 114 | (* Don't want to start with dashes. *) 115 | | _ when not started -> 116 | loop false (i + 1) 117 | | _ -> 118 | Buffer.add_char out '-' ; 119 | loop false (i + 1) 120 | in 121 | loop false 0 ; 122 | let s' = Buffer.contents out in 123 | if s' = "" then "" 124 | else 125 | (* Find out the index of the last character in [s'] that isn't a dash. *) 126 | let last_trailing = 127 | let rec loop i = 128 | if i < 0 || s'.[i] <> '-' then i 129 | else loop (i - 1) 130 | in 131 | loop (String.length s' - 1) 132 | in 133 | (* Trim trailing dashes. *) 134 | ids#mangle @@ String.sub s' 0 (last_trailing + 1) 135 | 136 | (* only convert when "necessary" *) 137 | let htmlentities ?(md=false) s = 138 | let module Break = struct exception Break end in 139 | let b = Buffer.create 64 in 140 | let rec loop i = 141 | if i = String.length s then 142 | () 143 | else 144 | let () = 145 | match s.[i] with 146 | | ( '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' ) as c -> Buffer.add_char b c 147 | | '"' -> Buffer.add_string b """ 148 | | '\'' -> Buffer.add_string b "'" 149 | | '&' -> 150 | if md then 151 | begin 152 | try 153 | let () = match s.[i+1] with 154 | | '#' -> 155 | let rec ff j = 156 | match s.[j] with 157 | | '0' .. '9' -> ff (succ j) 158 | | ';' -> () 159 | | _ -> raise Break.Break 160 | in 161 | ff (i+2) 162 | | 'A' .. 'Z' | 'a' .. 'z' -> 163 | let rec ff j = 164 | match s.[j] with 165 | | 'A' .. 'Z' | 'a' .. 'z' -> ff (succ j) 166 | | ';' -> () 167 | | _ -> raise Break.Break 168 | in 169 | ff (i+2) 170 | | _ -> raise Break.Break 171 | in 172 | Buffer.add_string b "&" 173 | with _ -> Buffer.add_string b "&" 174 | end 175 | else 176 | Buffer.add_string b "&" 177 | | '<' -> Buffer.add_string b "<" 178 | | '>' -> Buffer.add_string b ">" 179 | | c -> Buffer.add_char b c 180 | in loop (succ i) 181 | in 182 | loop 0; 183 | Buffer.contents b 184 | 185 | 186 | let minimalize_blanks s = 187 | let l = String.length s in 188 | let b = Buffer.create l in 189 | let rec loop f i = 190 | if i = l then 191 | Buffer.contents b 192 | else 193 | match s.[i] with 194 | | ' ' | '\t' | '\n' -> 195 | loop true (succ i) 196 | | _c -> 197 | if Buffer.length b > 0 && f then 198 | Buffer.add_char b ' '; 199 | loop false (succ i) 200 | in loop false 0 201 | 202 | let rec eat f = function 203 | | [] -> [] 204 | | e::tl as l -> if f e then eat f tl else l 205 | 206 | 207 | let rec extract_html_attributes (html:string) = 208 | let cut_on_char_from s i c = 209 | match String.index_from s i c with 210 | | 0 -> "", String.sub s 1 (String.length s - 1) 211 | | j -> String.sub s i (j-i), String.sub s (j+1) (String.length s - (j+1)) 212 | in 213 | let remove_prefix_spaces s = 214 | if s = "" then 215 | s 216 | else if s.[0] <> ' ' then 217 | s 218 | else 219 | let rec loop i = 220 | if i = String.length s then 221 | String.sub s i (String.length s - i) 222 | else 223 | match s.[i] with 224 | | ' ' -> loop (i+1) 225 | | _ -> String.sub s i (String.length s - i) 226 | in loop 1 227 | in 228 | let remove_suffix_spaces s = 229 | if s = "" then 230 | s 231 | else if s.[String.length s - 1] <> ' ' then 232 | s 233 | else 234 | let rec loop i = 235 | match s.[i] with 236 | | ' ' -> loop (i-1) 237 | | _ -> String.sub s 0 (i+1) 238 | in loop (String.length s - 1) 239 | in 240 | let rec loop s res i = 241 | if i = String.length s then 242 | res 243 | else 244 | match 245 | try 246 | Some (take_attribute s i) 247 | with Not_found -> None 248 | with 249 | | Some (((_,_) as a), new_s) -> 250 | loop new_s (a::res) 0 251 | | None -> res 252 | and take_attribute s i = 253 | let name, after_eq = cut_on_char_from s i '=' in 254 | let name = remove_suffix_spaces name in 255 | let after_eq = remove_prefix_spaces after_eq in 256 | let value, rest = cut_on_char_from after_eq 1 after_eq.[0] in 257 | (name,value), remove_prefix_spaces rest 258 | in 259 | if (* Has it at least one attribute? *) 260 | try String.index html '>' < String.index html ' ' 261 | with Not_found -> true 262 | then 263 | [] 264 | else 265 | match html.[1] with 266 | | '<' | ' ' -> 267 | extract_html_attributes 268 | (remove_prefix_spaces (String.sub html 1 (String.length html - 1))) 269 | | _ -> 270 | try 271 | let html = snd (cut_on_char_from html 0 ' ') in 272 | loop (String.sub html 0 (String.index html '>')) [] 0 273 | with Not_found -> [] 274 | 275 | let extract_inner_html (html:string) = 276 | let cut_on_char_from s i c = 277 | match String.index_from s i c with 278 | | 0 -> "", String.sub s 1 (String.length s - 1) 279 | | j -> String.sub s i (j-i), String.sub s (j+1) (String.length s - (j+1)) 280 | in 281 | let rcut_on_char_from s i c = 282 | match String.rindex_from s i c with 283 | | 0 -> "", String.sub s 1 (String.length s - 1) 284 | | j -> String.sub s 0 j, String.sub s (j+1) (String.length s - (j+1)) 285 | in 286 | let _, p = cut_on_char_from html 0 '>' in 287 | let r, _ = rcut_on_char_from p (String.length p - 1) '<' in 288 | r 289 | 290 | 291 | let html_void_elements = StringSet.of_list [ 292 | "img"; 293 | "input"; 294 | "link"; 295 | "meta"; 296 | "br"; 297 | "hr"; 298 | "source"; 299 | "wbr"; 300 | "param"; 301 | "embed"; 302 | "base"; 303 | "area"; 304 | "col"; 305 | "track"; 306 | "keygen"; 307 | ] 308 | 309 | let ( @ ) l1 l2 = 310 | List.rev_append (List.rev l1) l2 311 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_utils.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013/2014 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | val debug : bool 9 | (** Equals [true] if the environment variable DEBUG is set, 10 | or if the environment variable OMD_DEBUG is set to a string 11 | that is not ["false"]. *) 12 | 13 | val trackfix : bool 14 | 15 | exception Error of string 16 | 17 | val raise : exn -> 'a 18 | (** Same as [Pervasives.raise] except if [debug] equals true, 19 | in which case it prints a trace on stderr before raising the exception. *) 20 | 21 | val warn : ?we:bool -> string -> unit 22 | (** [warn we x] prints a warning with the message [x] if [we] is true, 23 | else raises [Omd_utils.Error x]. *) 24 | 25 | module StringSet : 26 | sig 27 | include Set.S with type elt = string 28 | val of_list : elt list -> t 29 | end 30 | (** Set of [string]. Cf. documentation of {!Set.S} *) 31 | 32 | type 'a split = 'a list -> 'a split_action 33 | (** Type of a split function *) 34 | 35 | and 'a split_action = 36 | (** Don't split yet *) 37 | | Continue 38 | 39 | (** Don't split yet but continue with those two lists instead of default *) 40 | | Continue_with of 'a list * 'a list 41 | 42 | (** Do split with this split scheme *) 43 | | Split of 'a list * 'a list 44 | (** Type of a split action *) 45 | 46 | 47 | val fsplit_rev : 48 | ?excl:('a list -> bool) -> 49 | f:'a split -> 'a list -> ('a list * 'a list) option 50 | (** [fsplit_rev ?excl ~f l] returns [Some(x,y)] where [x] is the 51 | **reversed** list of the consecutive elements of [l] that obey the 52 | split function [f]. 53 | Note that [f] is applied to a list of elements and not just an 54 | element, so that [f] can look farther in the list when applied. 55 | [f l] returns [Continue] if there're more elements to consume, 56 | [Continue_with(left,right)] if there's more elements to consume 57 | but we want to choose what goes to the left part and what remains 58 | to process (right part), and returns [Split(left,right)] if 59 | the splitting is decided. 60 | When [f] is applied to an empty list, if it returns [Continue] 61 | then the result will be [None]. 62 | 63 | If [excl] is given, then [excl] is applied before [f] is, to check 64 | if the splitting should be stopped right away. When the split 65 | fails, it returns [None]. *) 66 | 67 | 68 | val fsplit : 69 | ?excl:('a list -> bool) -> 70 | f:'a split -> 'a list -> ('a list * 'a list) option 71 | (** [fsplit ?excl ~f l] returns [Some(List.rev x, y)] 72 | if [fsplit ?excl ~f l] returns [Some(x,y)], else it returns [None]. *) 73 | 74 | val id_of_string : < mangle : string -> string; .. > -> string -> string 75 | (** [id_of_string ids id] returns a mangled version of [id], using the 76 | method [ids#mangle]. If you don't need mangling, you may use 77 | [object method mangle x = x end] for [ids]. However, the name 78 | [ids] also means that your object should have knowledge of all IDs 79 | it has issued, in order to avoid collision. This is why 80 | [id_of_string] asks for an object rather than "just a 81 | function". *) 82 | 83 | val htmlentities : ?md:bool -> string -> string 84 | (** [htmlentities s] returns a new string in which html-significant 85 | characters have been converted to html entities. For instance, 86 | "" is converted to "<Foo&Bar>". *) 87 | 88 | val minimalize_blanks : string -> string 89 | (** [minimalize_blanks s] returns a copy of [s] in which the first and last 90 | characters are never blank, and two consecutive blanks never happen. *) 91 | 92 | 93 | val eat : ('a -> bool) -> 'a list -> 'a list 94 | (** [eat f l] returns [l] where elements satisfying [f] have been removed, 95 | but it stops removing as soon as one element doesn't satisfy [f]. *) 96 | 97 | 98 | val extract_html_attributes : string -> (string * string) list 99 | (** Takes some HTML and returns the list of attributes of the first 100 | HTML tag. 101 | Notes: 102 | * Doesn't check the validity of HTML tags or attributes. 103 | * Doesn't support backslash escaping. 104 | * Attribute names are delimited by the space and equal characters. 105 | * Attribute values are either delimited by the double quote 106 | or the simple quote character. 107 | *) 108 | 109 | val extract_inner_html : string -> string 110 | (** Takes an HTML node and returns the contents of the node. 111 | If it's not given a node, it returns something rubbish. 112 | *) 113 | 114 | val html_void_elements : StringSet.t 115 | (** HTML void elements *) 116 | 117 | val ( @ ) : 'a list -> 'a list -> 'a list 118 | (** Tail-recursive version of [Pervasives.(@)]. *) 119 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_xtxt.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | (* xtxt = eXTernal eXTension *) 9 | 10 | (* let extensions = ref [] *) 11 | 12 | (* let get () = *) 13 | (* !extensions *) 14 | 15 | (* let register e = *) 16 | (* extensions := e :: !extensions *) 17 | 18 | (* let set es = extensions := es *) 19 | 20 | (* let activate ... *) 21 | 22 | (* (\* let deactivate ... *\) *) 23 | 24 | (* priority (integer?) *) 25 | (* pre-extension *) 26 | (* post-extension *) 27 | 28 | 29 | -------------------------------------------------------------------------------- /src/vendor/omd/omd_xtxt.mli: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* omd: Markdown frontend in OCaml *) 3 | (* (c) 2013 by Philippe Wang *) 4 | (* Licence : ISC *) 5 | (* http://www.isc.org/downloads/software-support-policy/isc-license/ *) 6 | (***********************************************************************) 7 | 8 | (** xtxt = eXTernal eXTension *) 9 | 10 | -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_comment.ml: -------------------------------------------------------------------------------- 1 | type style = 2 | | SingleLine 3 | | MultiLine 4 | 5 | let styleToString s = match s with 6 | | SingleLine -> "SingleLine" 7 | | MultiLine -> "MultiLine" 8 | 9 | type t = { 10 | txt: string; 11 | style: style; 12 | loc: Location.t; 13 | mutable prevTokEndPos: Lexing.position; 14 | } 15 | 16 | let loc t = t.loc 17 | let txt t = t.txt 18 | let prevTokEndPos t = t.prevTokEndPos 19 | 20 | let setPrevTokEndPos t pos = 21 | t.prevTokEndPos <- pos 22 | 23 | let isSingleLineComment t = match t.style with 24 | | SingleLine -> true 25 | | MultiLine -> false 26 | 27 | let toString t = 28 | Format.sprintf 29 | "(txt: %s\nstyle: %s\nlines: %d-%d)" 30 | t.txt 31 | (styleToString t.style) 32 | t.loc.loc_start.pos_lnum 33 | t.loc.loc_end.pos_lnum 34 | 35 | let makeSingleLineComment ~loc txt = { 36 | txt; 37 | loc; 38 | style = SingleLine; 39 | prevTokEndPos = Lexing.dummy_pos; 40 | } 41 | 42 | let makeMultiLineComment ~loc txt = { 43 | txt; 44 | loc; 45 | style = MultiLine; 46 | prevTokEndPos = Lexing.dummy_pos; 47 | } 48 | 49 | let fromOcamlComment ~loc ~txt ~prevTokEndPos = { 50 | txt; 51 | loc; 52 | style = MultiLine; 53 | prevTokEndPos = prevTokEndPos 54 | } 55 | 56 | let trimSpaces s = 57 | let len = String.length s in 58 | if len = 0 then s 59 | else if String.unsafe_get s 0 = ' ' || String.unsafe_get s (len - 1) = ' ' then ( 60 | let i = ref 0 in 61 | while !i < len && (String.unsafe_get s !i) = ' ' do 62 | incr i 63 | done; 64 | let j = ref (len - 1) in 65 | while !j >= !i && (String.unsafe_get s !j) = ' ' do 66 | decr j 67 | done; 68 | if !j >= !i then 69 | (String.sub [@doesNotRaise]) s !i (!j - !i + 1) 70 | else 71 | "" 72 | ) else s -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_comment.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val toString: t -> string 4 | 5 | val loc: t -> Location.t 6 | val txt: t -> string 7 | val prevTokEndPos: t -> Lexing.position 8 | 9 | val setPrevTokEndPos: t -> Lexing.position -> unit 10 | 11 | val isSingleLineComment: t -> bool 12 | 13 | val makeSingleLineComment: loc:Location.t -> string -> t 14 | val makeMultiLineComment: loc:Location.t -> string -> t 15 | val fromOcamlComment: 16 | loc:Location.t -> txt:string -> prevTokEndPos:Lexing.position -> t 17 | val trimSpaces: string -> string -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_doc.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val nil: t 4 | val line: t 5 | val hardLine: t 6 | val softLine: t 7 | val literalLine: t 8 | val text: string -> t 9 | val concat: t list -> t 10 | val indent: t -> t 11 | val ifBreaks: t -> t -> t 12 | val lineSuffix: t -> t 13 | val group: t -> t 14 | val breakableGroup: forceBreak : bool -> t -> t 15 | (* `customLayout docs` will pick the layout that fits from `docs`. 16 | * This is a very expensive computation as every layout from the list 17 | * will be checked until one fits. *) 18 | val customLayout: t list -> t 19 | val breakParent: t 20 | val join: sep: t -> t list -> t 21 | 22 | val space: t 23 | val comma: t 24 | val dot: t 25 | val dotdot: t 26 | val dotdotdot: t 27 | val lessThan: t 28 | val greaterThan: t 29 | val lbrace: t 30 | val rbrace: t 31 | val lparen: t 32 | val rparen: t 33 | val lbracket: t 34 | val rbracket: t 35 | val question: t 36 | val tilde: t 37 | val equal: t 38 | val trailingComma: t 39 | val doubleQuote: t [@@live] 40 | 41 | (* 42 | * `willBreak doc` checks whether `doc` contains forced line breaks. 43 | * This is more or less a "workaround" to make the parent of a `customLayout` break. 44 | * Forced breaks are not propagated through `customLayout`; otherwise we would always 45 | * get the last layout the algorithm tries… 46 | * This might result into some weird layouts: 47 | * [fn(x => { 48 | * let _ = x 49 | * }), fn(y => { 50 | * let _ = y 51 | * }), fn(z => { 52 | * let _ = z 53 | * })] 54 | * The `[` and `]` would be a lot better broken out. 55 | * Although the layout of `fn(x => {...})` is correct, we need to break its parent (the array). 56 | * `willBreak` can be used in this scenario to check if the `fn…` contains any forced breaks. 57 | * The consumer can then manually insert a `breakParent` doc, to manually propagate the 58 | * force breaks from bottom to top. 59 | *) 60 | val willBreak: t -> bool 61 | 62 | val toString: width: int -> t -> string 63 | val debug: t -> unit [@@live] 64 | -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_minibuffer.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | mutable buffer : bytes; 3 | mutable position : int; 4 | mutable length : int; 5 | } 6 | 7 | let create n = 8 | let n = if n < 1 then 1 else n in 9 | let s = (Bytes.create [@doesNotRaise]) n in 10 | {buffer = s; position = 0; length = n} 11 | 12 | let contents b = (Bytes.sub_string [@doesNotRaise]) b.buffer 0 b.position 13 | 14 | (* Can't be called directly, don't add to the interface *) 15 | let resize_internal b more = 16 | let len = b.length in 17 | let new_len = ref len in 18 | while b.position + more > !new_len do new_len := 2 * !new_len done; 19 | if !new_len > Sys.max_string_length then begin 20 | if b.position + more <= Sys.max_string_length 21 | then new_len := Sys.max_string_length 22 | end; 23 | let new_buffer = (Bytes.create [@doesNotRaise]) !new_len in 24 | (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in 25 | this tricky function that is slow anyway. *) 26 | Bytes.blit b.buffer 0 new_buffer 0 b.position [@doesNotRaise]; 27 | b.buffer <- new_buffer; 28 | b.length <- !new_len 29 | 30 | let add_char b c = 31 | let pos = b.position in 32 | if pos >= b.length then resize_internal b 1; 33 | Bytes.unsafe_set b.buffer pos c; 34 | b.position <- pos + 1 35 | 36 | let add_string b s = 37 | let len = String.length s in 38 | let new_position = b.position + len in 39 | if new_position > b.length then resize_internal b len; 40 | Bytes.blit_string s 0 b.buffer b.position len [@doesNotRaise]; 41 | b.position <- new_position 42 | 43 | (* adds newline and trims all preceding whitespace *) 44 | let flush_newline b = 45 | let position = ref (b.position) in 46 | while (Bytes.unsafe_get b.buffer (!position - 1)) = ' ' && !position >= 0 do 47 | position := !position - 1; 48 | done; 49 | b.position <- !position; 50 | add_char b '\n' 51 | -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_minibuffer.mli: -------------------------------------------------------------------------------- 1 | type t 2 | val add_char : t -> char -> unit 3 | val add_string : t -> string -> unit 4 | val contents : t -> string 5 | val create : int -> t 6 | val flush_newline : t -> unit 7 | -------------------------------------------------------------------------------- /src/vendor/res_outcome_printer/res_token.ml: -------------------------------------------------------------------------------- 1 | module Comment = Res_comment 2 | 3 | type t = 4 | | Open 5 | | True | False 6 | | Character of char 7 | | Int of {i: string; suffix: char option} 8 | | Float of {f: string; suffix: char option} 9 | | String of string 10 | | Lident of string 11 | | Uident of string 12 | | As 13 | | Dot | DotDot | DotDotDot 14 | | Bang 15 | | Semicolon 16 | | Let 17 | | And 18 | | Rec 19 | | Underscore 20 | | SingleQuote 21 | | Equal | EqualEqual | EqualEqualEqual 22 | | Bar 23 | | Lparen 24 | | Rparen 25 | | Lbracket 26 | | Rbracket 27 | | Lbrace 28 | | Rbrace 29 | | Colon 30 | | Comma 31 | | Eof 32 | | Exception 33 | | Backslash [@live] 34 | | Forwardslash | ForwardslashDot 35 | | Asterisk | AsteriskDot | Exponentiation 36 | | Minus | MinusDot 37 | | Plus | PlusDot | PlusPlus | PlusEqual 38 | | ColonGreaterThan 39 | | GreaterThan 40 | | LessThan 41 | | LessThanSlash 42 | | Hash | HashEqual 43 | | Assert 44 | | Lazy 45 | | Tilde 46 | | Question 47 | | If | Else | For | In | While | Switch 48 | | When 49 | | EqualGreater | MinusGreater 50 | | External 51 | | Typ 52 | | Private 53 | | Mutable 54 | | Constraint 55 | | Include 56 | | Module 57 | | Of 58 | | Land | Lor 59 | | Band (* Bitwise and: & *) 60 | | BangEqual | BangEqualEqual 61 | | LessEqual | GreaterEqual 62 | | ColonEqual 63 | | At | AtAt 64 | | Percent | PercentPercent 65 | | Comment of Comment.t 66 | | List 67 | | TemplateTail of string 68 | | TemplatePart of string 69 | | Backtick 70 | | BarGreater 71 | | Try 72 | | Import 73 | | Export 74 | 75 | let precedence = function 76 | | HashEqual | ColonEqual -> 1 77 | | Lor -> 2 78 | | Land -> 3 79 | | Equal | EqualEqual | EqualEqualEqual | LessThan | GreaterThan 80 | | BangEqual | BangEqualEqual | LessEqual | GreaterEqual | BarGreater -> 4 81 | | Plus | PlusDot | Minus | MinusDot | PlusPlus -> 5 82 | | Asterisk | AsteriskDot | Forwardslash | ForwardslashDot -> 6 83 | | Exponentiation -> 7 84 | | MinusGreater -> 8 85 | | Dot -> 9 86 | | _ -> 0 87 | 88 | let toString = function 89 | | Open -> "open" 90 | | True -> "true" | False -> "false" 91 | | Character c -> "character '" ^ (Char.escaped c) ^ "'" 92 | | String s -> "string \"" ^ s ^ "\"" 93 | | Lident str -> str 94 | | Uident str -> str 95 | | Dot -> "." | DotDot -> ".." | DotDotDot -> "..." 96 | | Int {i} -> "int " ^ i 97 | | Float {f} -> "Float: " ^ f 98 | | Bang -> "!" 99 | | Semicolon -> ";" 100 | | Let -> "let" 101 | | And -> "and" 102 | | Rec -> "rec" 103 | | Underscore -> "_" 104 | | SingleQuote -> "'" 105 | | Equal -> "=" | EqualEqual -> "==" | EqualEqualEqual -> "===" 106 | | Eof -> "eof" 107 | | Bar -> "|" 108 | | As -> "as" 109 | | Lparen -> "(" | Rparen -> ")" 110 | | Lbracket -> "[" | Rbracket -> "]" 111 | | Lbrace -> "{" | Rbrace -> "}" 112 | | ColonGreaterThan -> ":>" 113 | | Colon -> ":" 114 | | Comma -> "," 115 | | Minus -> "-" | MinusDot -> "-." 116 | | Plus -> "+" | PlusDot -> "+." | PlusPlus -> "++" | PlusEqual -> "+=" 117 | | Backslash -> "\\" 118 | | Forwardslash -> "/" | ForwardslashDot -> "/." 119 | | Exception -> "exception" 120 | | Hash -> "#" | HashEqual -> "#=" 121 | | GreaterThan -> ">" 122 | | LessThan -> "<" 123 | | LessThanSlash -> " "*" | AsteriskDot -> "*." | Exponentiation -> "**" 125 | | Assert -> "assert" 126 | | Lazy -> "lazy" 127 | | Tilde -> "tilde" 128 | | Question -> "?" 129 | | If -> "if" 130 | | Else -> "else" 131 | | For -> "for" 132 | | In -> "in" 133 | | While -> "while" 134 | | Switch -> "switch" 135 | | When -> "when" 136 | | EqualGreater -> "=>" | MinusGreater -> "->" 137 | | External -> "external" 138 | | Typ -> "type" 139 | | Private -> "private" 140 | | Constraint -> "constraint" 141 | | Mutable -> "mutable" 142 | | Include -> "include" 143 | | Module -> "module" 144 | | Of -> "of" 145 | | Lor -> "||" 146 | | Band -> "&" | Land -> "&&" 147 | | BangEqual -> "!=" | BangEqualEqual -> "!==" 148 | | GreaterEqual -> ">=" | LessEqual -> "<=" 149 | | ColonEqual -> ":=" 150 | | At -> "@" | AtAt -> "@@" 151 | | Percent -> "%" | PercentPercent -> "%%" 152 | | Comment c -> "Comment" ^ (Comment.toString c) 153 | | List -> "list{" 154 | | TemplatePart text -> text ^ "${" 155 | | TemplateTail text -> "TemplateTail(" ^ text ^ ")" 156 | | Backtick -> "`" 157 | | BarGreater -> "|>" 158 | | Try -> "try" 159 | | Import -> "import" 160 | | Export -> "export" 161 | 162 | let keywordTable = function 163 | | "and" -> And 164 | | "as" -> As 165 | | "assert" -> Assert 166 | | "constraint" -> Constraint 167 | | "else" -> Else 168 | | "exception" -> Exception 169 | | "export" -> Export 170 | | "external" -> External 171 | | "false" -> False 172 | | "for" -> For 173 | | "if" -> If 174 | | "import" -> Import 175 | | "in" -> In 176 | | "include" -> Include 177 | | "lazy" -> Lazy 178 | | "let" -> Let 179 | | "list{" -> List 180 | | "module" -> Module 181 | | "mutable" -> Mutable 182 | | "of" -> Of 183 | | "open" -> Open 184 | | "private" -> Private 185 | | "rec" -> Rec 186 | | "switch" -> Switch 187 | | "true" -> True 188 | | "try" -> Try 189 | | "type" -> Typ 190 | | "when" -> When 191 | | "while" -> While 192 | | _ -> raise Not_found 193 | [@@raises Not_found] 194 | 195 | let isKeyword = function 196 | | And | As | Assert | Constraint | Else | Exception | Export 197 | | External | False | For | If | Import | In | Include | Land | Lazy 198 | | Let | List | Lor | Module | Mutable | Of | Open | Private | Rec 199 | | Switch | True | Try | Typ | When | While -> true 200 | | _ -> false 201 | 202 | let lookupKeyword str = 203 | try keywordTable str with 204 | | Not_found -> 205 | match str.[0] [@doesNotRaise] with 206 | | 'A'..'Z' -> Uident str 207 | | _ -> Lident str 208 | 209 | let isKeywordTxt str = 210 | try let _ = keywordTable str in true with 211 | | Not_found -> false 212 | 213 | let catch = Lident "catch" 214 | -------------------------------------------------------------------------------- /test.sh: -------------------------------------------------------------------------------- 1 | function exp { 2 | echo "$(dirname $1)/expected/$(basename $1).txt" 3 | } 4 | 5 | for file in tests/src/*.res; do 6 | lib/rescript-editor-support.exe test $file &> $(exp $file) 7 | done 8 | 9 | warningYellow='\033[0;33m' 10 | successGreen='\033[0;32m' 11 | reset='\033[0m' 12 | 13 | diff=$(git ls-files --modified tests/src/expected) 14 | if [[ $diff = "" ]]; then 15 | printf "${successGreen}✅ No unstaged tests difference.${reset}\n" 16 | else 17 | printf "${warningYellow}⚠️ There are unstaged differences in tests/! Did you break a test?\n${diff}\n${reset}" 18 | exit 1 19 | fi 20 | -------------------------------------------------------------------------------- /tests/bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "test", 3 | "sources": "src", 4 | "bs-dependencies": ["reason-react"], 5 | "reason": { "react-jsx": 3 } 6 | } 7 | -------------------------------------------------------------------------------- /tests/package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "tests", 3 | "lockfileVersion": 2, 4 | "requires": true, 5 | "packages": { 6 | "": { 7 | "dependencies": { 8 | "reason-react": "^0.9.1" 9 | }, 10 | "devDependencies": { 11 | "rescript": "9.1.1" 12 | } 13 | }, 14 | "node_modules/reason-react": { 15 | "version": "0.9.1", 16 | "license": "MIT", 17 | "peerDependencies": { 18 | "bs-platform": "^7.1.1", 19 | "react": "^16.8.1", 20 | "react-dom": "^16.8.1" 21 | } 22 | }, 23 | "node_modules/rescript": { 24 | "version": "9.1.1", 25 | "dev": true, 26 | "hasInstallScript": true, 27 | "license": "SEE LICENSE IN LICENSE", 28 | "bin": { 29 | "bsb": "bsb", 30 | "bsc": "bsc", 31 | "bsrefmt": "bsrefmt", 32 | "bstracing": "lib/bstracing", 33 | "rescript": "rescript" 34 | } 35 | } 36 | }, 37 | "dependencies": { 38 | "reason-react": { 39 | "version": "0.9.1", 40 | "requires": {} 41 | }, 42 | "rescript": { 43 | "version": "9.1.1", 44 | "dev": true 45 | } 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /tests/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "reason-react": "^0.9.1" 4 | }, 5 | "devDependencies": { 6 | "rescript": "9.1.1" 7 | }, 8 | "scripts": { 9 | "build": "bsb -make-world", 10 | "start": "bsb -make-world -w", 11 | "clean": "bsb -clean" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /tests/src/Auto.res: -------------------------------------------------------------------------------- 1 | open! Belt 2 | 3 | let m = List.map 4 | // ^hov -------------------------------------------------------------------------------- /tests/src/Complete.res: -------------------------------------------------------------------------------- 1 | module MyList = Belt.List 2 | //^com MyList.m 3 | //^com Array. 4 | //^com Array.m 5 | 6 | 7 | module Dep: { 8 | @ocaml.doc("Some doc comment") @deprecated("Use customDouble instead") 9 | let customDouble: int => int 10 | } = { 11 | let customDouble = foo => foo * 2 12 | } 13 | 14 | //^com let cc = Dep.c 15 | 16 | module Lib = { 17 | let foo = (~age, ~name) => name ++ string_of_int(age) 18 | let next = (~number=0, ~year) => number + year 19 | } 20 | 21 | //^com let x = foo(~ 22 | 23 | //^com [1,2,3]->m 24 | 25 | //^com "abc"->toU 26 | 27 | let op = Some(3) 28 | 29 | //^com op->e 30 | 31 | module ForAuto = { 32 | type t = int 33 | let abc = (x:t, _y:int) => x 34 | let abd = (x:t, _y:int) => x 35 | } 36 | 37 | let fa:ForAuto.t = 34 38 | //^com fa-> 39 | 40 | //^com "hello"->Js.Dict.u 41 | 42 | module O = { 43 | module Comp = { 44 | @react.component 45 | let make = (~first="", ~zoo=3, ~second) => 46 | React.string(first ++ second ++ string_of_int(zoo)) 47 | } 48 | } 49 | 50 | let zzz = 11 51 | 52 | //^com let comp = int 16 | } = { 17 | let customDouble = foo => foo * 2 18 | } 19 | 20 | module D = Dep 21 | // ^hov 22 | 23 | let cd = D.customDouble 24 | // ^hov 25 | 26 | module HoverInsideModuleWithComponent = { 27 | let x = 2 // check that hover on x works 28 | // ^hov 29 | @react.component 30 | let make = () => React.null 31 | } 32 | 33 | @ocaml.doc("Doc comment for functionWithTypeAnnotation") 34 | let functionWithTypeAnnotation : unit => int = () => 1 35 | // ^hov 36 | 37 | @react.component 38 | let make = (~name) => React.string(name) 39 | // ^hov 40 | 41 | @react.component 42 | let make2 = (~name:string) => React.string(name) 43 | // ^hov -------------------------------------------------------------------------------- /tests/src/Jsx.res: -------------------------------------------------------------------------------- 1 | module M = { 2 | @react.component 3 | let make = (~first, ~fun="", ~second="") => React.string(first ++ fun++ second) 4 | } 5 | 6 | let d = 7 | // ^def 8 | 9 | //^com , 'a => 'b) => Belt.List.t<'b>\n```\n\n`map xs f`\n\nreturn the list obtained by applying `f` to each element of `xs`\n\n```ml\nmap [1;2] (fun x-> x + 1) = [3;4]\n```\n"} 3 | 4 | -------------------------------------------------------------------------------- /tests/src/expected/Definition.res.txt: -------------------------------------------------------------------------------- 1 | Definition tests/src/Definition.res 2:8 2 | {"uri": "Definition.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 6}}} 3 | 4 | Definition tests/src/Definition.res 10:23 5 | {"uri": "Definition.res", "range": {"start": {"line": 6, "character": 7}, "end": {"line": 6, "character": 13}}} 6 | 7 | Hover tests/src/Definition.res 14:14 8 | {"contents": "```rescript\n('a => 'b, list<'a>) => list<'b>\n```\n\n`List.map f [a1; ...; an]` applies function `f` to `a1, ..., an`, and builds the list `[f a1; ...; f an]` with the results returned by `f`. Not tail-recursive.\n\n"} 9 | 10 | Hover tests/src/Definition.res 18:14 11 | {"contents": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n`map xs f`\n\nreturn the list obtained by applying `f` to each element of `xs`\n\n```ml\nmap [1;2] (fun x-> x + 1) = [3;4]\n```\n"} 12 | 13 | -------------------------------------------------------------------------------- /tests/src/expected/Hover.res.txt: -------------------------------------------------------------------------------- 1 | Hover tests/src/Hover.res 0:4 2 | {"contents": "```rescript\nint\n```"} 3 | 4 | Hover tests/src/Hover.res 3:5 5 | {"contents": "```rescript\ntype t = (int, float)\n```"} 6 | 7 | Hover tests/src/Hover.res 6:7 8 | {"contents": "```rescript\nmodule Id = {\n type x = int\n}\n```"} 9 | 10 | Hover tests/src/Hover.res 19:11 11 | {"contents": "\nThis module is commented\n```rescript\nmodule Dep = {\n let customDouble: int => int\n}\n```"} 12 | 13 | Hover tests/src/Hover.res 22:11 14 | {"contents": "```rescript\nint => int\n```\n\nSome doc comment"} 15 | 16 | Hover tests/src/Hover.res 26:6 17 | {"contents": "```rescript\nint\n```"} 18 | 19 | Hover tests/src/Hover.res 33:4 20 | {"contents": "```rescript\nunit => int\n```\n\nDoc comment for functionWithTypeAnnotation"} 21 | 22 | Hover tests/src/Hover.res 37:13 23 | {"contents": "```rescript\nstring\n```"} 24 | 25 | Hover tests/src/Hover.res 41:13 26 | {"contents": "```rescript\nstring\n```"} 27 | 28 | -------------------------------------------------------------------------------- /tests/src/expected/Jsx.res.txt: -------------------------------------------------------------------------------- 1 | Definition tests/src/Jsx.res 5:9 2 | {"uri": "Jsx.res", "range": {"start": {"line": 2, "character": 6}, "end": {"line": 2, "character": 10}}} 3 | 4 | Complete tests/src/Jsx.res 7:2 5 | [] 6 | 7 | Complete tests/src/Jsx.res 10:2 8 | [{ 9 | "label": "key", 10 | "kind": 4, 11 | "tags": [], 12 | "detail": "string", 13 | "documentation": {"kind": "markdown", "value": "\nJsx.res:11"} 14 | }, { 15 | "label": "first", 16 | "kind": 4, 17 | "tags": [], 18 | "detail": "string", 19 | "documentation": {"kind": "markdown", "value": "\nJsx.res:11"} 20 | }, { 21 | "label": "fun", 22 | "kind": 4, 23 | "tags": [], 24 | "detail": "option", 25 | "documentation": {"kind": "markdown", "value": "\nJsx.res:11"} 26 | }] 27 | 28 | --------------------------------------------------------------------------------