├── .gitignore ├── .merlin ├── .npmignore ├── LICENSE.txt ├── README.md ├── errs ├── func_decl_no_arg.ml ├── func_no_arg_call.ml ├── if_param_not_bool.ml ├── let_without_in_in_body.ml ├── load_compile.ml ├── print_func_parens.ml ├── print_operator_infix.ml ├── some_no_parens.ml ├── string_concat.ml ├── syntax_err_no_semi.ml ├── type_unit_forgot_ignore.ml └── undefined_global.ml ├── package.json ├── src ├── Atom.ml ├── berror.re ├── betterErrorsTypes.re ├── helpers.re ├── index.re ├── parseError.re ├── parseWarning.re ├── reportError.re ├── reportWarning.re └── terminalReporter.re └── tests ├── 1_bad_file_name ├── 1_bad_file_name_1.ml └── 1_bad_file_name_1_expected.txt ├── bad-file-name-2 ├── bad-file-name-2_1.ml └── bad-file-name-2_1_expected.txt ├── file_IllegalCharacter ├── file_IllegalCharacter_1.ml └── file_IllegalCharacter_1_expected.txt ├── file_SyntaxError ├── file_SyntaxError_1.ml ├── file_SyntaxError_1_expected.txt ├── file_SyntaxError_2.ml ├── file_SyntaxError_2_expected.txt ├── file_SyntaxError_3.ml ├── file_SyntaxError_3_expected.txt ├── file_SyntaxError_4.ml ├── file_SyntaxError_4_expected.txt ├── file_SyntaxError_5.ml ├── file_SyntaxError_5_expected.txt ├── file_SyntaxError_6.ml └── file_SyntaxError_6_expected.txt ├── misc ├── bound_many_times.ml ├── cannot_be_applied_with_label.ml ├── misc_1.ml ├── misc_2.ml ├── misc_3.ml ├── misc_4.ml ├── misc_5.ml ├── misc_5_2.ml ├── misc_6.ml └── type_AppliedWithoutLabel_1.ml ├── noError ├── noError_1.ml └── noError_1_expected.txt ├── prettyPrint ├── prettyPrint_1.ml ├── prettyPrint_1_expected.txt ├── prettyPrint_2.ml └── prettyPrint_2_expected.txt ├── specialTests ├── specialTests_1_expected.txt ├── specialTests_2_expected.txt ├── specialTests_3_expected.txt └── specialTests_4_expected.txt ├── test.ml ├── type_AppliedTooMany ├── type_AppliedTooMany_1.ml ├── type_AppliedTooMany_1_expected.txt ├── type_AppliedTooMany_2.ml └── type_AppliedTooMany_2_expected.txt ├── type_AppliedWithoutLabel ├── type_AppliedWithoutLabel_1.ml └── type_AppliedWithoutLabel_1_expected.txt ├── type_IncompatibleType ├── type_IncompatibleType_1.ml ├── type_IncompatibleType_1_expected.txt ├── type_IncompatibleType_2.ml ├── type_IncompatibleType_2_expected.txt ├── type_IncompatibleType_3.ml ├── type_IncompatibleType_3_expected.txt ├── type_IncompatibleType_4.ml ├── type_IncompatibleType_4_expected.txt ├── type_IncompatibleType_5.ml ├── type_IncompatibleType_5_expected.txt ├── type_IncompatibleType_6.ml ├── type_IncompatibleType_6_expected.txt ├── type_IncompatibleType_7.ml └── type_IncompatibleType_7_expected.txt ├── type_MismatchTypeArguments ├── type_MismatchTypeArguments_1.ml └── type_MismatchTypeArguments_1_expected.txt ├── type_NotAFunction ├── type_NotAFunction_1.ml └── type_NotAFunction_1_expected.txt ├── type_RecordFieldNotBelong ├── type_RecordFieldNotBelong_1.ml ├── type_RecordFieldNotBelong_1_expected.txt ├── type_RecordFieldNotBelong_2.ml └── type_RecordFieldNotBelong_2_expected.txt ├── type_RecordFieldsUndefined ├── type_RecordFieldsUndefined_1.ml └── type_RecordFieldsUndefined_1_expected.txt ├── type_UnboundModule ├── type_UnboundModule_1.ml ├── type_UnboundModule_1_expected.txt ├── type_UnboundModule_2.ml └── type_UnboundModule_2_expected.txt ├── type_UnboundRecordField ├── type_UnboundRecordField_1.ml ├── type_UnboundRecordField_1_expected.txt ├── type_UnboundRecordField_2.ml └── type_UnboundRecordField_2_expected.txt ├── type_UnboundTypeConstructor ├── type_UnboundTypeConstructor_1.ml ├── type_UnboundTypeConstructor_1_expected.txt ├── type_UnboundTypeConstructor_2.ml └── type_UnboundTypeConstructor_2_expected.txt ├── type_UnboundValue ├── type_UnboundValue_1.ml ├── type_UnboundValue_1_expected.txt ├── type_UnboundValue_2.ml ├── type_UnboundValue_2_expected.txt ├── type_UnboundValue_3.ml ├── type_UnboundValue_3_expected.txt ├── type_UnboundValue_4.ml └── type_UnboundValue_4_expected.txt ├── warning_OptionalArgumentNotErased ├── warning_OptionalArgumentNotErased_1.ml ├── warning_OptionalArgumentNotErased_1_expected.txt ├── warning_OptionalArgumentNotErased_2.ml └── warning_OptionalArgumentNotErased_2_expected.txt ├── warning_PatternNotExhaustive ├── warning_PatternNotExhaustive_1.ml ├── warning_PatternNotExhaustive_1_expected.txt ├── warning_PatternNotExhaustive_1_expected_bk.txt ├── warning_PatternNotExhaustive_2.ml ├── warning_PatternNotExhaustive_2_expected.txt └── warning_PatternNotExhaustive_2_expected_bk.txt └── warning_PatternUnused ├── warning_PatternUnused_1.ml └── warning_PatternUnused_1_expected.txt /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | 3 | *.cmo 4 | *.out 5 | *.cmi 6 | 7 | _build 8 | *.native 9 | *.byte 10 | *.docdir 11 | 12 | setup.data 13 | setup.log 14 | 15 | /tests/**/*actual.txt 16 | 17 | node_modules 18 | .jenga 19 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | # This file is autogenerated for 2 | # [Merlin](https://github.com/the-lambda-church/merlin), a static analyser for 3 | # OCaml that provides autocompletion, jump-to-location, recoverable syntax 4 | # errors, type errors detection, etc., that your editor can use. To activate it, 5 | # one usually provides a .merlin file at the root of a project, describing where 6 | # the sources and artifacts are. Since we dictated the project structure, we can 7 | # auto generate .merlin files! 8 | 9 | # S is the merlin flag for source files 10 | S src 11 | 12 | # Include all the third-party sources too. You might notice that we've put a 13 | # .merlin into each node_modules package. This is subtle; in short, it's to make 14 | # jump-to-location work correctly in conjunction with our build & namespacing 15 | # setup, when you jump into a third-party file. 16 | S ./node_modules/**/src 17 | 18 | # B stands for build (artifacts). We generate ours into _build 19 | B ./_build/* 20 | 21 | # PKG lists packages found through ocamlfind (aka findlib), a tool for finding 22 | # the location of third-party dependencies. For us, most of our third-party deps 23 | # reside in `node_modules/` (made visible to Merlin through the S command 24 | # above); this PKG command is for discovering the opam/ocamlfind packages. 25 | PKG 26 | 27 | # FLG is the set of flags to pass to Merlin, as if it used ocamlc to compile and 28 | # understand our sources. You don't have to understand what these flags are for 29 | # now; but if you're curious, go check the jengaroot.ml that generated this 30 | # .merlin at https://github.com/chenglou/jengaboot 31 | FLG -w -30 -w -40 -open Top 32 | -------------------------------------------------------------------------------- /.npmignore: -------------------------------------------------------------------------------- 1 | errs 2 | asd.js 3 | _build/ 4 | .* 5 | .merlin 6 | a.out 7 | tests 8 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015-present Cheng Lou 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 6 | 7 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## THIS REPO IS DEPRECATED 2 | 3 | BetterErrors is now built into [bsb](https://bucklescript.github.io/bucklescript/Manual.html#_bucklescript_build_system_code_bsb_code). You can enable it through adding `"bsc-flags": ["-bs-super-errors"]` in bsconfig.json. Accompanying blog post [here](https://reasonml.github.io/community/blog/#way-way-waaaay-nicer-error-messages). 4 | 5 | ## === Old Setup === 6 | 7 | 8 | ### Setup 9 | 10 | To install BetterErrors we recommend installing [reason-cli](https://github.com/reasonml/reason-cli) which ships with BetterErrors by default. 11 | 12 | #### Before 13 | ![Before](https://cloud.githubusercontent.com/assets/1909539/13025465/4baf80c2-d1d6-11e5-8f88-1d7b8065567c.png) 14 | 15 | #### After 16 | ![Glorious After](https://cloud.githubusercontent.com/assets/1909539/13025466/4bc78262-d1d6-11e5-9dcc-2f9046dc1950.png) 17 | 18 | #### Before 19 | ![Before](https://cloud.githubusercontent.com/assets/1909539/13025491/a47377f4-d1d6-11e5-9c12-c0b5285dba47.png) 20 | 21 | #### After 22 | ![Glorious After](https://cloud.githubusercontent.com/assets/1909539/13025492/a4895d30-d1d6-11e5-996a-b7e0e2ba63bf.png) 23 | 24 | ```sh 25 | someCompilationCommand 2>&1 | berror 26 | ``` 27 | 28 | **Explanation**: `2>&1 |` means "pipe the stuff from stderr into stdout, then pipe it back into stdin of the next command". `berror` takes in this info and searches for errors to pretty-print back. 29 | 30 | To format the output in [Reason](https://github.com/facebook/reason) syntax, use `berror --path-to-refmttype thePathToRefmttype` (where `refmttype` is a binary exposed by Reason). 31 | 32 | Have fun! 33 | 34 | ### For Development 35 | `git clone` this repo, `cd` into it, then run: 36 | 37 | ```sh 38 | npm install 39 | # to compile 40 | npm start 41 | # to test, currently broken 42 | npm test 43 | ``` 44 | -------------------------------------------------------------------------------- /errs/func_decl_no_arg.ml: -------------------------------------------------------------------------------- 1 | let a = print_endline 5 2 | 3 | err bc func with 0 arg need to be appended () during declaration 4 | 5 | let a () = print_endline 5 6 | -------------------------------------------------------------------------------- /errs/func_no_arg_call.ml: -------------------------------------------------------------------------------- 1 | let asd () = 5;; 2 | print_int asd;; 3 | 4 | (* err bc func with 0 arg need to be appended () *) 5 | 6 | let asd () = 5;; 7 | print_int (asd ());; 8 | -------------------------------------------------------------------------------- /errs/if_param_not_bool.ml: -------------------------------------------------------------------------------- 1 | if 123 then "asd" else "a" 2 | 3 | (* err bc ocaml if takes boolean, no casting *) 4 | 5 | (* if true then "asd" else "a" *) 6 | -------------------------------------------------------------------------------- /errs/let_without_in_in_body.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let a = 5; 3 | print_int a 4 | 5 | (* let binding in body needs to be let ... in ... *) 6 | 7 | let () = 8 | let a = 5 in 9 | print_int a 10 | -------------------------------------------------------------------------------- /errs/load_compile.ml: -------------------------------------------------------------------------------- 1 | #load "str.cma";; 2 | 3 | (* err bc interpreter uses load but compiler needs linking? *) 4 | 5 | (* need to remove loads. then try: *) 6 | (* ocamlc str.cma yourFile.ml *) 7 | (* ocamlc str.cma yourFile.ml *) 8 | -------------------------------------------------------------------------------- /errs/print_func_parens.ml: -------------------------------------------------------------------------------- 1 | let () = print_string String.capitalize "asd" 2 | 3 | (* err bc need parens, precedence *) 4 | 5 | let () = print_string (String.capitalize "asd") 6 | -------------------------------------------------------------------------------- /errs/print_operator_infix.ml: -------------------------------------------------------------------------------- 1 | let () = print_int 5 + 6 2 | 3 | (* err bc need parens, precedence *) 4 | 5 | let () = print_int (5 + 6) 6 | -------------------------------------------------------------------------------- /errs/some_no_parens.ml: -------------------------------------------------------------------------------- 1 | let a = Some 5 + 6 2 | 3 | (* err bc no parens *) 4 | 5 | let a = Some (5 + 6) 6 | -------------------------------------------------------------------------------- /errs/string_concat.ml: -------------------------------------------------------------------------------- 1 | let () = "asd" + "asd" 2 | 3 | (* err bc type don't match, doesn't work adding () at the end *) 4 | 5 | let () = "asd" ^ "asd" 6 | -------------------------------------------------------------------------------- /errs/syntax_err_no_semi.ml: -------------------------------------------------------------------------------- 1 | let () = print_endline "asd" 2 | 3 | let r = 5 in print_int r 4 | 5 | (* error bc forgot semicolon and top level confusing-ness *) 6 | 7 | let () = print_endline "asd";; 8 | 9 | let r = 5 in print_int r 10 | -------------------------------------------------------------------------------- /errs/type_unit_forgot_ignore.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let r = Str.regexp "hello \\([A-Za-z]+\\)" in 3 | Str.replace_first r "\\1" "hello world" 4 | 5 | (* err bc type don't match, doesn't work adding () at the end *) 6 | 7 | let () = 8 | let r = Str.regexp "hello \\([A-Za-z]+\\)" in 9 | ignore (Str.replace_first r "\\1" "hello world") 10 | -------------------------------------------------------------------------------- /errs/undefined_global.ml: -------------------------------------------------------------------------------- 1 | let ph = Unix.open_process_in "cmd 2>&1" 2 | 3 | (* err bc Unix needs to be loaded via #load "unix.cma";; *) 4 | (* see load_compile for further errors *) 5 | 6 | #load "unix.cma" 7 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "ocamlBetterErrors", 3 | "version": "0.1.1", 4 | "description": "Better errors for ocaml", 5 | "dependencies": { 6 | "@opam-alpha/re": "*", 7 | "reason": "^1.9.0", 8 | "dependency-env": "*", 9 | "nopam": "*" 10 | }, 11 | "repository": { 12 | "type": "git", 13 | "url": "git+https://github.com/chenglou/BetterErrors.git" 14 | }, 15 | "author": "chenglou", 16 | "devDependencies": {}, 17 | "scripts": { 18 | "start": "eval $(dependencyEnv) && nopam && rebuild -pkg re.pcre -pkg unix src/berror.native", 19 | "test": "npm run start && ocaml tests/test.ml", 20 | "postinstall": "npm start" 21 | }, 22 | "exportedEnvVars": { 23 | "PATH": { 24 | "global": true, 25 | "globalCollisionBehavior": "joinPath", 26 | "resolveAsRelativePath": true, 27 | "val": "./_build/src/" 28 | } 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /src/Atom.ml: -------------------------------------------------------------------------------- 1 | module Range = 2 | struct 3 | type t = ((int* int)* (int* int)) 4 | let emptyRange = ((0, 0), (0, 0)) 5 | end 6 | module NuclideDiagnostic = 7 | struct 8 | type filePath = string 9 | type diagnosticType = 10 | | Error 11 | | Warning 12 | module Trace = 13 | struct 14 | type t = 15 | { 16 | typee: [ `trace ]; 17 | text: string option; 18 | html: string option; 19 | filePath: filePath; 20 | range: Range.t option;} 21 | end 22 | module Message = 23 | struct 24 | type 'a fileDiagnosticMessage = 25 | { 26 | scope: [ `file ]; 27 | providerName: string; 28 | typee: diagnosticType; 29 | filePath: filePath; 30 | text: string option; 31 | html: string option; 32 | range: Range.t option; 33 | trace: Trace.t array option; 34 | originalData: 'a;} 35 | type 'a projectDiagnosticMessage = 36 | { 37 | scope: [ `project ]; 38 | providerName: string; 39 | typee: diagnosticType; 40 | text: string option; 41 | html: string option; 42 | range: Range.t option; 43 | trace: Trace.t array option; 44 | originalData: 'a;} 45 | type 'a t = 46 | | FileDiagnosticMessage of 'a fileDiagnosticMessage 47 | | ProjectDiagnosticMessage of 'a projectDiagnosticMessage 48 | end 49 | end 50 | -------------------------------------------------------------------------------- /src/berror.re: -------------------------------------------------------------------------------- 1 | let usage = {|BetterErrors 2 | 3 | [Usage]: 4 | myBuildOutput 2>&1 | berror 5 | 6 | Output errors in Reason syntax: 7 | myBuildOutput 2>&1 | berror --path-to-refmttype 8 | |}; 9 | 10 | let refmttypePath = ref None; 11 | 12 | let options = [ 13 | ( 14 | "--path-to-refmttype", 15 | Arg.String (fun x => refmttypePath := Some x), 16 | ", parse AST as (either 'ml', 're', 'binary_reason(for interchange between Reason versions)', 'binary (from the ocaml compiler)')" 17 | ) 18 | ]; 19 | 20 | let () = 21 | Arg.parse 22 | options 23 | ( 24 | fun arg => 25 | prerr_endline "BetterErrors (berror) doesn't accept anonymous arguments in the command line." 26 | ) 27 | usage; 28 | 29 | 1; 30 | 31 | Index.parseFromStdin refmttypePath::!refmttypePath customErrorParsers::[]; 32 | -------------------------------------------------------------------------------- /src/betterErrorsTypes.re: -------------------------------------------------------------------------------- 1 | /* records that are only used by their variant tag of similar name below. We 2 | need inline record type declarations... */ 3 | type mismatchTypeArguments = {typeConstructor: string, expectedCount: int, actualCount: int}; 4 | 5 | type unboundValue = {unboundValue: string, suggestions: option (list string)}; 6 | 7 | type signatureMismatch = {constructor: string, expectedCount: int, observedCount: int}; 8 | 9 | type signatureItemMissing = {constructor: string, expectedCount: int, observedCount: int}; 10 | 11 | type unboundModule = {unboundModule: string, suggestion: option string}; 12 | 13 | type unboundConstructor = {constructor: string, expectedCount: int, observedCount: int}; 14 | 15 | type unboundTypeConstructor = {namespacedConstructor: string, suggestion: option string}; 16 | 17 | type appliedTooMany = {functionType: string, expectedArgCount: int}; 18 | 19 | type recordFieldNotInExpression = {constructor: string, expectedCount: int, observedCount: int}; 20 | 21 | type recordFieldError = {constructor: string, expectedCount: int, observedCount: int}; 22 | 23 | type inconsistentAssumptions = {constructor: string, expectedCount: int, observedCount: int}; 24 | 25 | type catchAll = {warningCode: int, message: string}; 26 | 27 | type unusedVariable = {constructor: string, expectedCount: int, observedCount: int}; 28 | 29 | type fieldNotBelong = {actual: string, expected: string}; 30 | 31 | type badFileName = 32 | | Leading string 33 | | Contains string 34 | | UnknownIllegalChar; 35 | 36 | type incompatibleType = { 37 | actual: string, 38 | expected: string, 39 | differingPortion: (string, string), 40 | actualEquivalentType: option string, 41 | expectedEquivalentType: option string, 42 | extra: option string 43 | }; 44 | 45 | type notAFunction = {actual: string}; 46 | 47 | type syntaxError = {offendingString: string, hint: option string}; 48 | 49 | type illegalCharacter = {character: string}; 50 | 51 | type patternNotExhaustive = {unmatched: list string}; 52 | 53 | type unparsableButWithFileInfo = {error: string}; 54 | 55 | type unboundRecordField = {recordField: string, suggestion: option string}; 56 | 57 | type optionalArgumentNotErased = {argumentName: string}; 58 | 59 | /* -------------------------- */ 60 | type warningType = 61 | | Warning_UnusedVariable unusedVariable 62 | | Warning_PatternNotExhaustive patternNotExhaustive 63 | | Warning_PatternUnused unusedVariable 64 | | Warning_OptionalArgumentNotErased optionalArgumentNotErased 65 | | Warning_BadFileName badFileName 66 | | Warning_CatchAll string; 67 | 68 | type error = 69 | | Type_MismatchTypeArguments mismatchTypeArguments 70 | | Type_UnboundValue unboundValue 71 | | Type_SignatureMismatch signatureMismatch 72 | | Type_SignatureItemMissing signatureItemMissing 73 | | Type_UnboundModule unboundModule 74 | | Type_UnboundRecordField unboundRecordField 75 | | Type_UnboundConstructor unboundConstructor 76 | | Type_UnboundTypeConstructor unboundTypeConstructor 77 | | Type_AppliedTooMany appliedTooMany 78 | | Type_RecordFieldNotInExpression recordFieldNotInExpression 79 | | Type_RecordFieldError recordFieldError 80 | /* might be the same thing as above? jordan wrote "record expression" instead of "pattern" */ 81 | | Type_RecordFieldNotBelong recordFieldError 82 | | Type_FieldNotBelong fieldNotBelong 83 | | Type_IncompatibleType incompatibleType 84 | | Type_NotAFunction notAFunction 85 | | File_SyntaxError syntaxError 86 | | Build_InconsistentAssumptions inconsistentAssumptions 87 | | File_IllegalCharacter illegalCharacter 88 | | Error_CatchAll string; 89 | 90 | type fileError = 91 | | NoneFile string 92 | | NonexistentFile 93 | | CommandLine string 94 | | Stdin string; 95 | 96 | type warning = {code: int, warningType: warningType}; 97 | 98 | type withFileInfo 'a = { 99 | filePath: string, 100 | cachedContent: list string, 101 | range: Atom.Range.t, 102 | parsedContent: 'a 103 | }; 104 | 105 | type result = 106 | | Unparsable string 107 | | ErrorFile fileError 108 | | ErrorContent (withFileInfo error) 109 | | Warning (withFileInfo warning); 110 | -------------------------------------------------------------------------------- /src/helpers.re: -------------------------------------------------------------------------------- 1 | /* Batteries library substitutes */ 2 | let listDrop n lst => { 3 | let lst = ref lst; 4 | for i in 1 to n { 5 | lst := List.tl !lst 6 | }; 7 | !lst 8 | }; 9 | 10 | let listDropWhile f lst => { 11 | let lst = ref lst; 12 | while (f (List.hd !lst)) { 13 | lst := List.tl !lst 14 | }; 15 | !lst 16 | }; 17 | 18 | let listTake n lst => { 19 | let result = ref []; 20 | let lst = ref lst; 21 | for i in 1 to n { 22 | result := [List.hd !lst, ...!result]; 23 | lst := List.tl !lst 24 | }; 25 | List.rev !result 26 | }; 27 | 28 | let listTakeWhile f lst => { 29 | let result = ref []; 30 | let lst = ref lst; 31 | while (f (List.hd !lst)) { 32 | result := [List.hd !lst, ...!result]; 33 | lst := List.tl !lst 34 | }; 35 | List.rev !result 36 | }; 37 | 38 | let optionGet a => 39 | switch a { 40 | | Some n => n 41 | | None => raise (Invalid_argument "optionGet") 42 | }; 43 | 44 | let optionMap f a => 45 | switch a { 46 | | Some a' => Some (f a') 47 | | None => None 48 | }; 49 | 50 | let listFilterMap f lst => 51 | List.map f lst |> 52 | List.filter ( 53 | fun 54 | | Some a => true 55 | | None => false 56 | ) |> 57 | List.map optionGet; 58 | 59 | let listFindMap f lst => 60 | lst |> 61 | List.find ( 62 | fun a => 63 | switch (f a) { 64 | | Some x => true 65 | | None => false 66 | } 67 | ) |> f |> optionGet; 68 | 69 | let stringSlice ::first=0 ::last=? str => { 70 | let last = 71 | switch last { 72 | | Some l => min l (String.length str) 73 | | None => String.length str 74 | }; 75 | if (last <= first) { 76 | "" 77 | } else { 78 | String.sub str first (last - first) 79 | } 80 | }; 81 | 82 | let stringFind str part => { 83 | let rec find' str part idx => 84 | if (String.length str < String.length part) { 85 | raise Not_found 86 | } else if ( 87 | stringSlice str last::(String.length part) == part 88 | ) { 89 | idx 90 | } else { 91 | find' (stringSlice str first::1) part (idx + 1) 92 | }; 93 | find' str part 0 94 | }; 95 | 96 | let stringNsplit str ::by => 97 | if (String.length str == 0) { 98 | raise (Invalid_argument "stringNSplit: empty str not allowed") 99 | } else if ( 100 | str == "" 101 | ) { 102 | [] 103 | } else { 104 | let rec split' str ::by accum curr => { 105 | let lengthBy = String.length by; 106 | let lengthStr = String.length str; 107 | if (lengthStr < lengthBy) { 108 | [curr ^ str, ...accum] 109 | } else if (String.sub str 0 lengthBy == by) { 110 | split' (String.sub str lengthBy (lengthStr - lengthBy)) ::by [curr, ...accum] "" 111 | } else { 112 | split' (String.sub str 1 (lengthStr - 1)) ::by accum (curr ^ String.sub str 0 1) 113 | } 114 | }; 115 | split' str ::by [] "" |> List.rev 116 | }; 117 | 118 | let stringSplit str ::by => 119 | if (by == "") { 120 | ("", str) 121 | } else if (str == "") { 122 | raise Not_found 123 | } else { 124 | switch (stringNsplit str ::by) { 125 | | [] 126 | | [_] => raise Not_found 127 | | [x, ...xs] => (x, String.concat by xs) 128 | } 129 | }; 130 | 131 | let linesOfChannelExn chan => { 132 | let lines = ref []; 133 | try { 134 | while true { 135 | lines := [input_line chan, ...!lines] 136 | }; 137 | !lines 138 | } { 139 | | End_of_file => 140 | close_in chan; 141 | List.rev !lines 142 | } 143 | }; 144 | 145 | let fileLinesOfExn filePath => linesOfChannelExn (open_in filePath); 146 | 147 | /* ============ */ 148 | let get_match_n n pat str => { 149 | let rex = Re_pcre.regexp pat; 150 | Re_pcre.get_substring (Re_pcre.exec ::rex str) n 151 | }; 152 | 153 | /* get the first (presumably only) match in a string */ 154 | let get_match = get_match_n 1; 155 | 156 | let get_match_maybe pat str => { 157 | let rex = Re_pcre.regexp pat; 158 | try (Some (Re_pcre.get_substring (Re_pcre.exec ::rex str) 1)) { 159 | | Not_found => None 160 | } 161 | }; 162 | 163 | let get_match_n_maybe n pat str => { 164 | let rex = Re_pcre.regexp pat; 165 | try (Some (Re_pcre.get_substring (Re_pcre.exec ::rex str) n)) { 166 | | _ => None 167 | } 168 | }; 169 | 170 | let execMaybe pat str => { 171 | let rex = Re_pcre.regexp pat; 172 | try (Some (Re_pcre.exec ::rex str)) { 173 | | Not_found => None 174 | } 175 | }; 176 | 177 | let getSubstringMaybe result n => 178 | try (Some (Re_pcre.get_substring result n)) { 179 | | Not_found => None 180 | }; 181 | 182 | let split sep str => { 183 | let rex = Re_pcre.regexp sep; 184 | Re_pcre.split ::rex str 185 | }; 186 | 187 | let rec splitInto ::chunckSize (l: list 'a) :list (list 'a) => 188 | if (List.length l <= chunckSize || chunckSize == 0) { 189 | [l] 190 | } else { 191 | [listTake chunckSize l, ...splitInto ::chunckSize (listDrop chunckSize l)] 192 | }; 193 | 194 | let resetANSI = "\027[0m"; 195 | 196 | let red s => "\027[31m" ^ s ^ resetANSI; 197 | 198 | let redUnderlined s => "\027[31;4m" ^ s ^ resetANSI; 199 | 200 | let yellow s => "\027[33m" ^ s ^ resetANSI; 201 | 202 | let yellowUnderlined s => "\027[33;4m" ^ s ^ resetANSI; 203 | 204 | let green s => "\027[32m" ^ s ^ resetANSI; 205 | 206 | let cyan s => "\027[36m" ^ s ^ resetANSI; 207 | 208 | let mapcat sep f l => String.concat sep (List.map f l); 209 | 210 | let sp = Printf.sprintf; 211 | 212 | let highlight ::color=red ::first=0 ::last=99999 str => 213 | stringSlice last::first str ^ 214 | (color @@ stringSlice ::first ::last str) ^ stringSlice first::last str; 215 | -------------------------------------------------------------------------------- /src/index.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | /* the compiler output might point to an error that spans across many lines; 6 | however, instead of indicating from (startRow, startColumn) to (endRow, 7 | endColumn), it'll indicate (startRow, startColumn, endColumn) where endColumn 8 | might belong to a different row! We normalize and find the row here */ 9 | /* the compiler line number is 1-indexed, and col number is 0-indexed but the 10 | endColumn for an error goes past the last "expected" endColumn, e.g. if it's 11 | `typ a = string` 12 | instead of saying it's from 0 to 2, it shows as 0 to 3. This is also kinda 13 | expected, since you get easy column count through 3 - 0 */ 14 | /* we'll use 0-indexed. It's a reporter (printer)'s job to normalize to 15 | 1-indexed if it desires so */ 16 | let normalizeCompilerLineColsToRange ::fileLines ::lineRaw ::col1Raw ::col2Raw => { 17 | /* accept strings to constraint usage to parse directly from raw data */ 18 | let line = int_of_string lineRaw; 19 | let fileLength = List.length fileLines; 20 | let isOCamlBeingBadAndPointingToALineBeyondFileLength = line > fileLength; 21 | let (col1, col2) = 22 | if isOCamlBeingBadAndPointingToALineBeyondFileLength { 23 | let lastDamnReachableSpotInTheFile = String.length @@ List.nth fileLines (fileLength - 1); 24 | (lastDamnReachableSpotInTheFile - 1, lastDamnReachableSpotInTheFile) 25 | } else { 26 | switch (col1Raw, col2Raw) { 27 | | (Some a, Some b) => (int_of_string a, int_of_string b) 28 | /* some error msgs don't have column numbers; we normal them to 0 here */ 29 | | _ => (0, 0) 30 | } 31 | }; 32 | let startRow = 33 | if isOCamlBeingBadAndPointingToALineBeyondFileLength { 34 | fileLength - 1 35 | } else { 36 | line - 1 37 | }; 38 | let currentLine = List.nth fileLines startRow; 39 | let numberOfCharsBetweenStartAndEndColumn = col2 - col1; 40 | let numberOfCharsLeftToCoverOnStartingRow = 41 | /* +1 bc ocaml looooves to count new line as a char below when the error 42 | spans multiple lines*/ 43 | String.length currentLine - col1 + 1; 44 | if (numberOfCharsBetweenStartAndEndColumn <= numberOfCharsLeftToCoverOnStartingRow) { 45 | ((startRow, col1), (startRow, col2)) 46 | } else { 47 | let howManyCharsLeftToCoverOnSubsequentLines = 48 | ref (numberOfCharsBetweenStartAndEndColumn - numberOfCharsLeftToCoverOnStartingRow); 49 | let suddenlyFunctionalProgrammingOutOfNowhere = 50 | fileLines |> Helpers.listDrop (startRow + 1) |> List.map String.length |> 51 | Helpers.listTakeWhile ( 52 | fun numberOfCharsOnThisLine => 53 | if (!howManyCharsLeftToCoverOnSubsequentLines > numberOfCharsOnThisLine) { 54 | howManyCharsLeftToCoverOnSubsequentLines := 55 | !howManyCharsLeftToCoverOnSubsequentLines - numberOfCharsOnThisLine - 1; 56 | true 57 | } else { 58 | false 59 | } 60 | ); 61 | let howManyMoreRowsCoveredSinceStartRow = 62 | 1 + List.length suddenlyFunctionalProgrammingOutOfNowhere; 63 | ( 64 | (startRow, col1), 65 | (startRow + howManyMoreRowsCoveredSinceStartRow, !howManyCharsLeftToCoverOnSubsequentLines) 66 | ) 67 | } 68 | }; 69 | 70 | /* has the side-effect of reading the file */ 71 | let extractFromFileMatch fileMatch => 72 | Re_pcre.( 73 | switch fileMatch { 74 | | [ 75 | Delim _, 76 | Group _ filePath [@implicit_arity], 77 | Group _ lineNum [@implicit_arity], 78 | col1, 79 | col2, 80 | Text body 81 | ] => 82 | let cachedContent = Helpers.fileLinesOfExn filePath; 83 | /* sometimes there's only line, but no characters */ 84 | let (col1Raw, col2Raw) = 85 | switch (col1, col2) { 86 | | (Group _ c1 [@implicit_arity], Group _ c2 [@implicit_arity]) => 87 | /* bug: https://github.com/mmottl/pcre-ocaml/issues/5 */ 88 | if (String.trim c1 == "" || String.trim c2 == "") { 89 | (None, None) 90 | } else { 91 | (Some c1, Some c2) 92 | } 93 | | _ => (None, None) 94 | }; 95 | ( 96 | filePath, 97 | cachedContent, 98 | normalizeCompilerLineColsToRange 99 | fileLines::cachedContent lineRaw::lineNum ::col1Raw ::col2Raw, 100 | /* important, otherwise leaves random blank lines that defies some of 101 | our regex logic, maybe */ 102 | String.trim body 103 | ) 104 | | _ => raise (invalid_arg "Couldn't extract error") 105 | } 106 | ); 107 | 108 | /* debug helper */ 109 | let printFullSplitResult = 110 | List.iteri ( 111 | fun i x => { 112 | print_int i; 113 | print_endline ""; 114 | Re_pcre.( 115 | switch x { 116 | | Delim a => print_endline @@ "Delim " ^ a 117 | | Group _ a [@implicit_arity] => print_endline @@ "Group " ^ a 118 | | Text a => print_endline @@ "Text " ^ a 119 | | NoGroup => print_endline @@ "NoGroup" 120 | } 121 | ) 122 | } 123 | ); 124 | 125 | let fileR = 126 | Re_pcre.regexp 127 | flags::[Re_pcre.(`MULTILINE)] 128 | {|^File "([\s\S]+?)", line (\d+)(?:, characters (\d+)-(\d+))?:$|}; 129 | 130 | let hasErrorOrWarningR = Re_pcre.regexp flags::[Re_pcre.(`MULTILINE)] {|^(Error|Warning \d+): |}; 131 | 132 | let hasIndentationR = Re_pcre.regexp flags::[Re_pcre.(`MULTILINE)] {|^ +|}; 133 | 134 | /* TODO: make the below work. the "Here is an example..." is followed by even more lines of hints */ 135 | /* let hasHintRStr = {|^(Hint: Did you mean |Here is an example of a value that is not matched:)|} */ 136 | /* let hasHintRStr = {|^(Here is an example of a value that is not matched:|Hint: Did you mean )|} */ 137 | let hasHintRStr = {|^Hint: Did you mean |}; 138 | 139 | let hasHintR = Re_pcre.regexp flags::[Re_pcre.(`MULTILINE)] hasHintRStr; 140 | 141 | let parse ::customErrorParsers err => { 142 | /* we know whatever err is, it starts with "File: ..." because that's how `parse` 143 | is used */ 144 | let err = String.trim err; 145 | try 146 | Re_pcre.( 147 | switch (full_split rex::fileR err) { 148 | | [ 149 | Delim _, 150 | Group _ filePath [@implicit_arity], 151 | Group _ lineNum [@implicit_arity], 152 | col1, 153 | col2, 154 | Text body 155 | ] => 156 | /* important, otherwise leaves random blank lines that defies some of 157 | our regex logic, maybe */ 158 | let body = String.trim body; 159 | let errorCapture = get_match_maybe {|^Error: ([\s\S]+)|} body; 160 | switch (ParseError.specialParserThatChecksWhetherFileEvenExists filePath errorCapture) { 161 | | Some err => err 162 | | None => 163 | let cachedContent = Helpers.fileLinesOfExn filePath; 164 | /* sometimes there's only line, but no characters */ 165 | let (col1Raw, col2Raw) = 166 | switch (col1, col2) { 167 | | (Group _ c1 [@implicit_arity], Group _ c2 [@implicit_arity]) => 168 | /* bug: https://github.com/mmottl/pcre-ocaml/issues/5 */ 169 | if (String.trim c1 == "" || String.trim c2 == "") { 170 | raise (Invalid_argument "HUHUHUH") 171 | } else { 172 | (Some c1, Some c2) 173 | } 174 | | _ => (None, None) 175 | }; 176 | let range = 177 | normalizeCompilerLineColsToRange 178 | fileLines::cachedContent lineRaw::lineNum ::col1Raw ::col2Raw; 179 | let warningCapture = 180 | switch (execMaybe {|^Warning (\d+): ([\s\S]+)|} body) { 181 | | None => (None, None) 182 | | Some capture => (getSubstringMaybe capture 1, getSubstringMaybe capture 2) 183 | }; 184 | switch (errorCapture, warningCapture) { 185 | | (Some errorBody, (None, None)) => 186 | ErrorContent { 187 | filePath, 188 | cachedContent, 189 | range, 190 | parsedContent: 191 | ParseError.parse ::customErrorParsers ::errorBody ::cachedContent ::range 192 | } 193 | | (None, (Some code, Some warningBody)) => 194 | let code = int_of_string code; 195 | Warning { 196 | filePath, 197 | cachedContent, 198 | range, 199 | parsedContent: { 200 | code, 201 | warningType: ParseWarning.parse code warningBody filePath cachedContent range 202 | } 203 | } 204 | | _ => raise (Invalid_argument err) 205 | } 206 | } 207 | /* not an error, not a warning. False alarm? */ 208 | | _ => Unparsable err 209 | } 210 | ) { 211 | | _ => Unparsable err 212 | } 213 | }; 214 | 215 | let line_stream_of_channel channel => 216 | Stream.from ( 217 | fun _ => 218 | try (Some (input_line channel)) { 219 | | End_of_file => None 220 | } 221 | ); 222 | 223 | /* entry point, for convenience purposes for now. Theoretically the parser and 224 | the reporters are decoupled */ 225 | let parseFromStdin ::refmttypePath ::customErrorParsers => { 226 | let errBuffer = ref ""; 227 | let prettyPrintParsedResult = TerminalReporter.prettyPrintParsedResult ::refmttypePath; 228 | try { 229 | line_stream_of_channel stdin |> 230 | Stream.iter ( 231 | fun line => 232 | switch ( 233 | errBuffer.contents, 234 | Re_pcre.pmatch rex::fileR line, 235 | Re_pcre.pmatch rex::hasErrorOrWarningR line, 236 | Re_pcre.pmatch rex::hasIndentationR line 237 | ) { 238 | | ("", false, false, false) => 239 | /* no error, just stream on the line */ 240 | print_endline line 241 | | ("", true, _, _) 242 | | ("", _, true, _) 243 | | ("", _, _, true) => 244 | /* the beginning of a new error! */ 245 | errBuffer := line ^ "\n" 246 | /* don't parse it yet. Maybe the error's continuing on the next line */ 247 | | (_, true, _, _) => 248 | /* we have a file match, AND the current errBuffer isn't empty? We'll 249 | just assume here that this is also the beginning of a new error, unless 250 | a single error might span many (non-indented, god forbid) fileNames. 251 | Print out the current (previous) error and keep accumulating */ 252 | parse ::customErrorParsers errBuffer.contents |> prettyPrintParsedResult |> print_endline; 253 | errBuffer := line ^ "\n" 254 | | (_, _, _, true) 255 | | (_, _, true, _) => 256 | /* buffer not empty, and we're seeing an error/indentation line. This is 257 | the continuation of a currently streaming error/warning */ 258 | errBuffer := errBuffer.contents ^ line ^ "\n" 259 | | (_, false, false, false) => 260 | /* woah this case was previously forgotten but caught by the compiler. 261 | Man I don't ever wanna write an if-else anymore */ 262 | /* buffer not empty, and no indentation and not an error/file line? This 263 | means the previous error might have ended. We say "might" because some 264 | errors provide non-indented messages... here's one such case */ 265 | if (Re_pcre.pmatch rex::hasHintR line) { 266 | errBuffer := errBuffer.contents ^ line ^ "\n"; 267 | parse ::customErrorParsers errBuffer.contents |> prettyPrintParsedResult |> print_endline; 268 | errBuffer := "" 269 | } else { 270 | parse ::customErrorParsers errBuffer.contents |> prettyPrintParsedResult |> print_endline; 271 | errBuffer := line ^ "\n" 272 | } 273 | } 274 | ); 275 | /* might have accumulated a few more lines */ 276 | if (String.trim errBuffer.contents != "") { 277 | parse ::customErrorParsers errBuffer.contents |> prettyPrintParsedResult |> print_endline 278 | }; 279 | close_in stdin 280 | } { 281 | | e => 282 | close_in stdin; 283 | raise e 284 | } 285 | }; 286 | -------------------------------------------------------------------------------- /src/parseError.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | /* agnostic extractors, turning err string into proper data structures */ 6 | /* TODO: don't make these raise error */ 7 | /* get the diffing portion of two incompatible types, columns are 0-indexed */ 8 | let stripCommonPrefix (l1, l2) => { 9 | let i = ref 0; 10 | while (!i < List.length l1 && !i < List.length l2 && List.nth l1 !i == List.nth l2 !i) { 11 | i := !i + 1 12 | }; 13 | (Helpers.listDrop !i l1, Helpers.listDrop !i l2) 14 | }; 15 | 16 | let applyToBoth f (a, b) => (f a, f b); 17 | 18 | let typeDiff a b => 19 | /* look ma, functional programming! */ 20 | (Helpers.stringNsplit a by::".", Helpers.stringNsplit b by::".") |> stripCommonPrefix |> 21 | applyToBoth List.rev |> stripCommonPrefix |> 22 | applyToBoth List.rev |> 23 | applyToBoth (String.concat "."); 24 | 25 | let splitEquivalentTypes raw => 26 | try (Some (Helpers.stringSplit raw by::"=")) { 27 | | Not_found => None 28 | }; 29 | 30 | let functionArgsCount str => { 31 | /* the func type 'a -> (int -> 'b) -> string has 2 arguments */ 32 | /* strip out false positive -> from nested function types passed as param */ 33 | let nestedFunctionTypeR = Re_pcre.regexp {|\([\s\S]+\)|}; 34 | let cleaned = Re_pcre.substitute rex::nestedFunctionTypeR subst::(fun _ => "|||||") str; 35 | /* TODO: allow pluggable function type syntax */ 36 | List.length (split {|->|} cleaned) - 1 37 | }; 38 | 39 | /* need: where the original expected comes from */ 40 | /* TODO: when it's a -> b vs b, ask if whether user forgot an argument to the 41 | func */ 42 | let type_IncompatibleType err _ range => { 43 | /* the type actual and expected might be on their own line */ 44 | /* sometimes the error msg might equivalent types, e.g. "myType = string isn't 45 | compatible to bla" */ 46 | let allR = 47 | /* This regex query is brought to you by debuggex.com. Get your free 48 | real-time regex visualization today. */ 49 | {|This expression has type([\s\S]*?)but an expression was expected of type([\s\S]*?)(Type\b([\s\S]*?)|$)?((The type constructor[\s\S]*?)|$)?((The type variable[\s\S]* occurs inside ([\s\S])*)|$)|}; 50 | let extraRaw = get_match_n_maybe 3 allR err; 51 | let extra = 52 | switch extraRaw { 53 | | Some a => 54 | if (String.trim a == "") { 55 | None 56 | } else { 57 | Some (String.trim a) 58 | } 59 | | None => None 60 | }; 61 | let actualRaw = get_match_n 1 allR err; 62 | let expectedRaw = get_match_n 2 allR err; 63 | let (actual, actualEquivalentType) = 64 | switch (splitEquivalentTypes actualRaw) { 65 | | Some (a, b) => (String.trim a, Some (String.trim b)) 66 | | None => (String.trim actualRaw, None) 67 | }; 68 | let (expected, expectedEquivalentType) = 69 | switch (splitEquivalentTypes expectedRaw) { 70 | | Some (a, b) => (String.trim a, Some (String.trim b)) 71 | | None => (String.trim expectedRaw, None) 72 | }; 73 | Type_IncompatibleType { 74 | actual, 75 | expected, 76 | differingPortion: typeDiff actual expected, 77 | /* TODO: actually use this */ 78 | actualEquivalentType, 79 | expectedEquivalentType, 80 | extra 81 | } 82 | }; 83 | 84 | /* TODO: differing portion data structure a-la diff table */ 85 | let type_MismatchTypeArguments err _ _ => { 86 | let allR = {|The constructor ([\w\.]*) *expects[\s]*(\d+) *argument\(s\),\s*but is applied here to (\d+) argument\(s\)|}; 87 | let typeConstructor = get_match_n 1 allR err; 88 | let expectedCount = int_of_string @@ get_match_n 2 allR err; 89 | let actualCount = int_of_string @@ get_match_n 3 allR err; 90 | Type_MismatchTypeArguments {typeConstructor, expectedCount, actualCount} 91 | }; 92 | 93 | /* need: if it's e.g. a module function, which part is not found? Module? 94 | Function? */ 95 | let type_UnboundValue err _ _ => { 96 | let unboundValueR = {|Unbound value ([\w\.]*)|}; 97 | let unboundValue = get_match unboundValueR err; 98 | /* TODO: there might be more than one suggestion */ 99 | let suggestionR = {|Unbound value [\w\.]*[\s\S]Hint: Did you mean ([\s\S]+)\?|}; 100 | let suggestions = 101 | get_match_maybe suggestionR err |> 102 | Helpers.optionMap (Re_pcre.split rex::(Re_pcre.regexp {|, | or |})); 103 | Type_UnboundValue {unboundValue, suggestions} 104 | }; 105 | 106 | let type_SignatureMismatch err cachedContent => raise Not_found; 107 | 108 | let type_SignatureItemMissing err cachedContent => raise Not_found; 109 | 110 | let type_UnboundModule err _ _ => { 111 | let unboundModuleR = {|Unbound module ([\w\.]*)|}; 112 | let unboundModule = get_match unboundModuleR err; 113 | let suggestionR = {|Unbound module [\w\.]*[\s\S]Hint: Did you mean (\S+)\?|}; 114 | let suggestion = get_match_maybe suggestionR err; 115 | Type_UnboundModule {unboundModule, suggestion} 116 | }; 117 | 118 | /* need: if there's a hint, show which record type it is */ 119 | let type_UnboundRecordField err _ _ => { 120 | let recordFieldR = {|Unbound record field (\w+)|}; 121 | let recordField = get_match recordFieldR err; 122 | let suggestionR = {|Hint: Did you mean (\w+)\?|}; 123 | let suggestion = get_match_maybe suggestionR err; 124 | Type_UnboundRecordField {recordField, suggestion} 125 | }; 126 | 127 | let type_UnboundConstructor err cachedContent => raise Not_found; 128 | 129 | let type_UnboundTypeConstructor err _ _ => { 130 | let constructorR = {|Unbound type constructor ([\w\.]+)|}; 131 | let constructor = get_match constructorR err; 132 | let suggestionR = {|Hint: Did you mean ([\w\.]+)\?|}; 133 | let suggestion = get_match_maybe suggestionR err; 134 | Type_UnboundTypeConstructor {namespacedConstructor: constructor, suggestion} 135 | }; 136 | 137 | /* need: number of arguments actually applied to it, and what they are */ 138 | /* need: number of args the function asks, and what types they are */ 139 | let type_AppliedTooMany err _ _ => { 140 | let functionTypeR = {|This function has type([\s\S]+)It is applied to too many arguments; maybe you forgot a `;'.|}; 141 | let functionType = String.trim (get_match functionTypeR err); 142 | Type_AppliedTooMany {functionType, expectedArgCount: functionArgsCount functionType} 143 | }; 144 | 145 | let type_RecordFieldNotInExpression err cachedContent range => raise Not_found; 146 | 147 | let type_RecordFieldError err cachedContent range => raise Not_found; 148 | 149 | let type_FieldNotBelong err cachedContent range => raise Not_found; 150 | 151 | let type_NotAFunction err _ range => { 152 | let actualR = {|This expression has type([\s\S]+)This is not a function; it cannot be applied.|}; 153 | let actual = String.trim (get_match actualR err); 154 | Type_NotAFunction {actual: actual} 155 | }; 156 | 157 | /* TODO: apparently syntax error can be followed by more indications */ 158 | /* need: way, way more information, I can't even */ 159 | let file_SyntaxError err cachedContent range => { 160 | let allR = Re_pcre.regexp {|Syntax error|}; 161 | /* raise the same error than if we failed to match */ 162 | if (not (Re_pcre.pmatch rex::allR err)) { 163 | raise Not_found 164 | } else { 165 | let hintR = {|Syntax error:([\s\S]+)|}; 166 | let hint = get_match_maybe hintR err; 167 | /* assuming on the same row */ 168 | let ((startRow, startColumn), (_, endColumn)) = range; 169 | File_SyntaxError { 170 | hint: Helpers.optionMap String.trim hint, 171 | offendingString: 172 | Helpers.stringSlice first::startColumn last::endColumn (List.nth cachedContent startRow) 173 | } 174 | } 175 | }; 176 | 177 | let build_InconsistentAssumptions err cachedContent range => raise Not_found; 178 | 179 | /* need: list of legal characters */ 180 | let file_IllegalCharacter err _ _ => { 181 | let characterR = {|Illegal character \(([\s\S]+)\)|}; 182 | let character = get_match characterR err; 183 | File_IllegalCharacter {character: character} 184 | }; 185 | 186 | let parsers = [ 187 | type_MismatchTypeArguments, 188 | type_UnboundValue, 189 | type_SignatureMismatch, 190 | type_SignatureItemMissing, 191 | type_UnboundModule, 192 | type_UnboundRecordField, 193 | type_UnboundConstructor, 194 | type_UnboundTypeConstructor, 195 | type_AppliedTooMany, 196 | type_RecordFieldNotInExpression, 197 | type_RecordFieldError, 198 | type_FieldNotBelong, 199 | type_IncompatibleType, 200 | type_NotAFunction, 201 | file_SyntaxError, 202 | build_InconsistentAssumptions, 203 | file_IllegalCharacter 204 | ]; 205 | 206 | let goodFileNameR = Re_pcre.regexp {|^[a-zA-Z][a-zA-Z_\d]+\.\S+$|}; 207 | 208 | let cannotFindFileRStr = {|Cannot find file ([\s\S]+)|}; 209 | 210 | let unboundModuleRStr = {|Unbound module ([\s\S]+)|}; 211 | 212 | /* not pluggable yet (unlike `customErrorParsers` below) */ 213 | /* TODO: this doesn't work. What did I say about testing... */ 214 | let specialParserThatChecksWhetherFileEvenExists filePath errorBody => 215 | switch filePath { 216 | | "_none_" => 217 | switch errorBody { 218 | | None => None /* unrecognized? We're mainly trying to catch the case below */ 219 | | Some err => 220 | switch (get_match_maybe cannotFindFileRStr err) { 221 | | None => None /* unrecognized again? We're mainly trying to catch the case below */ 222 | | Some fileName => Some (ErrorFile (NoneFile fileName)) 223 | } 224 | } 225 | | "command line" => 226 | switch errorBody { 227 | | None => None /* unrecognized? We're mainly trying to catch the case below */ 228 | | Some err => 229 | switch (get_match_maybe unboundModuleRStr err) { 230 | | None => None /* unrecognized? We're mainly trying to catch the case below */ 231 | | Some moduleName => Some (ErrorFile (CommandLine moduleName)) 232 | } 233 | } 234 | | "(stdin)" => 235 | /* piping into `utop -stdin`. Can't really indicate better errors here as we can't read into stdin 236 | again */ 237 | switch errorBody { 238 | | None => None /* unrecognized? We're mainly trying to catch the case below */ 239 | | Some err => Some (ErrorFile (Stdin err)) 240 | } 241 | | _ => None 242 | }; 243 | 244 | let parse ::customErrorParsers ::errorBody ::cachedContent ::range => 245 | /* custom parsers go first */ 246 | try ( 247 | customErrorParsers @ parsers |> 248 | Helpers.listFindMap ( 249 | fun parse => 250 | try (Some (parse errorBody cachedContent range)) { 251 | | _ => None 252 | } 253 | ) 254 | ) { 255 | | Not_found => Error_CatchAll errorBody 256 | }; 257 | -------------------------------------------------------------------------------- /src/parseWarning.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | /* agnostic extractors, turning err string into proper data structures */ 6 | /* TODO: don't make these raise error */ 7 | let warning_UnusedVariable code err _ _ _ => raise Not_found; 8 | 9 | /* need: what the variant is. If it's e.g. a list, instead of saying "doesn't 10 | cover all the cases of the variant" we could say "doesn't cover all the possible 11 | length of the list" */ 12 | let warning_PatternNotExhaustive code err _ _ _ => { 13 | let unmatchedR = {|this pattern-matching is not exhaustive.\sHere is an example of a value that is not matched:\s([\s\S]+)|}; 14 | let unmatchedRaw = get_match unmatchedR err; 15 | let unmatched = 16 | if (unmatchedRaw.[0] == '(') { 17 | /* format was (Variant1|Variant2|Variant3). We strip the surrounding parens */ 18 | unmatchedRaw |> Helpers.stringSlice first::1 last::(String.length unmatchedRaw - 1) |> 19 | split {|\|[\s]*|} 20 | } else { 21 | [unmatchedRaw] 22 | }; 23 | Warning_PatternNotExhaustive {unmatched: unmatched} 24 | }; 25 | 26 | let warning_PatternUnused code err _ _ _ => raise Not_found; 27 | 28 | /* need: offending optional argument name from AST */ 29 | /* need: offending function name */ 30 | let warning_OptionalArgumentNotErased code err _ cachedContent range => { 31 | let ((startRow, startColumn), (endRow, endColumn)) = range; 32 | /* Hardcoding 16 for now. We might one day switch to use the variant from 33 | https://github.com/ocaml/ocaml/blob/901c67559469acc58935e1cc0ced253469a8c77a/utils/warnings.ml#L20 */ 34 | let allR = {|this optional argument cannot be erased\.|}; 35 | let fileLine = List.nth cachedContent startRow; 36 | let _ = get_match_n 0 allR err; 37 | let argumentNameRaw = 38 | Helpers.stringSlice 39 | first::startColumn 40 | last::( 41 | if (startRow == endRow) { 42 | endColumn 43 | } else { 44 | 99999 45 | } 46 | ) 47 | fileLine; 48 | let argumentNameR = {|(:?\?\s*\()?([^=]+)|}; 49 | let argumentName = get_match_n 2 argumentNameR argumentNameRaw; 50 | Warning_OptionalArgumentNotErased {argumentName: String.trim argumentName} 51 | }; 52 | 53 | /* need: what the variant is. If it's e.g. a list, instead of saying "doesn't 54 | cover all the cases of the variant" we could say "doesn't cover all the possible 55 | length of the list" */ 56 | let warning_BadFileName code err filePath _ _ => 57 | if (code == 24) { 58 | let fileName = Filename.basename filePath; 59 | let offendingChar = 60 | switch ( 61 | get_match_maybe {|^([^a-zA-Z])|} fileName, 62 | get_match_maybe {|.+?([^a-zA-Z\.])|} fileName 63 | ) { 64 | | (Some m, _) => Leading m 65 | | (None, Some m) => Contains m 66 | | _ => UnknownIllegalChar 67 | }; 68 | Warning_BadFileName offendingChar 69 | } else { 70 | raise Not_found 71 | }; 72 | 73 | /* TODO: better logic using these codes */ 74 | let parsers = [ 75 | warning_UnusedVariable, 76 | warning_PatternNotExhaustive, 77 | warning_PatternUnused, 78 | warning_OptionalArgumentNotErased, 79 | warning_BadFileName 80 | ]; 81 | 82 | let parse code warningBody filePath cachedContent range => 83 | try ( 84 | Helpers.listFindMap 85 | ( 86 | fun parse' => 87 | try (Some (parse' code warningBody filePath cachedContent range)) { 88 | | _ => None 89 | } 90 | ) 91 | parsers 92 | ) { 93 | | Not_found => Warning_CatchAll warningBody 94 | }; 95 | -------------------------------------------------------------------------------- /src/reportError.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | let listify suggestions => 6 | suggestions |> List.map (fun sug => "- `" ^ sug ^ "`") |> String.concat "\n"; 7 | 8 | let highlightPart ::color ::part str => { 9 | let indexOfPartInStr = Helpers.stringFind str part; 10 | highlight ::color first::indexOfPartInStr last::(indexOfPartInStr + String.length part) str 11 | }; 12 | 13 | let report ::refmttypePath parsedContent => { 14 | let formatOutputSyntax types => 15 | switch refmttypePath { 16 | | None => types 17 | | Some path => 18 | let types = String.concat {|\"|} types; 19 | let cmd = path ^ (sp {| "%s"|}) types; 20 | let input = Unix.open_process_in cmd; 21 | let result = ref []; 22 | try ( 23 | while true { 24 | result := [input_line input, ...!result] 25 | } 26 | ) { 27 | | End_of_file => ignore (Unix.close_process_in input) 28 | }; 29 | List.rev !result 30 | }; 31 | switch parsedContent { 32 | | Error_CatchAll error => error 33 | | Type_MismatchTypeArguments {typeConstructor, expectedCount, actualCount} => 34 | sp 35 | "This needs to be applied to %d argument%s, we found %d." 36 | expectedCount 37 | ( 38 | if (expectedCount == 1) { 39 | "" 40 | } else { 41 | "s" 42 | } 43 | ) 44 | actualCount 45 | | Type_IncompatibleType { 46 | actual, 47 | expected, 48 | differingPortion, 49 | actualEquivalentType, 50 | expectedEquivalentType, 51 | extra 52 | } => 53 | /* let (diffA, diffB) = differingPortion; */ 54 | let (actual, expected) = 55 | switch (formatOutputSyntax [actual, expected]) { 56 | | [a, b] => (a, b) 57 | | _ => (actual, expected) 58 | }; 59 | sp 60 | "The types don't match.\n%s %s\n%s %s" 61 | (red "This is:") 62 | /* (highlightPart color::red part::diffA actual) */ 63 | (highlight actual) 64 | (green "Wanted:") 65 | /* (highlightPart color::green part::diffB expected) */ 66 | (highlight color::green expected) ^ ( 67 | switch extra { 68 | | Some e => "\nExtra info: " ^ e 69 | | None => "" 70 | } 71 | ) 72 | | Type_NotAFunction {actual} => 73 | let actual = 74 | switch (formatOutputSyntax [actual]) { 75 | | [a] => a 76 | | _ => actual 77 | }; 78 | "This is " ^ 79 | actual ^ 80 | ". You seem to have called it as a function.\n" ^ "Careful with spaces, semicolons, parentheses, and whatever in-between!" 81 | | Type_AppliedTooMany {functionType, expectedArgCount} => 82 | let functionType = 83 | switch (formatOutputSyntax [functionType]) { 84 | | [a] => a 85 | | _ => functionType 86 | }; 87 | sp 88 | "This function has type %s\nIt accepts only %d arguments. You gave more. Maybe you forgot a `;` somewhere?" 89 | functionType 90 | expectedArgCount 91 | | File_SyntaxError {offendingString, hint} => 92 | ( 93 | switch hint { 94 | | Some a => "The syntax is wrong: " ^ a 95 | | None => "The syntax is wrong." 96 | } 97 | ) ^ 98 | "\n" ^ 99 | ( 100 | switch offendingString { 101 | | ";" => "Semicolon is an infix symbol used *between* expressions that return `unit` (aka \"nothing\").\n" 102 | | "else" => 103 | "Did you happen to have put a semicolon on the line before else?" ^ " Also, `then` accepts a single expression. If you've put many, wrap them in parentheses.\n" 104 | | _ => "" 105 | } 106 | ) ^ "Note: the location indicated might not be accurate." 107 | | File_IllegalCharacter {character} => 108 | sp "The character `%s` is illegal. EVERY CHARACTER THAT'S NOT AMERICAN IS ILLEGAL!" character 109 | | Type_UnboundTypeConstructor {namespacedConstructor, suggestion} => 110 | let namespacedConstructor = 111 | switch (formatOutputSyntax [namespacedConstructor]) { 112 | | [a] => a 113 | | _ => namespacedConstructor 114 | }; 115 | sp "The type constructor %s can't be found." namespacedConstructor ^ ( 116 | switch suggestion { 117 | | None => "" 118 | | Some h => sp "\nHint: did you mean `%s`?" h 119 | } 120 | ) 121 | | Type_UnboundValue {unboundValue, suggestions} => 122 | switch suggestions { 123 | | None => sp "`%s` can't be found. Could it be a typo?" unboundValue 124 | | Some [hint] => sp "`%s` can't be found. Did you mean `%s`?" unboundValue hint 125 | | Some [hint1, hint2] => 126 | sp "`%s` can't be found. Did you mean `%s` or `%s`?" unboundValue hint1 hint2 127 | | Some hints => 128 | sp "`%s` can't be found. Did you mean one of these?\n%s" unboundValue (listify hints) 129 | } 130 | | Type_UnboundRecordField {recordField, suggestion} => 131 | let recordField = 132 | switch (formatOutputSyntax [recordField]) { 133 | | [a] => a 134 | | _ => recordField 135 | }; 136 | switch suggestion { 137 | | None => sp "Field `%s` can't be found in any record type." recordField 138 | | Some hint => 139 | sp "Field `%s` can't be found in any record type. Did you mean `%s`?" recordField hint 140 | } 141 | | Type_UnboundModule {unboundModule, suggestion} => 142 | let unboundModule = 143 | switch (formatOutputSyntax [unboundModule]) { 144 | | [a] => a 145 | | _ => unboundModule 146 | }; 147 | sp "Module `%s` not found in included libraries.\n" unboundModule ^ ( 148 | switch suggestion { 149 | | Some s => sp "Hint: did you mean `%s`?" s 150 | | None => 151 | let pckName = String.lowercase unboundModule; 152 | "Hint: your build rules might be missing a link. If you're using: \n" ^ 153 | " - Oasis: make sure you have `" ^ 154 | pckName ^ 155 | "` under `BuildDepends` in your _oasis file.\n" ^ 156 | " - ocamlbuild: make sure you have `-pkgs " ^ 157 | pckName ^ 158 | "` in your build command.\n" ^ 159 | " - ocamlc | ocamlopt: make sure you have `-I +" ^ 160 | pckName ^ 161 | "` in your build command before the source files.\n" ^ 162 | " - ocamlfind: make sure you have `-package " ^ 163 | pckName ^ " -linkpkg` in your build command." 164 | } 165 | ) 166 | | _ => "huh" 167 | } 168 | }; 169 | -------------------------------------------------------------------------------- /src/reportWarning.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | let report ::refmttypePath code filePath parsedContent => 6 | switch parsedContent { 7 | | Warning_CatchAll message => message 8 | | Warning_PatternNotExhaustive {unmatched} => 9 | "this match doesn't cover all possible values of the variant.\n" ^ ( 10 | switch unmatched { 11 | | [oneVariant] => sp "The case `%s` is not matched" oneVariant 12 | | many => sp "These cases are not matched:\n%s" (mapcat "\n" (sp "- `%s`") many) 13 | } 14 | ) 15 | | Warning_OptionalArgumentNotErased {argumentName} => 16 | sp 17 | "`%s` is an optional argument at last position; calling the function by omitting %s might be confused with currying.\n" 18 | argumentName 19 | argumentName ^ "The rule: an optional argument is erased as soon as the 1st positional (i.e. neither labeled nor optional) argument defined after it is passed in." 20 | | Warning_BadFileName offendingChar => 21 | sp 22 | "file name potentially invalid. The OCaml ecosystem's build systems usually turn file names into module names by simply upper-casing the first letter. In this case, `%s` %s.\nNote: some build systems might e.g. turn kebab-case into CamelCase module, which is why this isn't a hard error." 23 | /* "%s\n\n%s 24: \"%s\" isn't a valid file name; OCaml file names are often turned into modules, which need to start with a capitalized letter." */ 24 | (Filename.basename filePath |> String.capitalize) 25 | ( 26 | switch offendingChar { 27 | | Leading ch => sp "starts with `%s`, which doesn't form a legal module name" ch 28 | | Contains ch => sp "contains `%s`, which doesn't form a legal module name" ch 29 | | UnknownIllegalChar => "isn't a legal module name" 30 | } 31 | ) 32 | | _ => "huh" 33 | }; 34 | -------------------------------------------------------------------------------- /src/terminalReporter.re: -------------------------------------------------------------------------------- 1 | open BetterErrorsTypes; 2 | 3 | open Helpers; 4 | 5 | let numberOfDigits n => { 6 | let digits = ref 1; 7 | let nn = ref n; 8 | while (!nn / 10 > 0) { 9 | nn := !nn / 10; 10 | digits := !digits + 1 11 | }; 12 | !digits 13 | }; 14 | 15 | let pad ::ch=' ' content n => String.make (n - String.length content) ch ^ content; 16 | 17 | let startingSpacesCount str => { 18 | let rec startingSpacesCount' str idx => 19 | if (idx == String.length str) { 20 | idx 21 | } else if (str.[idx] != ' ') { 22 | idx 23 | } else { 24 | startingSpacesCount' str (idx + 1) 25 | }; 26 | startingSpacesCount' str 0 27 | }; 28 | 29 | /* row and col 0-indexed; endColumn is 1 past the actual end. See 30 | Main.compilerLineColsToRange */ 31 | let _printFile 32 | highlightColor::color 33 | highlight::((startRow, startColumn), (endRow, endColumn)) 34 | content => { 35 | let displayedStartRow = max 0 (startRow - 3); 36 | /* we display no more than 3 lines after startRow. Some endRow are rly far 37 | away */ 38 | let displayedEndRow = min (List.length content - 1) (startRow + 3); 39 | let lineNumWidth = numberOfDigits (List.length content); 40 | /* sometimes the snippet of file we show is really indented. We de-indent it 41 | for nicer display by trimming out the maximum amount of leading spaces we can. */ 42 | let rowsForCountingStartingSpaces = 43 | listDrop displayedStartRow content |> listTake (displayedEndRow - displayedStartRow + 1) |> 44 | List.filter (fun row => row != ""); 45 | let minIndent = 46 | switch rowsForCountingStartingSpaces { 47 | | [] => 0 48 | | _ => 49 | let startingSpaces = List.map startingSpacesCount rowsForCountingStartingSpaces; 50 | List.fold_left 51 | ( 52 | fun acc num => 53 | if (num < acc) { 54 | num 55 | } else { 56 | acc 57 | } 58 | ) 59 | (List.hd startingSpaces) 60 | startingSpaces 61 | }; 62 | /* ellipsis vertical separator to indicate "there are white spaces before" */ 63 | let sep = 64 | if (minIndent == 0) { 65 | " │ " 66 | } else { 67 | " ┆ " 68 | }; 69 | let startColumn = startColumn - minIndent; 70 | let endColumn = endColumn - minIndent; 71 | let result = ref []; 72 | for i in displayedStartRow to displayedEndRow { 73 | let currLine = List.nth content i |> stringSlice first::minIndent; 74 | if (i >= startRow && i <= endRow) { 75 | if (startRow == endRow) { 76 | result := [ 77 | pad (string_of_int (i + 1)) lineNumWidth ^ 78 | sep ^ highlight ::color first::startColumn last::endColumn currLine, 79 | ...!result 80 | ] 81 | } else if ( 82 | i == startRow 83 | ) { 84 | result := [ 85 | pad (string_of_int (i + 1)) lineNumWidth ^ 86 | sep ^ highlight ::color first::startColumn currLine, 87 | ...!result 88 | ] 89 | } else if ( 90 | i == endRow 91 | ) { 92 | result := [ 93 | pad (string_of_int (i + 1)) lineNumWidth ^ 94 | sep ^ highlight ::color last::endColumn currLine, 95 | ...!result 96 | ] 97 | } else { 98 | result := [ 99 | pad (string_of_int (i + 1)) lineNumWidth ^ sep ^ highlight ::color currLine, 100 | ...!result 101 | ] 102 | } 103 | } else { 104 | result := [pad (string_of_int (i + 1)) lineNumWidth ^ sep ^ currLine, ...!result] 105 | } 106 | }; 107 | !result |> List.rev |> String.concat "\n" 108 | }; 109 | 110 | let printFile ::isWarning=false {cachedContent, filePath, range} => { 111 | let ((startRow, startColumn), (endRow, endColumn)) = range; 112 | let filePathDisplay = 113 | if (startRow == endRow) { 114 | cyan @@ sp "%s:%d %d-%d\n" filePath (startRow + 1) startColumn endColumn 115 | } else { 116 | cyan @@ sp "%s:%d:%d-%d:%d\n" filePath (startRow + 1) startColumn (endRow + 1) endColumn 117 | }; 118 | filePathDisplay ^ 119 | _printFile highlightColor::(if isWarning {yellow} else {red}) highlight::range cachedContent 120 | }; 121 | 122 | let prettyPrintParsedResult ::refmttypePath (result: result) => 123 | switch result { 124 | | Unparsable str => 125 | /* output the line without any decoration around. We previously had some 126 | cute little ascii red x mark to say "we couldn't parse this but there's 127 | probably an error". But it's very possible that this line's a continuation 128 | of a previous error, just that we couldn't parse it. So we try to bolt this 129 | line right after our supposedly parsed and pretty-printed error to make them 130 | look like one printed error. */ 131 | /* the effing length we'd go for better errors... someone gimme a cookie */ 132 | str 133 | | ErrorFile NonexistentFile => 134 | /* this case is never reached because we don't ever return `ErrorFile NonexistentFile` from 135 | `ParseError.specialParserThatChecksWhetherFileEvenExists` */ 136 | "" 137 | | ErrorFile (Stdin original) => sp "%s: (from stdin)\n%s" (red "Error") original 138 | | ErrorFile (CommandLine moduleName) => sp "%s: module `%s` not found." (red "Error") moduleName 139 | | ErrorFile (NoneFile filename) => 140 | /* TODO: test case for this. Forgot how to repro it */ 141 | if (Filename.check_suffix filename ".cmo") { 142 | sp 143 | "%s: Cannot find file %s. Cmo files are artifacts the compiler looks for when compiling/linking dependent files." 144 | (red "Error") 145 | (cyan filename) 146 | } else { 147 | sp "%s: Cannot find file %s." (red "Error") (cyan filename) 148 | } 149 | | ErrorContent withFileInfo => 150 | sp 151 | "%s\n\n%s: %s" 152 | (printFile withFileInfo) 153 | (red "Error") 154 | (ReportError.report ::refmttypePath withFileInfo.parsedContent) 155 | | Warning withFileInfo => 156 | sp 157 | "%s\n\n%s %d: %s" 158 | (printFile isWarning::true withFileInfo) 159 | (yellow "Warning") 160 | withFileInfo.parsedContent.code 161 | ( 162 | ReportWarning.report 163 | ::refmttypePath 164 | withFileInfo.parsedContent.code 165 | withFileInfo.filePath 166 | withFileInfo.parsedContent.warningType 167 | ) 168 | }; 169 | -------------------------------------------------------------------------------- /tests/1_bad_file_name/1_bad_file_name_1.ml: -------------------------------------------------------------------------------- 1 | let a = 5 2 | -------------------------------------------------------------------------------- /tests/1_bad_file_name/1_bad_file_name_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/1_bad_file_name/1_bad_file_name_1.ml:1 0-0 2 | 1 │ let a = 5 3 | 4 | Warning 24: file name potentially invalid. The OCaml ecosystem's build systems usually turn file names into module names by simply upper-casing the first letter. In this case, `1_bad_file_name_1.ml` starts with `1`, which doesn't form a legal module name. 5 | Note: some build systems might e.g. turn kebab-case into CamelCase module, which is why this isn't a hard error. 6 | -------------------------------------------------------------------------------- /tests/bad-file-name-2/bad-file-name-2_1.ml: -------------------------------------------------------------------------------- 1 | asd 2 | -------------------------------------------------------------------------------- /tests/bad-file-name-2/bad-file-name-2_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/bad-file-name-2/bad-file-name-2_1.ml:1 0-0 2 | 1 │ asd 3 | 4 | Warning 24: file name potentially invalid. The OCaml ecosystem's build systems usually turn file names into module names by simply upper-casing the first letter. In this case, `Bad-file-name-2_1.ml` contains `-`, which doesn't form a legal module name. 5 | Note: some build systems might e.g. turn kebab-case into CamelCase module, which is why this isn't a hard error. 6 | tests/bad-file-name-2/bad-file-name-2_1.ml:1 0-3 7 | 1 │ asd 8 | 9 | Error: `asd` can't be found. Did you mean `asr`? 10 | -------------------------------------------------------------------------------- /tests/file_IllegalCharacter/file_IllegalCharacter_1.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | \hahaha look at me 3 | roaming free 4 | this is a haiku 5 | kidding it's not 6 | -------------------------------------------------------------------------------- /tests/file_IllegalCharacter/file_IllegalCharacter_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_IllegalCharacter/file_IllegalCharacter_1.ml:2 2-3 2 | 1 │ let () = 3 | 2 │ \hahaha look at me 4 | 3 │ roaming free 5 | 4 │ this is a haiku 6 | 5 │ kidding it's not 7 | 8 | Error: The character `\\` is illegal. EVERY CHARACTER THAT'S NOT AMERICAN IS ILLEGAL! 9 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_1.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | I'm glad you're looking at this file =) 3 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_1.ml:2 11-17 2 | 1 │ let () = 3 | 2 │ I'm glad you're looking at this file =) 4 | 5 | Error: The syntax is wrong. 6 | Note: the location indicated might not be accurate. 7 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_2.ml: -------------------------------------------------------------------------------- 1 | let a = (print_char 'a) 2 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_2.ml:1 20-21 2 | 1 │ let a = (print_char 'a) 3 | 4 | Error: The syntax is wrong: operator expected. 5 | Note: the location indicated might not be accurate. 6 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_3.ml: -------------------------------------------------------------------------------- 1 | let a = (1, 2 2 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_3_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_3.ml:1 12-13 2 | 1 │ let a = (1, 2 3 | 4 | Error: The syntax is wrong: ')' expected 5 | Note: the location indicated might not be accurate. 6 | tests/file_SyntaxError/file_SyntaxError_3.ml:1 8-9 7 | 1 │ let a = (1, 2 8 | 9 | Error: This '(' might be unmatched 10 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_4.ml: -------------------------------------------------------------------------------- 1 | type file = { 2 | path: string; 3 | messages: message list; 4 | } 5 | type output = file list; 6 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_4_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_4.ml:5 23-24 2 | 2 │ path: string; 3 | 3 │ messages: message list; 4 | 4 │ } 5 | 5 │ type output = file list; 6 | 7 | Error: The syntax is wrong. 8 | Semicolon is an infix symbol used *between* expressions that return `unit` (aka "nothing"). 9 | Note: the location indicated might not be accurate. 10 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_5.ml: -------------------------------------------------------------------------------- 1 | let () = if true then 2 | print_endline "gosh"; 3 | print_endline "so much functional purity" 4 | else 5 | print_endline "that I cant even" 6 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_5_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_5.ml:4 0-4 2 | 1 │ let () = if true then 3 | 2 │ print_endline "gosh"; 4 | 3 │ print_endline "so much functional purity" 5 | 4 │ else 6 | 5 │ print_endline "that I cant even" 7 | 8 | Error: The syntax is wrong. 9 | Did you happen to have put a semicolon on the line before else? Also, `then` accepts a single expression. If you've put many, wrap them in parentheses. 10 | Note: the location indicated might not be accurate. 11 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_6.ml: -------------------------------------------------------------------------------- 1 | type fruits = 2 | | apple of string 3 | -------------------------------------------------------------------------------- /tests/file_SyntaxError/file_SyntaxError_6_expected.txt: -------------------------------------------------------------------------------- 1 | tests/file_SyntaxError/file_SyntaxError_6.ml:2 2-7 2 | 1 │ type fruits = 3 | 2 │ | apple of string 4 | 5 | Error: The syntax is wrong. 6 | Note: the location indicated might not be accurate. 7 | -------------------------------------------------------------------------------- /tests/misc/bound_many_times.ml: -------------------------------------------------------------------------------- 1 | let cake = ("cream", "ketchup") 2 | 3 | let () = 4 | match cake with 5 | | (ingredient1, ingredient1) -> print_endline "I'm good at cooking" 6 | | _ -> print_endline "I'm good at cooking" 7 | -------------------------------------------------------------------------------- /tests/misc/cannot_be_applied_with_label.ml: -------------------------------------------------------------------------------- 1 | let eat ~fruitName = print_endline "hi" 2 | 3 | let () = eat ~fruitname:"apple" 4 | -------------------------------------------------------------------------------- /tests/misc/misc_1.ml: -------------------------------------------------------------------------------- 1 | let pad ?(ch=' ') content n = 2 | (String.make (n - (String.length content)) ~ch) ^ content 3 | (* should be ch, not ~ch *) 4 | 5 | let () = print_endline @@ pad "1" 2 6 | -------------------------------------------------------------------------------- /tests/misc/misc_2.ml: -------------------------------------------------------------------------------- 1 | let dontCurry a b = print_endline "hi" 2 | 3 | let () = dontCurry 1; print_endline "bye" 4 | -------------------------------------------------------------------------------- /tests/misc/misc_3.ml: -------------------------------------------------------------------------------- 1 | type a = {b: int} 2 | 3 | type a = {b: int} 4 | -------------------------------------------------------------------------------- /tests/misc/misc_4.ml: -------------------------------------------------------------------------------- 1 | (* http://stackoverflow.com/questions/16005801/why-cant-ocaml-infer-the-following-type *) 2 | module type Foo = sig 3 | type t 4 | val do_with_t : t -> unit 5 | end 6 | 7 | let any_foo t (module F : Foo) = F.do_with_t t 8 | -------------------------------------------------------------------------------- /tests/misc/misc_5.ml: -------------------------------------------------------------------------------- 1 | type fruits = Apple | Banana 2 | 3 | let a: fruits = Orange 4 | -------------------------------------------------------------------------------- /tests/misc/misc_5_2.ml: -------------------------------------------------------------------------------- 1 | type fruits = Apple | Banana 2 | 3 | let a = match Apple with 4 | | Apple -> 1 5 | | Orange -> 2 6 | -------------------------------------------------------------------------------- /tests/misc/misc_6.ml: -------------------------------------------------------------------------------- 1 | type fruits = Apple | Banana 2 | 3 | let a = Apple 4 | 5 | match a with 6 | | Apple -> 1 7 | | Orange -> 2 8 | -------------------------------------------------------------------------------- /tests/misc/type_AppliedWithoutLabel_1.ml: -------------------------------------------------------------------------------- 1 | (* let () = print_endline "asd" "dsa" *) 2 | let asd ?a ?b = "asd" 3 | 4 | let () = print_endline (asd ()) 5 | -------------------------------------------------------------------------------- /tests/noError/noError_1.ml: -------------------------------------------------------------------------------- 1 | let thisVariableIsTotallyFine = 5 2 | -------------------------------------------------------------------------------- /tests/noError/noError_1_expected.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/reasonml-old/BetterErrors/d439b92bfe377689c38fded5d8aa2b151133f25d/tests/noError/noError_1_expected.txt -------------------------------------------------------------------------------- /tests/prettyPrint/prettyPrint_1.ml: -------------------------------------------------------------------------------- 1 | 2 | 3 | type bread = 4 | | Coconut of string 5 | let morning = Coconut 6 | 7 | 8 | 9 | 10 | (* *) 11 | -------------------------------------------------------------------------------- /tests/prettyPrint/prettyPrint_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/prettyPrint/prettyPrint_1.ml:5 38-45 2 |  2 ┆ 3 | 3 ┆ type bread = 4 | 4 ┆ | Coconut of string 5 | 5 ┆ let morning = Coconut 6 | 6 ┆ 7 | 7 ┆ 8 | 8 ┆ 9 | 10 | Error: This needs to be applied to 1 argument, we found 0. 11 | -------------------------------------------------------------------------------- /tests/prettyPrint/prettyPrint_2.ml: -------------------------------------------------------------------------------- 1 | type bread = 2 | | Coconut of string 3 | let morning = Coconut 4 | -------------------------------------------------------------------------------- /tests/prettyPrint/prettyPrint_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/prettyPrint/prettyPrint_2.ml:3 38-45 2 | 1 ┆ type bread = 3 | 2 ┆ | Coconut of string 4 | 3 ┆ let morning = Coconut 5 | 6 | Error: This needs to be applied to 1 argument, we found 0. 7 | -------------------------------------------------------------------------------- /tests/specialTests/specialTests_1_expected.txt: -------------------------------------------------------------------------------- 1 | Error: module `NonExistantModule` not found. 2 | -------------------------------------------------------------------------------- /tests/specialTests/specialTests_2_expected.txt: -------------------------------------------------------------------------------- 1 | Error: Cannot find file nonexistentFile.cmo. Cmo files are artifacts the compiler looks for when compiling/linking dependent files. 2 | -------------------------------------------------------------------------------- /tests/specialTests/specialTests_3_expected.txt: -------------------------------------------------------------------------------- 1 | File "nonexistentFile.ml", line 1: 2 | Error: I/O error: nonexistentFile.ml: No such file or directory 3 | -------------------------------------------------------------------------------- /tests/specialTests/specialTests_4_expected.txt: -------------------------------------------------------------------------------- 1 | Error: (from stdin) 2 | This expression has type int but an expression was expected of type 3 | bytes 4 | -------------------------------------------------------------------------------- /tests/test.ml: -------------------------------------------------------------------------------- 1 | (* Note: this file must be run at root directory of the project. Otherwise the 2 | Sys.command calls below happen in the wrong directory *) 3 | 4 | (* File's in ocaml for now, because our `ocaml tests/test.ml` call doesn't allow 5 | us to pass the `-pp refmt` option to parse reason code. Would be nice if `ocaml` 6 | had that like `ocamlc` *) 7 | 8 | let folders = [ 9 | (* (directory, number of tests) *) 10 | (* first one is special. See the actual tests loop below *) 11 | ("specialTests", 4); 12 | ("noError", 1); 13 | ("prettyPrint", 2); 14 | ("1_bad_file_name", 1); 15 | ("bad-file-name-2", 1); 16 | ("file_IllegalCharacter", 1); 17 | ("file_SyntaxError", 6); 18 | ("type_AppliedTooMany", 2); 19 | ("type_AppliedWithoutLabel", 1); 20 | ("type_IncompatibleType", 7); 21 | ("type_MismatchTypeArguments", 1); 22 | ("type_NotAFunction", 1); 23 | ("type_RecordFieldNotBelong", 2); 24 | ("type_RecordFieldsUndefined", 1); 25 | ("type_UnboundModule", 2); 26 | ("type_UnboundRecordField", 2); 27 | ("type_UnboundTypeConstructor", 2); 28 | ("type_UnboundValue", 4); 29 | ("warning_OptionalArgumentNotErased", 2); 30 | ("warning_PatternNotExhaustive", 2); 31 | ("warning_PatternUnused", 1); 32 | ] 33 | 34 | exception Not_equal of string 35 | 36 | let readFile filePath = 37 | let lines = ref [] in 38 | let chan = open_in filePath in 39 | try 40 | while true do 41 | lines := input_line chan :: !lines 42 | done; 43 | "this will never be reached" 44 | with End_of_file -> 45 | close_in chan; 46 | List.rev !lines |> String.concat "\n" 47 | 48 | (* these generate ocaml errors that points to nonexistant files. Handle them 49 | specially here *) 50 | let specialTestsCommands = [ 51 | "ocamlc -open NonExistantModule foo.ml"; 52 | "ocamlc nonexistentFile.cmo"; 53 | "ocamlc nonexistentFile.ml"; 54 | "echo \"let a:string = 1\" | utop -stdin" 55 | ] 56 | 57 | let () = 58 | try 59 | folders 60 | |> List.iteri (fun i (dirname, fileCount) -> for j = 1 to fileCount do 61 | let testsDirname = Filename.concat "tests" dirname in 62 | let filename = Filename.concat testsDirname (Printf.sprintf "%s_%d.ml" dirname j) in 63 | let expectedOutputName = Filename.concat testsDirname (Printf.sprintf "%s_%d_expected.txt" dirname j) in 64 | let actualOutputName = Filename.concat testsDirname (Printf.sprintf "%s_%d_actual.txt" dirname j) in 65 | (* special handling of the first item, specialTests *) 66 | let cmd = if i = 0 then List.nth specialTestsCommands (j - 1) else "ocamlc " ^ filename in 67 | (* expecting compiling errors in stderr; pipe to a file *) 68 | ignore @@ Sys.command @@ Printf.sprintf "%s 2>&1 | ./_build/src/berror.native > %s" cmd actualOutputName; 69 | (* open the produced error output *) 70 | let expected = readFile expectedOutputName in 71 | let actual = readFile actualOutputName in 72 | (* swap-comment below two lines if you want to generate new expected 73 | from the new actual *) 74 | 75 | (* ignore @@ Sys.command @@ Printf.sprintf "cp %s %s" actualOutputName expectedOutputName *) 76 | (* TODO: show the differences *) 77 | if actual <> expected then ( 78 | print_endline "Actual:"; 79 | print_endline actual; 80 | print_endline "Expected:"; 81 | print_endline expected; 82 | raise (Not_equal filename) 83 | ) 84 | done); 85 | print_endline "ALL GOOD!"; 86 | ignore @@ Sys.command "rm -rf ./tests/**/*.{cmi,cmo}"; 87 | (* trust me I'm not evil *) 88 | (* the leftover cmi and cmo files from some partially failed ocamlc above 89 | cause the next `make` build to fail out of refusal to compile with these 90 | leftover artifact, so we remove them *) 91 | with a -> 92 | ignore @@ Sys.command "rm -rf ./tests/**/*.{cmi,cmo}"; 93 | raise a 94 | -------------------------------------------------------------------------------- /tests/type_AppliedTooMany/type_AppliedTooMany_1.ml: -------------------------------------------------------------------------------- 1 | let omNomNomArgs a b = (ignore (b 1)); "hello world!" 2 | 3 | let () = print_endline (omNomNomArgs 1 (fun x -> "a") 1) 4 | -------------------------------------------------------------------------------- /tests/type_AppliedTooMany/type_AppliedTooMany_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_AppliedTooMany/type_AppliedTooMany_1.ml:3 24-36 2 | 1 │ let omNomNomArgs a b = (ignore (b 1)); "hello world!" 3 | 2 │ 4 | 3 │ let () = print_endline (omNomNomArgs 1 (fun x -> "a") 1) 5 | 6 | Error: This function has type 'a -> (int -> 'b) -> string 7 | It accepts only 2 arguments. You gave more. Maybe you forgot a `;` somewhere? 8 | -------------------------------------------------------------------------------- /tests/type_AppliedTooMany/type_AppliedTooMany_2.ml: -------------------------------------------------------------------------------- 1 | let longFunction a b c d e f g = a ^ b ^ c ^ d ^ e ^ f ^ g 2 | 3 | let evenLongerCall = longFunction "a" "a" "a" "a" "a" "a" "a" "a" 4 | -------------------------------------------------------------------------------- /tests/type_AppliedTooMany/type_AppliedTooMany_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_AppliedTooMany/type_AppliedTooMany_2.ml:3 21-33 2 | 1 │ let longFunction a b c d e f g = a ^ b ^ c ^ d ^ e ^ f ^ g 3 | 2 │ 4 | 3 │ let evenLongerCall = longFunction "a" "a" "a" "a" "a" "a" "a" "a" 5 | 6 | Error: This function has type string -> 7 | string -> string -> string -> string -> string -> string -> string 8 | It accepts only 7 arguments. You gave more. Maybe you forgot a `;` somewhere? 9 | -------------------------------------------------------------------------------- /tests/type_AppliedWithoutLabel/type_AppliedWithoutLabel_1.ml: -------------------------------------------------------------------------------- 1 | let f ~a ~b c = () 2 | 3 | let () = 4 | f 1 2 5 | -------------------------------------------------------------------------------- /tests/type_AppliedWithoutLabel/type_AppliedWithoutLabel_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_AppliedWithoutLabel/type_AppliedWithoutLabel_1.ml:4 6-7 2 | 1 │ let f ~a ~b c = () 3 | 2 │ 4 | 3 │ let () = 5 | 4 │ f 1 2 6 | 7 | Error: The function applied to this argument has type a:'a -> b:'b -> unit 8 | This argument cannot be applied without label 9 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_1.ml: -------------------------------------------------------------------------------- 1 | if 123 then "asd" else "a" 2 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_1.ml:1 3-6 2 | 1 │ if 123 then "asd" else "a" 3 | 4 | Error: The types don't match. 5 | This is: int 6 | Wanted: bool 7 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_2.ml: -------------------------------------------------------------------------------- 1 | if !true then "asd" else "a" 2 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_2.ml:1 4-8 2 | 1 │ if !true then "asd" else "a" 3 | 4 | Error: The types don't match. 5 | This is: bool 6 | Wanted: 'a ref 7 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_3.ml: -------------------------------------------------------------------------------- 1 | type asd = { 2 | bla: string list; 3 | } 4 | 5 | let takeMeAway = { 6 | bla = [|1|]; 7 | } 8 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_3_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_3.ml:6 8-13 2 | 3 │ } 3 | 4 │ 4 | 5 │ let takeMeAway = { 5 | 6 │ bla = [|1|]; 6 | 7 │ } 7 | 8 | Error: The types don't match. 9 | This is: 'a array 10 | Wanted: string list 11 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_4.ml: -------------------------------------------------------------------------------- 1 | module TopNotchModule = struct 2 | type jeSuisString = string 3 | type jeSuisStrings = jeSuisString list list 4 | type myRecord = {nihao: int} 5 | type myRecordList = myRecord 6 | type myRecordListList = myRecordList list 7 | type myRecordListListList = myRecordListList list 8 | 9 | module Nested = struct 10 | type wow = myRecordListListList list 11 | end 12 | end 13 | 14 | let asd: TopNotchModule.jeSuisStrings = ([[[{nihao = 1}]]]: TopNotchModule.Nested.wow) 15 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_4_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_4.ml:14 44-55 2 | 11 │ end 3 | 12 │ end 4 | 13 │ 5 | 14 │ let asd: TopNotchModule.jeSuisStrings = ([[[{nihao = 1}]]]: TopNotchModule.Nested.wow) 6 | 7 | Warning 40: this record of type TopNotchModule.myRecord contains fields that are 8 | not visible in the current scope: nihao. 9 | They will not be selected if the type becomes unknown. 10 | tests/type_IncompatibleType/type_IncompatibleType_4.ml:14 41-58 11 | 11 │ end 12 | 12 │ end 13 | 13 │ 14 | 14 │ let asd: TopNotchModule.jeSuisStrings = ([[[{nihao = 1}]]]: TopNotchModule.Nested.wow) 15 | 16 | Error: The types don't match. 17 | This is: TopNotchModule.Nested.wow 18 | Wanted: TopNotchModule.jeSuisStrings 19 | Extra info: Type 20 | TopNotchModule.myRecordListListList = 21 | TopNotchModule.myRecordListList list 22 | is not compatible with type TopNotchModule.jeSuisString list 23 | Type 24 | TopNotchModule.myRecordListList = TopNotchModule.myRecordList list 25 | is not compatible with type TopNotchModule.jeSuisString = string 26 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_5.ml: -------------------------------------------------------------------------------- 1 | module PettyModule = struct 2 | type youAreAString = string 3 | 4 | module Nested = struct 5 | type weAreStrings = youAreAString list 6 | end 7 | end 8 | 9 | module TopNotchModule = struct 10 | type stringListList = string list list 11 | type myRecord = {nihao: int} 12 | type myRecordList = myRecord list 13 | type myRecordListList = myRecordList list 14 | end 15 | 16 | let asd: PettyModule.Nested.weAreStrings = 17 | ([[{nihao = 1}]]: TopNotchModule.myRecordListList) 18 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_5_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_5.ml:17 5-16 2 | 14 │ end 3 | 15 │ 4 | 16 │ let asd: PettyModule.Nested.weAreStrings = 5 | 17 │ ([[{nihao = 1}]]: TopNotchModule.myRecordListList) 6 | 7 | Warning 40: this record of type TopNotchModule.myRecord contains fields that are 8 | not visible in the current scope: nihao. 9 | They will not be selected if the type becomes unknown. 10 | tests/type_IncompatibleType/type_IncompatibleType_5.ml:17 3-18 11 | 14 │ end 12 | 15 │ 13 | 16 │ let asd: PettyModule.Nested.weAreStrings = 14 | 17 │ ([[{nihao = 1}]]: TopNotchModule.myRecordListList) 15 | 16 | Error: The types don't match. 17 | This is: TopNotchModule.myRecordListList 18 | Wanted: PettyModule.Nested.weAreStrings 19 | Extra info: Type TopNotchModule.myRecordList = TopNotchModule.myRecord list 20 | is not compatible with type PettyModule.youAreAString = string 21 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_6.ml: -------------------------------------------------------------------------------- 1 | let iTakeAFunction f a = f "yes" a 2 | 3 | let () = ignore (iTakeAFunction "rebel") 4 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_6_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_6.ml:3 32-39 2 | 1 │ let iTakeAFunction f a = f "yes" a 3 | 2 │ 4 | 3 │ let () = ignore (iTakeAFunction "rebel") 5 | 6 | Error: The types don't match. 7 | This is: string 8 | Wanted: string -> 'a -> 'b 9 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_7.ml: -------------------------------------------------------------------------------- 1 | module Abc = struct 2 | type myInt = int 3 | type myString = string 4 | end 5 | 6 | module Def = struct 7 | type myFloat = float 8 | type myBool = bool 9 | end 10 | 11 | let inc (n: Abc.myInt): Def.myFloat = 1. +. float_of_int n 12 | 13 | let dec (f: Abc.myString -> Def.myBool) = 1 14 | 15 | let () = dec inc 16 | -------------------------------------------------------------------------------- /tests/type_IncompatibleType/type_IncompatibleType_7_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_IncompatibleType/type_IncompatibleType_7.ml:15 13-16 2 | 12 │ 3 | 13 │ let dec (f: Abc.myString -> Def.myBool) = 1 4 | 14 │ 5 | 15 │ let () = dec inc 6 | 7 | Error: The types don't match. 8 | This is: Abc.myInt -> Def.myFloat 9 | Wanted: Abc.myString -> Def.myBool 10 | Extra info: Type Abc.myInt = int is not compatible with type Abc.myString = string 11 | -------------------------------------------------------------------------------- /tests/type_MismatchTypeArguments/type_MismatchTypeArguments_1.ml: -------------------------------------------------------------------------------- 1 | type bread = 2 | | Coconut of string 3 | 4 | let morning = Coconut 5 | -------------------------------------------------------------------------------- /tests/type_MismatchTypeArguments/type_MismatchTypeArguments_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_MismatchTypeArguments/type_MismatchTypeArguments_1.ml:4 14-21 2 | 1 │ type bread = 3 | 2 │ | Coconut of string 4 | 3 │ 5 | 4 │ let morning = Coconut 6 | 7 | Error: This needs to be applied to 1 argument, we found 0. 8 | -------------------------------------------------------------------------------- /tests/type_NotAFunction/type_NotAFunction_1.ml: -------------------------------------------------------------------------------- 1 | let a = 2 | [[[[[[[[[[5]]]]]]]]]] () 3 | -------------------------------------------------------------------------------- /tests/type_NotAFunction/type_NotAFunction_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_NotAFunction/type_NotAFunction_1.ml:2 2-23 2 | 1 │ let a = 3 | 2 │ [[[[[[[[[[5]]]]]]]]]] () 4 | 5 | Error: This is int list list list list list list list list list list. You seem to have called it as a function. 6 | Careful with spaces, semicolons, parentheses, and whatever in-between! 7 | -------------------------------------------------------------------------------- /tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_1.ml: -------------------------------------------------------------------------------- 1 | type asd = { 2 | a: int; 3 | hello: int; 4 | } 5 | 6 | type lol = 7 | | Something of asd 8 | 9 | let bla (Something {a; b}) = 1 10 | -------------------------------------------------------------------------------- /tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_1.ml:9 23-24 2 | 6 │ type lol = 3 | 7 │ | Something of asd 4 | 8 │ 5 | 9 │ let bla (Something {a; b}) = 1 6 | 7 | Error: This record pattern is expected to have type asd 8 | The field b does not belong to type asd 9 | -------------------------------------------------------------------------------- /tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_2.ml: -------------------------------------------------------------------------------- 1 | type point = { 2 | x: int; 3 | y: int; 4 | dog: string; 5 | } 6 | 7 | let myPoint: point = { 8 | xs = 0; 9 | ys = 10; 10 | dogs = "hi"; 11 | }; 12 | -------------------------------------------------------------------------------- /tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_RecordFieldNotBelong/type_RecordFieldNotBelong_2.ml:8 2-4 2 |  5 │ } 3 | 6 │ 4 | 7 │ let myPoint: point = { 5 | 8 │ xs = 0; 6 | 9 │ ys = 10; 7 | 10 │ dogs = "hi"; 8 | 11 │ }; 9 | 10 | Error: This record expression is expected to have type point 11 | The field xs does not belong to type point 12 | -------------------------------------------------------------------------------- /tests/type_RecordFieldsUndefined/type_RecordFieldsUndefined_1.ml: -------------------------------------------------------------------------------- 1 | type asd = { 2 | a: int; 3 | b: string; 4 | } 5 | 6 | let bla = { 7 | a = 5; 8 | } 9 | -------------------------------------------------------------------------------- /tests/type_RecordFieldsUndefined/type_RecordFieldsUndefined_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_RecordFieldsUndefined/type_RecordFieldsUndefined_1.ml:6:10-8:1 2 | 3 │ b: string; 3 | 4 │ } 4 | 5 │ 5 | 6 │ let bla = { 6 | 7 │  a = 5; 7 | 8 │ } 8 | 9 | Error: Some record fields are undefined: b 10 | -------------------------------------------------------------------------------- /tests/type_UnboundModule/type_UnboundModule_1.ml: -------------------------------------------------------------------------------- 1 | open Camlp4;; 2 | -------------------------------------------------------------------------------- /tests/type_UnboundModule/type_UnboundModule_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundModule/type_UnboundModule_1.ml:1 5-11 2 | 1 │ open Camlp4;; 3 | 4 | Error: Module `Camlp4` not found in included libraries. 5 | Hint: your build rules might be missing a link. If you're using: 6 | - Oasis: make sure you have `camlp4` under `BuildDepends` in your _oasis file. 7 | - ocamlbuild: make sure you have `-pkgs camlp4` in your build command. 8 | - ocamlc | ocamlopt: make sure you have `-I +camlp4` in your build command before the source files. 9 | - ocamlfind: make sure you have `-package camlp4 -linkpkg` in your build command. 10 | -------------------------------------------------------------------------------- /tests/type_UnboundModule/type_UnboundModule_2.ml: -------------------------------------------------------------------------------- 1 | module HelloWorld = struct 2 | module ThisMorningIThink = struct 3 | module IWillEatSomeDelicious = struct 4 | module Pancake = struct 5 | end 6 | end 7 | end 8 | end 9 | 10 | open HelloWorld.ThisMorningIThink.IWillEatSomeDelicious.Pancaek 11 | -------------------------------------------------------------------------------- /tests/type_UnboundModule/type_UnboundModule_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundModule/type_UnboundModule_2.ml:10 5-63 2 |  7 │ end 3 | 8 │ end 4 | 9 │ 5 | 10 │ open HelloWorld.ThisMorningIThink.IWillEatSomeDelicious.Pancaek 6 | 7 | Error: Module `HelloWorld.ThisMorningIThink.IWillEatSomeDelicious.Pancaek` not found in included libraries. 8 | Hint: did you mean `Pancake`? 9 | -------------------------------------------------------------------------------- /tests/type_UnboundRecordField/type_UnboundRecordField_1.ml: -------------------------------------------------------------------------------- 1 | type asd = { 2 | a: int; 3 | } 4 | 5 | let bla = { 6 | a = 5; 7 | b = 6; 8 | } 9 | -------------------------------------------------------------------------------- /tests/type_UnboundRecordField/type_UnboundRecordField_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundRecordField/type_UnboundRecordField_1.ml:7 2-3 2 | 4 │ 3 | 5 │ let bla = { 4 | 6 │ a = 5; 5 | 7 │ b = 6; 6 | 8 │ } 7 | 8 | Error: Field `b` can't be found in any record type. 9 | -------------------------------------------------------------------------------- /tests/type_UnboundRecordField/type_UnboundRecordField_2.ml: -------------------------------------------------------------------------------- 1 | type asd = { 2 | a: int; 3 | hello: int; 4 | } 5 | 6 | let bla = { 7 | a = 5; 8 | helo = 6; 9 | } 10 | -------------------------------------------------------------------------------- /tests/type_UnboundRecordField/type_UnboundRecordField_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundRecordField/type_UnboundRecordField_2.ml:8 2-6 2 | 5 │ 3 | 6 │ let bla = { 4 | 7 │ a = 5; 5 | 8 │ helo = 6; 6 | 9 │ } 7 | 8 | Error: Field `helo` can't be found in any record type. Did you mean `hello`? 9 | -------------------------------------------------------------------------------- /tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_1.ml: -------------------------------------------------------------------------------- 1 | type asd = 2 | | Hello of whereAmI 3 | | Goodbye 4 | -------------------------------------------------------------------------------- /tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_1.ml:2 13-21 2 | 1 │ type asd = 3 | 2 │ | Hello of whereAmI 4 | 3 │ | Goodbye 5 | 6 | Error: The type constructor whereAmI can't be found. 7 | -------------------------------------------------------------------------------- /tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_2.ml: -------------------------------------------------------------------------------- 1 | type whereAm = { 2 | location: string 3 | } 4 | type greeting = 5 | | Hello of whereAmI 6 | | Goodbye 7 | -------------------------------------------------------------------------------- /tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundTypeConstructor/type_UnboundTypeConstructor_2.ml:5 13-21 2 | 2 │ location: string 3 | 3 │ } 4 | 4 │ type greeting = 5 | 5 │ | Hello of whereAmI 6 | 6 │ | Goodbye 7 | 8 | Error: The type constructor whereAmI can't be found. 9 | Hint: did you mean `whereAm`? 10 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_1.ml: -------------------------------------------------------------------------------- 1 | let callMe perhaps = perhap 1 2 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundValue/type_UnboundValue_1.ml:1 21-27 2 | 1 │ let callMe perhaps = perhap 1 3 | 4 | Error: `perhap` can't be found. Did you mean `perhaps`? 5 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_2.ml: -------------------------------------------------------------------------------- 1 | let callMe perhaps = nvm 1 2 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundValue/type_UnboundValue_2.ml:1 21-24 2 | 1 │ let callMe perhaps = nvm 1 3 | 4 | Error: `nvm` can't be found. Could it be a typo? 5 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_3.ml: -------------------------------------------------------------------------------- 1 | let f ~a b = 5 + a 2 | 3 | let eleven = f ~a 6 4 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_3_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundValue/type_UnboundValue_3.ml:3 16-17 2 | 1 │ let f ~a b = 5 + a 3 | 2 │ 4 | 3 │ let eleven = f ~a 6 5 | 6 | Error: `a` can't be found. Could it be a typo? 7 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_4.ml: -------------------------------------------------------------------------------- 1 | let poshanassy = 1 2 | let poshanessy = 2 3 | let poshanissy = 3 4 | let poshanyssy = 4 5 | 6 | let () = print_int poshanossy 7 | -------------------------------------------------------------------------------- /tests/type_UnboundValue/type_UnboundValue_4_expected.txt: -------------------------------------------------------------------------------- 1 | tests/type_UnboundValue/type_UnboundValue_4.ml:6 19-29 2 | 3 │ let poshanissy = 3 3 | 4 │ let poshanyssy = 4 4 | 5 │ 5 | 6 │ let () = print_int poshanossy 6 | 7 | Error: `poshanossy` can't be found. Did you mean one of these? 8 | - `poshanessy` 9 | - `poshanyssy` 10 | - `poshanissy` 11 | - `poshanassy` 12 | -------------------------------------------------------------------------------- /tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_1.ml: -------------------------------------------------------------------------------- 1 | (* the spacing matters here to test the regex that extracts bcD' *) 2 | let asd a ?bcD'= "asd" 3 | 4 | let () = print_endline (asd 1 ~bcD':1) 5 | -------------------------------------------------------------------------------- /tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_1.ml:2 11-15 2 | 1 │ (* the spacing matters here to test the regex that extracts bcD' *) 3 | 2 │ let asd a ?bcD'= "asd" 4 | 3 │ 5 | 4 │ let () = print_endline (asd 1 ~bcD':1) 6 | 7 | Warning 16: `bcD'` is an optional argument at last position; calling the function by omitting bcD' might be confused with currying. 8 | The rule: an optional argument is erased as soon as the 1st positional (i.e. neither labeled nor optional) argument defined after it is passed in. 9 | -------------------------------------------------------------------------------- /tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_2.ml: -------------------------------------------------------------------------------- 1 | let eat aNumber ?(withFork=true) = 2 | "Hello, world!" 3 | 4 | let () = print_endline (eat 1 ~withFork:false) 5 | -------------------------------------------------------------------------------- /tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/warning_OptionalArgumentNotErased/warning_OptionalArgumentNotErased_2.ml:1:16-2:17 2 | 1 │ let eat aNumber ?(withFork=true) = 3 | 2 │  "Hello, world!" 4 | 3 │ 5 | 4 │ let () = print_endline (eat 1 ~withFork:false) 6 | 7 | Warning 16: `withFork` is an optional argument at last position; calling the function by omitting withFork might be confused with currying. 8 | The rule: an optional argument is erased as soon as the 1st positional (i.e. neither labeled nor optional) argument defined after it is passed in. 9 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_1.ml: -------------------------------------------------------------------------------- 1 | type greetings = 2 | | Hello 3 | | Goodbye 4 | 5 | let say a = match a with 6 | | Hello -> () 7 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_1.ml:5:12-6:13 2 | 2 │ | Hello 3 | 3 │ | Goodbye 4 | 4 │ 5 | 5 │ let say a = match a with 6 | 6 │ | Hello -> () 7 | 8 | Warning 8: this pattern-matching is not exhaustive. 9 | Here is an example of a value that is not matched: 10 | Goodbye 11 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_1_expected_bk.txt: -------------------------------------------------------------------------------- 1 | tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_1.ml:5:12-6:13 2 | 2 | | Hello 3 | 3 | | Goodbye 4 | 4 | 5 | 5 | let say a = match a with 6 | 6 | | Hello -> () 7 | 8 | Warning 8: this match doesn't cover all possible values of the variant. 9 | The case `Goodbye` is not matched 10 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_2.ml: -------------------------------------------------------------------------------- 1 | type greetings = 2 | | Hello 3 | | Goodbye 4 | | Hola of string 5 | | Nihao of int 6 | | LongAssGreetingInSomeSuperObscureLanguageIWannaHaveALineBreakHere 7 | 8 | let say a = match a with 9 | | Hello -> () 10 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_2_expected.txt: -------------------------------------------------------------------------------- 1 | tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_2.ml:8:12-9:13 2 | 5 │ | Nihao of int 3 | 6 │ | LongAssGreetingInSomeSuperObscureLanguageIWannaHaveALineBreakHere 4 | 7 │ 5 | 8 │ let say a = match a with 6 | 9 │ | Hello -> () 7 | 8 | Warning 8: this pattern-matching is not exhaustive. 9 | Here is an example of a value that is not matched: 10 | (Goodbye|Hola _|Nihao _| 11 | LongAssGreetingInSomeSuperObscureLanguageIWannaHaveALineBreakHere) 12 | -------------------------------------------------------------------------------- /tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_2_expected_bk.txt: -------------------------------------------------------------------------------- 1 | tests/warning_PatternNotExhaustive/warning_PatternNotExhaustive_2.ml:8:12-9:13 2 | 5 | | Nihao of int 3 | 6 | | LongAssGreetingInSomeSuperObscureLanguageIWannaHaveALineBreakHere 4 | 7 | 5 | 8 | let say a = match a with 6 | 9 | | Hello -> () 7 | 8 | Warning 8: this match doesn't cover all possible values of the variant. 9 | These cases are not matched: 10 | - `Goodbye` 11 | - `Hola _` 12 | - `Nihao _` 13 | - `LongAssGreetingInSomeSuperObscureLanguageIWannaHaveALineBreakHere` 14 | -------------------------------------------------------------------------------- /tests/warning_PatternUnused/warning_PatternUnused_1.ml: -------------------------------------------------------------------------------- 1 | type greetings = 2 | | Hello 3 | | Goodbye 4 | 5 | let say a = match a with 6 | | Hello -> () 7 | | Goodbye -> () 8 | | _ -> () 9 | -------------------------------------------------------------------------------- /tests/warning_PatternUnused/warning_PatternUnused_1_expected.txt: -------------------------------------------------------------------------------- 1 | tests/warning_PatternUnused/warning_PatternUnused_1.ml:8 2-3 2 | 5 │ let say a = match a with 3 | 6 │ | Hello -> () 4 | 7 │ | Goodbye -> () 5 | 8 │ | _ -> () 6 | 7 | Warning 11: this match case is unused. 8 | --------------------------------------------------------------------------------