diff --git a/analysis/.depend b/analysis/.depend index 987f9061f..4e520f3d4 100644 --- a/analysis/.depend +++ b/analysis/.depend @@ -30,8 +30,7 @@ src/Protocol.cmx : src/vendor/Json.cmx src/References.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \ src/ProcessCmt.cmx src/Log.cmx src/Infix.cmx src/Shared.cmx : src/PrintType.cmx src/Log.cmx src/Files.cmx -src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx \ - src/Infix.cmx +src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx src/Uri2.cmx : src/Utils.cmx : src/Protocol.cmx src/vendor/Json.cmx : diff --git a/analysis/examples/example-project/.gitignore b/analysis/examples/example-project/.gitignore new file mode 100644 index 000000000..4ae6e66ef --- /dev/null +++ b/analysis/examples/example-project/.gitignore @@ -0,0 +1,2 @@ +lib +.merlin \ No newline at end of file diff --git a/analysis/examples/example-project/bsconfig.json b/analysis/examples/example-project/bsconfig.json index 8cbede0a1..49c4f6559 100644 --- a/analysis/examples/example-project/bsconfig.json +++ b/analysis/examples/example-project/bsconfig.json @@ -7,6 +7,6 @@ }, "bs-dependencies": ["reason-react"], "reason": { "react-jsx": 3 }, - "namespace": "try-it", + "namespace": "my-namespace", "refmt": 3 } \ No newline at end of file diff --git a/analysis/examples/example-project/package-lock.json b/analysis/examples/example-project/package-lock.json index 39f9ced65..61650f529 100644 --- a/analysis/examples/example-project/package-lock.json +++ b/analysis/examples/example-project/package-lock.json @@ -1,42 +1,16 @@ { - "name": "example-project", - "lockfileVersion": 2, "requires": true, - "packages": { - "": { - "dependencies": { - "bs-platform": "9.0.2", - "reason-react": "^0.9.1" - } - }, - "node_modules/bs-platform": { - "version": "9.0.2", - "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-9.0.2.tgz", - "integrity": "sha512-Ye9JqJ4Oa7mcjjoOVRYI8Uc2Cf8N7jQLWDcdUplY7996d/YErSR7WitmV7XnSwr4EvdrbwjEsg1NxNjUQv3ChA==", - "hasInstallScript": true, - "bin": { - "bsb": "bsb", - "bsc": "bsc", - "bsrefmt": "bsrefmt", - "bstracing": "lib/bstracing" - } - }, - "node_modules/reason-react": { - "version": "0.9.1", - "resolved": "https://registry.npmjs.org/reason-react/-/reason-react-0.9.1.tgz", - "integrity": "sha512-nlH0O2TDy9KzOLOW+vlEQk4ExHOeciyzFdoLcsmmiit6hx6H5+CVDrwJ+8aiaLT/kqK5xFOjy4PS7PftWz4plA==" - } - }, + "lockfileVersion": 1, "dependencies": { - "bs-platform": { - "version": "9.0.2", - "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-9.0.2.tgz", - "integrity": "sha512-Ye9JqJ4Oa7mcjjoOVRYI8Uc2Cf8N7jQLWDcdUplY7996d/YErSR7WitmV7XnSwr4EvdrbwjEsg1NxNjUQv3ChA==" - }, "reason-react": { "version": "0.9.1", "resolved": "https://registry.npmjs.org/reason-react/-/reason-react-0.9.1.tgz", "integrity": "sha512-nlH0O2TDy9KzOLOW+vlEQk4ExHOeciyzFdoLcsmmiit6hx6H5+CVDrwJ+8aiaLT/kqK5xFOjy4PS7PftWz4plA==" + }, + "rescript": { + "version": "9.1.2", + "resolved": "https://registry.npmjs.org/rescript/-/rescript-9.1.2.tgz", + "integrity": "sha512-4wHvTDv3nyYnAPJHcg1RGG8z7u3HDiBf6RN3P/dITDv859Qo35aKOzJWQtfBzbAs0EKNafLqei3TnUqiAv6BwQ==" } } } diff --git a/analysis/examples/example-project/package.json b/analysis/examples/example-project/package.json index 818017cfe..b948ffc3a 100644 --- a/analysis/examples/example-project/package.json +++ b/analysis/examples/example-project/package.json @@ -1,11 +1,11 @@ { "dependencies": { - "bs-platform": "9.0.2", - "reason-react": "^0.9.1" + "reason-react": "^0.9.1", + "rescript": "^9.1.2" }, "scripts": { - "build": "bsb -make-world", - "start": "bsb -make-world -w", - "clean": "bsb -clean" + "build": "rescript", + "start": "rescript build -w", + "clean": "rescript clean -with-deps" } } diff --git a/analysis/examples/example-project/src/Hello.re b/analysis/examples/example-project/src/Hello.re deleted file mode 100644 index 04e8a6f3f..000000000 --- a/analysis/examples/example-project/src/Hello.re +++ /dev/null @@ -1,188 +0,0 @@ -let someLongName = 10; - -let otherLongName = "string"; - -let x = [%bs.obj {a: 3}]; - -let r = Other.something; - -let l = More.inner + More.n + Other.inner; - -let n = More.n; - -let _ = More.party; -let _ = string_of_bool; - -/* let m = {More.a: 2, b: 32.}; */ - -module Something = { - open Other; - - let m = {name: "Me", age: 0}; - let animal = Things(10); - let other = Things(2); - let me: animals = People("Hie"); - let x = something + 10; - let r = m.name; - - let awesome = 20; - if (true) { - () - } -}; - -open! Something; - -let y = x + 10; - -switch me { -| Things(n) => () -| _ => () -}; - - -let z = x * x; - -let aThing = 10 + Other.something; - -/** Some docs about this **awesome** thing. */ -let awesome = 100 + m.age; - -let thing = "thing"; - -let transform = (x, y) => x ++ Js.Float.toString(y); - -let z = transform("hello ", 5.); - -let zzz = 1; - -let more = 20; - -/** Something here */ -let added = 10 + awesome; - -open Other; - -open Hashtbl; - -/** Some more documentation about this */ -let awesome = x => x + 2; - -let a = [ - "hello", - "my fine" ++ "folks", - "in boonville" -]; - -let div = (~x, ~y, ~children, ()) => 10; - -let m =
; - - let something = animal => switch animal { - | blank => () - }; - - something(animal); - -let someFunction = (memorableName, {contents}) => { - let innerMemorable = 20; - memorableName + innerMemorable; -}; - -/* let awesome = 10000; */ - -/* let awesome = 111; */ - -let z = 10; - -let z = find; - -let z = later; - -let m = Other.later; - -for (_index in 0 to 10) { - print_endline("hellO"); -}; - -module OneOneOneOne = { - module TwoTwoTwoTwo = { - let xxxxxxxxxx = 10; - }; -}; -let r = OneOneOneOne.TwoTwoTwoTwo.xxxxxxxxxx; - -type awesome = { - one: string, - two: float, -}; - -open OneOneOneOne.TwoTwoTwoTwo; - -include OneOneOneOne.TwoTwoTwoTwo; - -include More; - -let _ = Other.oo.person.name; - -type lots = -| Parties -| Plutocrats(int, float) -| Possums -| Oppossums; - -let y = Some(10 + awesome(3)); - -let z = {contents: 30}; -let party = {one: "one", two: 2.}; - -let {one, two} = party; - -let thing = () => { - 34 + 43; -}; - -type more = awesome; - -let {contents} = z; - -switch (y) { -| Some(u) => () -| None => () -}; - -/* let x = [%raw " hello"]; */ - -let awesome = "hello"; - - -type shortReference = (string, list(string), string); - -type reference = { - uri: string, - moduleName: string, - modulePath: list(string), - name: string, -}; - -type typeSource = - | Builtin(string) - | Public(reference) - | NotFound; - -type lockfile = { - version: int, - pastVersions: Belt.HashMap.Int.t( - list(( - shortReference, - int - )) - ), - current: list(( - shortReference, - int - )) -}; \ No newline at end of file diff --git a/analysis/examples/example-project/src/Hello.res b/analysis/examples/example-project/src/Hello.res new file mode 100644 index 000000000..db525a7e7 --- /dev/null +++ b/analysis/examples/example-project/src/Hello.res @@ -0,0 +1,173 @@ +let someLongName = 10 + +let otherLongName = "string" + +let x = {"a": 3} + +let r = Other.something + +let l = More.inner + More.n + Other.inner + +let n = More.n + +let _ = More.party +let _ = string_of_bool + +/* let m = {More.a: 2, b: 32.}; */ + +module Something = { + open Other + + let m = {name: "Me", age: 0} + let animal = Things(10) + let other = Things(2) + let me: animals = People("Hie") + let x = something + 10 + let r = m.name + + let awesome = 20 + if true { + () + } +} + +open! Something + +let y = x + 10 + +switch me { +| Things(n) => () +| _ => () +} + +let z = x * x + +let aThing = 10 + Other.something + +@ocaml.doc(" Some docs about this **awesome** thing. ") +let awesome = + 100 + m.age + +let thing = "thing" + +let transform = (x, y) => x ++ Js.Float.toString(y) + +let z = transform("hello ", 5.) + +let zzz = 1 + +let more = 20 + +@ocaml.doc(" Something here ") +let added = + 10 + awesome + +open Other + +open Hashtbl + +@ocaml.doc(" Some more documentation about this ") +let awesome = x => x + 2 + +let a = list{"hello", "my fine" ++ "folks", "in boonville"} + +let div = (~x, ~y, ~children, ()) => 10 + +let m =
+ +let something = animal => + switch animal { + | blank => () + } + +something(animal) + +let someFunction = (memorableName, {contents}) => { + let innerMemorable = 20 + memorableName + innerMemorable +} + +/* let awesome = 10000; */ + +/* let awesome = 111; */ + +let z = 10 + +let z = find + +let z = later + +let m = Other.later + +for _index in 0 to 10 { + print_endline("hellO") +} + +module OneOneOneOne = { + module TwoTwoTwoTwo = { + let xxxxxxxxxx = 10 + } +} +let r = OneOneOneOne.TwoTwoTwoTwo.xxxxxxxxxx + +type awesome = { + one: string, + two: float, +} + +open OneOneOneOne.TwoTwoTwoTwo + +include OneOneOneOne.TwoTwoTwoTwo + +include More + +let _ = Other.oo.person.name + +type lots = + | Parties + | Plutocrats(int, float) + | Possums + | Oppossums + +let y = Some(10 + awesome(3)) + +let z = {contents: 30} +let party = {one: "one", two: 2.} + +let {one, two} = party + +let thing = () => 34 + 43 + +type more = awesome + +let {contents} = z + +switch y { +| Some(u) => () +| None => () +} + +/* let x = [%raw " hello"]; */ + +let awesome = "hello" + +type shortReference = (string, list, string) + +type reference = { + uri: string, + moduleName: string, + modulePath: list, + name: string, +} + +type typeSource = + | Builtin(string) + | Public(reference) + | NotFound + +type lockfile = { + version: int, + pastVersions: Belt.HashMap.Int.t>, + current: list<(shortReference, int)>, +} + diff --git a/analysis/examples/example-project/src/Json.re b/analysis/examples/example-project/src/Json.re deleted file mode 100644 index 514597428..000000000 --- a/analysis/examples/example-project/src/Json.re +++ /dev/null @@ -1,599 +0,0 @@ -/** # Json parser - * - * Works with bucklescript and bsb-native - * - * ## Basics - * - * ``` - * open Json.Infix; /* for the nice infix operators */ - * let raw = {|{"hello": "folks"}|}; - * let who = Json.parse(raw) |> Json.get("hello") |?> Json.string; - * Js.log(who); - * ``` - * - * ## Parse & stringify - * - * @doc parse, stringify - * - * ## Accessing descendents - * - * @doc get, nth, getPath - * - * ## Coercing to types - * - * @doc string, number, array, obj, bool, null - * - * ## The JSON type - * - * @doc t - * - * ## Infix operators for easier working - * - * @doc Infix - */; - -type t = - | String(string) - | Number(float) - | Array(list(t)) - | Object(list((string, t))) - | True - | False - | Null; - -let string_of_number = (f) => { - let s = Js.Float.toString(f); - if (s.[String.length(s) - 1] == '.') { - String.sub(s, 0, String.length(s) - 1) - } else { - s - } -}; - -/** - * This module is provided for easier working with optional values. - */ -module Infix = { - /** The "force unwrap" operator - * - * If you're sure there's a value, you can force it. - * ``` - * open Json.Infix; - * let x: int = Some(10) |! "Expected this to be present"; - * Js.log(x); - * ``` - * - * But you gotta be sure, otherwise it will throw. - * ```reason;raises - * open Json.Infix; - * let x: int = None |! "This will throw"; - * ``` - */ - let (|!) = (o, d) => - switch o { - | None => failwith(d) - | Some(v) => v - }; - /** The "upwrap with default" operator - * ``` - * open Json.Infix; - * let x: int = Some(10) |? 4; - * let y: int = None |? 5; - * Js.log2(x, y); - * ``` - */ - let (|?) = (o, d) => - switch o { - | None => d - | Some(v) => v - }; - /** The "transform contents into new optional" operator - * ``` - * open Json.Infix; - * let maybeInc = x => x > 5 ? Some(x + 1) : None; - * let x: option(int) = Some(14) |?> maybeInc; - * let y: option(int) = None |?> maybeInc; - * ``` - */ - let (|?>) = (o, fn) => - switch o { - | None => None - | Some(v) => fn(v) - }; - /** The "transform contents into new value & then re-wrap" operator - * ``` - * open Json.Infix; - * let inc = x => x + 1; - * let x: option(int) = Some(7) |?>> inc; - * let y: option(int) = None |?>> inc; - * Js.log2(x, y); - * ``` - */ - let (|?>>) = (o, fn) => - switch o { - | None => None - | Some(v) => Some(fn(v)) - }; - /** "handle the value if present, otherwise here's the default" - * - * It's called fold because that's what people call it :?. It's the same as "transform contents to new value" + "unwrap with default". - * - * ``` - * open Json.Infix; - * let inc = x => x + 1; - * let x: int = fold(Some(4), 10, inc); - * let y: int = fold(None, 2, inc); - * Js.log2(x, y); - * ``` - */ - let fold = (o, d, f) => - switch o { - | None => d - | Some(v) => f(v) - }; -}; - -let escape = (text) => { - let ln = String.length(text); - let buf = Buffer.create(ln); - let rec loop = (i) => - if (i < ln) { - switch text.[i] { - | '\012' => Buffer.add_string(buf, "\\f") - | '\\' => Buffer.add_string(buf, "\\\\") - | '"' => Buffer.add_string(buf, "\\\"") - | '\n' => Buffer.add_string(buf, "\\n") - | '\b' => Buffer.add_string(buf, "\\b") - | '\r' => Buffer.add_string(buf, "\\r") - | '\t' => Buffer.add_string(buf, "\\t") - | c => Buffer.add_char(buf, c) - }; - loop(i + 1) - }; - loop(0); - Buffer.contents(buf) -}; - -/** ``` - * let text = {|{"hello": "folks", "aa": [2, 3, "four"]}|}; - * let result = Json.stringify(Json.parse(text)); - * Js.log(result); - * assert(text == result); - * ``` - */ -let rec stringify = (t) => - switch t { - | String(value) => "\"" ++ escape(value) ++ "\"" - | Number(num) => string_of_number(num) - | Array(items) => "[" ++ String.concat(", ", List.map(items, stringify)) ++ "]" - | Object(items) => - "{" - ++ String.concat( - ", ", - List.map(items, ((k, v)) => "\"" ++ String.escaped(k) ++ "\": " ++ stringify(v)) - ) - ++ "}" - | True => "true" - | False => "false" - | Null => "null" - }; - -let white = n => { - let buffer = Buffer.create(n); - for (_ in 0 to n - 1) { - Buffer.add_char(buffer, ' ') - }; - Buffer.contents(buffer) -}; - -let rec stringifyPretty = (~indent=0, t) => - switch t { - | String(value) => "\"" ++ escape(value) ++ "\"" - | Number(num) => string_of_number(num) - | Array([]) => "[]" - | Array(items) => "[\n" ++ white(indent) ++ String.concat(",\n" ++ white(indent), List.map(items, stringifyPretty(~indent=indent + 2))) ++ "\n" ++ white(indent) ++ "]" - | Object([]) => "{}" - | Object(items) => - "{\n" ++ white(indent) - ++ String.concat( - ",\n" ++ white(indent), - List.map(items, ((k, v)) => "\"" ++ String.escaped(k) ++ "\": " ++ stringifyPretty(~indent=indent + 2, v)) - ) - ++ "\n" ++ white(indent) ++ "}" - | True => "true" - | False => "false" - | Null => "null" - }; - - -let unwrap = (message, t) => - switch t { - | Some(v) => v - | None => failwith(message) - }; - -[@nodoc] -module Parser = { - let split_by = (~keep_empty=false, is_delim, str) => { - let len = String.length(str); - let rec loop = (acc, last_pos, pos) => - if (pos == (-1)) { - if (last_pos == 0 && ! keep_empty) { - acc - } else { - [String.sub(str, 0, last_pos), ...acc] - } - } else if (is_delim(str.[pos])) { - let new_len = last_pos - pos - 1; - if (new_len != 0 || keep_empty) { - let v = String.sub(str, pos + 1, new_len); - loop([v, ...acc], pos, pos - 1) - } else { - loop(acc, pos, pos - 1) - } - } else { - loop(acc, last_pos, pos - 1) - }; - loop([], len, len - 1) - }; - let fail = (text, pos, message) => { - let pre = String.sub(text, 0, pos); - let lines = split_by((c) => c == '\n', pre); - let count = List.length(lines); - let last = count > 0 ? List.getExn(lines, count - 1) : ""; - let col = String.length(last) + 1; - let line = List.length(lines); - let string = Printf.sprintf("Error \"%s\" at %d:%d -> %s\n", message, line, col, last); - failwith(string) - }; - let rec skipToNewline = (text, pos) => - if (pos >= String.length(text)) { - pos - } else if (text.[pos] == '\n') { - pos + 1 - } else { - skipToNewline(text, pos + 1) - }; - let stringTail = (text) => { - let len = String.length(text); - if (len > 1) { - String.sub(text, 1, len - 1) - } else { - "" - } - }; - let rec skipToCloseMultilineComment = (text, pos) => - if (pos + 1 >= String.length(text)) { - failwith("Unterminated comment") - } else if (text.[pos] == '*' && text.[pos + 1] == '/') { - pos + 2 - } else { - skipToCloseMultilineComment(text, pos + 1) - }; - let rec skipWhite = (text, pos) => - if (pos < String.length(text) - && (text.[pos] == ' ' || text.[pos] == '\t' || text.[pos] == '\n' || text.[pos] == '\r')) { - skipWhite(text, pos + 1) - } else { - pos - }; - let parseString = (text, pos) => { - /* let i = ref(pos); */ - let buffer = Buffer.create(String.length(text)); - let ln = String.length(text); - let rec loop = (i) => - i >= ln ? - fail(text, i, "Unterminated string") : - ( - switch text.[i] { - | '"' => i + 1 - | '\\' => - i + 1 >= ln ? - fail(text, i, "Unterminated string") : - ( - switch text.[i + 1] { - | '/' => - Buffer.add_char(buffer, '/'); - loop(i + 2) - | 'f' => - Buffer.add_char(buffer, '\012'); - loop(i + 2) - | _ => - Buffer.add_string(buffer, Scanf.unescaped(String.sub(text, i, 2))); - loop(i + 2) - } - ) - | c => - Buffer.add_char(buffer, c); - loop(i + 1) - } - ); - let final = loop(pos); - (Buffer.contents(buffer), final) - }; - let parseDigits = (text, pos) => { - let len = String.length(text); - let rec loop = (i) => - if (i >= len) { - i - } else { - switch text.[i] { - | '0'..'9' => loop(i + 1) - | _ => i - } - }; - loop(pos + 1) - }; - let parseWithDecimal = (text, pos) => { - let pos = parseDigits(text, pos); - if (pos < String.length(text) && text.[pos] == '.') { - let pos = parseDigits(text, pos + 1); - pos - } else { - pos - } - }; - let parseNumber = (text, pos) => { - let pos = parseWithDecimal(text, pos); - let ln = String.length(text); - if (pos < ln - 1 && (text.[pos] == 'E' || text.[pos] == 'e')) { - let pos = - switch text.[pos + 1] { - | '-' - | '+' => pos + 2 - | _ => pos + 1 - }; - parseDigits(text, pos) - } else { - pos - } - }; - let parseNegativeNumber = (text, pos) => { - let final = - if (text.[pos] == '-') { - parseNumber(text, pos + 1) - } else { - parseNumber(text, pos) - }; - (Number(float_of_string(String.sub(text, pos, final - pos))), final) - }; - let expect = (char, text, pos, message) => - if (text.[pos] != char) { - fail(text, pos, "Expected: " ++ message) - } else { - pos + 1 - }; - let parseComment: 'a .(string, int, (string, int) => 'a) => 'a = - (text, pos, next) => - if (text.[pos] != '/') { - if (text.[pos] == '*') { - next(text, skipToCloseMultilineComment(text, pos + 1)) - } else { - failwith("Invalid syntax") - } - } else { - next(text, skipToNewline(text, pos + 1)) - }; - let maybeSkipComment = (text, pos) => - if (pos < String.length(text) && text.[pos] == '/') { - if (pos + 1 < String.length(text) && text.[pos + 1] == '/') { - skipToNewline(text, pos + 1) - } else if (pos + 1 < String.length(text) && text.[pos + 1] == '*') { - skipToCloseMultilineComment(text, pos + 1) - } else { - fail(text, pos, "Invalid synatx") - } - } else { - pos - }; - let rec skip = (text, pos) => - if (pos == String.length(text)) { - pos - } else { - let n = skipWhite(text, pos) |> maybeSkipComment(text); - if (n > pos) { - skip(text, n) - } else { - n - } - }; - let rec parse = (text, pos) => - if (pos >= String.length(text)) { - fail(text, pos, "Reached end of file without being done parsing") - } else { - switch text.[pos] { - | '/' => parseComment(text, pos + 1, parse) - | '[' => parseArray(text, pos + 1) - | '{' => parseObject(text, pos + 1) - | 'n' => - if (String.sub(text, pos, 4) == "null") { - (Null, pos + 4) - } else { - fail(text, pos, "unexpected character") - } - | 't' => - if (String.sub(text, pos, 4) == "true") { - (True, pos + 4) - } else { - fail(text, pos, "unexpected character") - } - | 'f' => - if (String.sub(text, pos, 5) == "false") { - (False, pos + 5) - } else { - fail(text, pos, "unexpected character") - } - | '\n' - | '\t' - | ' ' - | '\r' => parse(text, skipWhite(text, pos)) - | '"' => - let (s, pos) = parseString(text, pos + 1); - (String(s), pos) - | '-' - | '0'..'9' => parseNegativeNumber(text, pos) - | _ => fail(text, pos, "unexpected character") - } - } - and parseArrayValue = (text, pos) => { - let pos = skip(text, pos); - let (value, pos) = parse(text, pos); - let pos = skip(text, pos); - switch text.[pos] { - | ',' => - let pos = skip(text, pos + 1); - if (text.[pos] == ']') { - ([value], pos + 1) - } else { - let (rest, pos) = parseArrayValue(text, pos); - ([value, ...rest], pos) - } - | ']' => ([value], pos + 1) - | _ => fail(text, pos, "unexpected character") - } - } - and parseArray = (text, pos) => { - let pos = skip(text, pos); - switch text.[pos] { - | ']' => (Array([]), pos + 1) - | _ => - let (items, pos) = parseArrayValue(text, pos); - (Array(items), pos) - } - } - and parseObjectValue = (text, pos) => { - let pos = skip(text, pos); - if (text.[pos] != '"') { - fail(text, pos, "Expected string") - } else { - let (key, pos) = parseString(text, pos + 1); - let pos = skip(text, pos); - let pos = expect(':', text, pos, "Colon"); - let (value, pos) = parse(text, pos); - let pos = skip(text, pos); - switch text.[pos] { - | ',' => - let pos = skip(text, pos + 1); - if (text.[pos] == '}') { - ([(key, value)], pos + 1) - } else { - let (rest, pos) = parseObjectValue(text, pos); - ([(key, value), ...rest], pos) - } - | '}' => ([(key, value)], pos + 1) - | _ => - let (rest, pos) = parseObjectValue(text, pos); - ([(key, value), ...rest], pos) - } - } - } - and parseObject = (text, pos) => { - let pos = skip(text, pos); - if (text.[pos] == '}') { - (Object([]), pos + 1) - } else { - let (pairs, pos) = parseObjectValue(text, pos); - (Object(pairs), pos) - } - }; -}; - -/** Turns some text into a json object. throws on failure */ -let parse = (text) => { - let (item, pos) = Parser.parse(text, 0); - let pos = Parser.skip(text, pos); - if (pos < String.length(text)) { - failwith( - "Extra data after parse finished: " ++ String.sub(text, pos, String.length(text) - pos) - ) - } else { - item - } -}; - -/* Accessor helpers */ -let bind = (v, fn) => - switch v { - | None => None - | Some(v) => fn(v) - }; - -/** If `t` is an object, get the value associated with the given string key */ -let get = (key, t) => - switch t { - | Object(items) => - List.getAssoc(items, key, (==)) - | _ => None - }; - -/** If `t` is an array, get the value associated with the given index */ -let nth = (n, t) => - switch t { - | Array(items) => - if (n < List.length(items)) { - Some(List.getExn(items, n)) - } else { - None - } - | _ => None - }; - -let string = (t) => - switch t { - | String(s) => Some(s) - | _ => None - }; - -let number = (t) => - switch t { - | Number(s) => Some(s) - | _ => None - }; - -let array = (t) => - switch t { - | Array(s) => Some(s) - | _ => None - }; - -let obj = (t) => - switch t { - | Object(s) => Some(s) - | _ => None - }; - -let bool = (t) => - switch t { - | True => Some(true) - | False => Some(false) - | _ => None - }; - -let null = (t) => - switch t { - | Null => Some() - | _ => None - }; - -let rec parsePath = (keyList, t) => - switch keyList { - | [] => Some(t) - | [head, ...rest] => - switch (get(head, t)) { - | None => None - | Some(value) => parsePath(rest, value) - } - }; - -/** Get a deeply nested value from an object `t`. - * ``` - * open Json.Infix; - * let json = Json.parse({|{"a": {"b": {"c": 2}}}|}); - * let num = Json.getPath("a.b.c", json) |?> Json.number; - * assert(num == Some(2.)) - * ``` - */ -let getPath = (path, t) => { - let keys = Parser.split_by((c) => c == '.', path); - parsePath(keys, t) -}; \ No newline at end of file diff --git a/analysis/examples/example-project/src/Json.res b/analysis/examples/example-project/src/Json.res new file mode 100644 index 000000000..7cbfbbe03 --- /dev/null +++ b/analysis/examples/example-project/src/Json.res @@ -0,0 +1,607 @@ +@@ocaml.doc(" # Json parser + * + * Works with bucklescript and bsb-native + * + * ## Basics + * + * ``` + * open Json.Infix; /* for the nice infix operators */ + * let raw = {|{\"hello\": \"folks\"}|}; + * let who = Json.parse(raw) |> Json.get(\"hello\") |?> Json.string; + * Js.log(who); + * ``` + * + * ## Parse & stringify + * + * @doc parse, stringify + * + * ## Accessing descendents + * + * @doc get, nth, getPath + * + * ## Coercing to types + * + * @doc string, number, array, obj, bool, null + * + * ## The JSON type + * + * @doc t + * + * ## Infix operators for easier working + * + * @doc Infix + ") + +type rec t = + | String(string) + | Number(float) + | Array(list) + | Object(list<(string, t)>) + | True + | False + | Null + +let string_of_number = f => { + let s = Js.Float.toString(f) + if String.get(s, String.length(s) - 1) == '.' { + String.sub(s, 0, String.length(s) - 1) + } else { + s + } +} + +@ocaml.doc(" + * This module is provided for easier working with optional values. + ") +module Infix = { + @ocaml.doc(" The \"force unwrap\" operator + * + * If you're sure there's a value, you can force it. + * ``` + * open Json.Infix; + * let x: int = Some(10) |! \"Expected this to be present\"; + * Js.log(x); + * ``` + * + * But you gotta be sure, otherwise it will throw. + * ```reason;raises + * open Json.Infix; + * let x: int = None |! \"This will throw\"; + * ``` + ") + let \"|!" = (o, d) => + switch o { + | None => failwith(d) + | Some(v) => v + } + @ocaml.doc(" The \"upwrap with default\" operator + * ``` + * open Json.Infix; + * let x: int = Some(10) |? 4; + * let y: int = None |? 5; + * Js.log2(x, y); + * ``` + ") + let \"|?" = (o, d) => + switch o { + | None => d + | Some(v) => v + } + @ocaml.doc(" The \"transform contents into new optional\" operator + * ``` + * open Json.Infix; + * let maybeInc = x => x > 5 ? Some(x + 1) : None; + * let x: option(int) = Some(14) |?> maybeInc; + * let y: option(int) = None |?> maybeInc; + * ``` + ") + let \"|?>" = (o, fn) => + switch o { + | None => None + | Some(v) => fn(v) + } + @ocaml.doc(" The \"transform contents into new value & then re-wrap\" operator + * ``` + * open Json.Infix; + * let inc = x => x + 1; + * let x: option(int) = Some(7) |?>> inc; + * let y: option(int) = None |?>> inc; + * Js.log2(x, y); + * ``` + ") + let \"|?>>" = (o, fn) => + switch o { + | None => None + | Some(v) => Some(fn(v)) + } + @ocaml.doc(" \"handle the value if present, otherwise here's the default\" + * + * It's called fold because that's what people call it :?. It's the same as \"transform contents to new value\" + \"unwrap with default\". + * + * ``` + * open Json.Infix; + * let inc = x => x + 1; + * let x: int = fold(Some(4), 10, inc); + * let y: int = fold(None, 2, inc); + * Js.log2(x, y); + * ``` + ") + let fold = (o, d, f) => + switch o { + | None => d + | Some(v) => f(v) + } +} + +let escape = text => { + let ln = String.length(text) + let buf = Buffer.create(ln) + let rec loop = i => + if i < ln { + switch String.get(text, i) { + | '\012' => Buffer.add_string(buf, "\\f") + | '\\' => Buffer.add_string(buf, "\\\\") + | '"' => Buffer.add_string(buf, "\\\"") + | '\n' => Buffer.add_string(buf, "\\n") + | '\b' => Buffer.add_string(buf, "\\b") + | '\r' => Buffer.add_string(buf, "\\r") + | '\t' => Buffer.add_string(buf, "\\t") + | c => Buffer.add_char(buf, c) + } + loop(i + 1) + } + loop(0) + Buffer.contents(buf) +} + +@ocaml.doc(" ``` + * let text = {|{\"hello\": \"folks\", \"aa\": [2, 3, \"four\"]}|}; + * let result = Json.stringify(Json.parse(text)); + * Js.log(result); + * assert(text == result); + * ``` + ") +let rec stringify = t => + switch t { + | String(value) => "\"" ++ (escape(value) ++ "\"") + | Number(num) => string_of_number(num) + | Array(items) => "[" ++ (String.concat(", ", List.map(items, stringify)) ++ "]") + | Object(items) => + "{" ++ + (String.concat( + ", ", + List.map(items, ((k, v)) => "\"" ++ (String.escaped(k) ++ ("\": " ++ stringify(v)))), + ) ++ + "}") + | True => "true" + | False => "false" + | Null => "null" + } + +let white = n => { + let buffer = Buffer.create(n) + for _ in 0 to n - 1 { + Buffer.add_char(buffer, ' ') + } + Buffer.contents(buffer) +} + +let rec stringifyPretty = (~indent=0, t) => + switch t { + | String(value) => "\"" ++ (escape(value) ++ "\"") + | Number(num) => string_of_number(num) + | Array(list{}) => "[]" + | Array(items) => + "[\n" ++ + (white(indent) ++ + (String.concat(",\n" ++ white(indent), List.map(items, stringifyPretty(~indent=indent + 2))) ++ + ("\n" ++ + (white(indent) ++ "]")))) + | Object(list{}) => "{}" + | Object(items) => + "{\n" ++ + (white(indent) ++ + (String.concat( + ",\n" ++ white(indent), + List.map(items, ((k, v)) => + "\"" ++ (String.escaped(k) ++ ("\": " ++ stringifyPretty(~indent=indent + 2, v))) + ), + ) ++ + ("\n" ++ + (white(indent) ++ "}")))) + | True => "true" + | False => "false" + | Null => "null" + } + +let unwrap = (message, t) => + switch t { + | Some(v) => v + | None => failwith(message) + } + +@nodoc +module Parser = { + let split_by = (~keep_empty=false, is_delim, str) => { + let len = String.length(str) + let rec loop = (acc, last_pos, pos) => + if pos == -1 { + if last_pos == 0 && !keep_empty { + acc + } else { + list{String.sub(str, 0, last_pos), ...acc} + } + } else if is_delim(String.get(str, pos)) { + let new_len = last_pos - pos - 1 + if new_len != 0 || keep_empty { + let v = String.sub(str, pos + 1, new_len) + loop(list{v, ...acc}, pos, pos - 1) + } else { + loop(acc, pos, pos - 1) + } + } else { + loop(acc, last_pos, pos - 1) + } + loop(list{}, len, len - 1) + } + let fail = (text, pos, message) => { + let pre = String.sub(text, 0, pos) + let lines = split_by(c => c == '\n', pre) + let count = List.length(lines) + let last = count > 0 ? List.getExn(lines, count - 1) : "" + let col = String.length(last) + 1 + let line = List.length(lines) + let string = Printf.sprintf("Error \"%s\" at %d:%d -> %s\n", message, line, col, last) + failwith(string) + } + let rec skipToNewline = (text, pos) => + if pos >= String.length(text) { + pos + } else if String.get(text, pos) == '\n' { + pos + 1 + } else { + skipToNewline(text, pos + 1) + } + let stringTail = text => { + let len = String.length(text) + if len > 1 { + String.sub(text, 1, len - 1) + } else { + "" + } + } + let rec skipToCloseMultilineComment = (text, pos) => + if pos + 1 >= String.length(text) { + failwith("Unterminated comment") + } else if String.get(text, pos) == '*' && String.get(text, pos + 1) == '/' { + pos + 2 + } else { + skipToCloseMultilineComment(text, pos + 1) + } + let rec skipWhite = (text, pos) => + if ( + pos < String.length(text) && + (String.get(text, pos) == ' ' || + (String.get(text, pos) == '\t' || + (String.get(text, pos) == '\n' || String.get(text, pos) == '\r'))) + ) { + skipWhite(text, pos + 1) + } else { + pos + } + let parseString = (text, pos) => { + /* let i = ref(pos); */ + let buffer = Buffer.create(String.length(text)) + let ln = String.length(text) + let rec loop = i => + i >= ln + ? fail(text, i, "Unterminated string") + : switch String.get(text, i) { + | '"' => i + 1 + | '\\' => + i + 1 >= ln + ? fail(text, i, "Unterminated string") + : switch String.get(text, i + 1) { + | '/' => + Buffer.add_char(buffer, '/') + loop(i + 2) + | 'f' => + Buffer.add_char(buffer, '\012') + loop(i + 2) + | _ => + Buffer.add_string(buffer, Scanf.unescaped(String.sub(text, i, 2))) + loop(i + 2) + } + | c => + Buffer.add_char(buffer, c) + loop(i + 1) + } + let final = loop(pos) + (Buffer.contents(buffer), final) + } + let parseDigits = (text, pos) => { + let len = String.length(text) + let rec loop = i => + if i >= len { + i + } else { + switch String.get(text, i) { + | '0' .. '9' => loop(i + 1) + | _ => i + } + } + loop(pos + 1) + } + let parseWithDecimal = (text, pos) => { + let pos = parseDigits(text, pos) + if pos < String.length(text) && String.get(text, pos) == '.' { + let pos = parseDigits(text, pos + 1) + pos + } else { + pos + } + } + let parseNumber = (text, pos) => { + let pos = parseWithDecimal(text, pos) + let ln = String.length(text) + if pos < ln - 1 && (String.get(text, pos) == 'E' || String.get(text, pos) == 'e') { + let pos = switch String.get(text, pos + 1) { + | '-' + | '+' => + pos + 2 + | _ => pos + 1 + } + parseDigits(text, pos) + } else { + pos + } + } + let parseNegativeNumber = (text, pos) => { + let final = if String.get(text, pos) == '-' { + parseNumber(text, pos + 1) + } else { + parseNumber(text, pos) + } + (Number(float_of_string(String.sub(text, pos, final - pos))), final) + } + let expect = (char, text, pos, message) => + if String.get(text, pos) != char { + fail(text, pos, "Expected: " ++ message) + } else { + pos + 1 + } + let parseComment: 'a. (string, int, (string, int) => 'a) => 'a = (text, pos, next) => + if String.get(text, pos) != '/' { + if String.get(text, pos) == '*' { + next(text, skipToCloseMultilineComment(text, pos + 1)) + } else { + failwith("Invalid syntax") + } + } else { + next(text, skipToNewline(text, pos + 1)) + } + let maybeSkipComment = (text, pos) => + if pos < String.length(text) && String.get(text, pos) == '/' { + if pos + 1 < String.length(text) && String.get(text, pos + 1) == '/' { + skipToNewline(text, pos + 1) + } else if pos + 1 < String.length(text) && String.get(text, pos + 1) == '*' { + skipToCloseMultilineComment(text, pos + 1) + } else { + fail(text, pos, "Invalid synatx") + } + } else { + pos + } + let rec skip = (text, pos) => + if pos == String.length(text) { + pos + } else { + let n = skipWhite(text, pos) |> maybeSkipComment(text) + if n > pos { + skip(text, n) + } else { + n + } + } + let rec parse = (text, pos) => + if pos >= String.length(text) { + fail(text, pos, "Reached end of file without being done parsing") + } else { + switch String.get(text, pos) { + | '/' => parseComment(text, pos + 1, parse) + | '[' => parseArray(text, pos + 1) + | '{' => parseObject(text, pos + 1) + | 'n' => + if String.sub(text, pos, 4) == "null" { + (Null, pos + 4) + } else { + fail(text, pos, "unexpected character") + } + | 't' => + if String.sub(text, pos, 4) == "true" { + (True, pos + 4) + } else { + fail(text, pos, "unexpected character") + } + | 'f' => + if String.sub(text, pos, 5) == "false" { + (False, pos + 5) + } else { + fail(text, pos, "unexpected character") + } + | '\n' + | '\t' + | ' ' + | '\r' => + parse(text, skipWhite(text, pos)) + | '"' => + let (s, pos) = parseString(text, pos + 1) + (String(s), pos) + | '-' + | '0' .. '9' => + parseNegativeNumber(text, pos) + | _ => fail(text, pos, "unexpected character") + } + } + and parseArrayValue = (text, pos) => { + let pos = skip(text, pos) + let (value, pos) = parse(text, pos) + let pos = skip(text, pos) + switch String.get(text, pos) { + | ',' => + let pos = skip(text, pos + 1) + if String.get(text, pos) == ']' { + (list{value}, pos + 1) + } else { + let (rest, pos) = parseArrayValue(text, pos) + (list{value, ...rest}, pos) + } + | ']' => (list{value}, pos + 1) + | _ => fail(text, pos, "unexpected character") + } + } + and parseArray = (text, pos) => { + let pos = skip(text, pos) + switch String.get(text, pos) { + | ']' => (Array(list{}), pos + 1) + | _ => + let (items, pos) = parseArrayValue(text, pos) + (Array(items), pos) + } + } + and parseObjectValue = (text, pos) => { + let pos = skip(text, pos) + if String.get(text, pos) != '"' { + fail(text, pos, "Expected string") + } else { + let (key, pos) = parseString(text, pos + 1) + let pos = skip(text, pos) + let pos = expect(':', text, pos, "Colon") + let (value, pos) = parse(text, pos) + let pos = skip(text, pos) + switch String.get(text, pos) { + | ',' => + let pos = skip(text, pos + 1) + if String.get(text, pos) == '}' { + (list{(key, value)}, pos + 1) + } else { + let (rest, pos) = parseObjectValue(text, pos) + (list{(key, value), ...rest}, pos) + } + | '}' => (list{(key, value)}, pos + 1) + | _ => + let (rest, pos) = parseObjectValue(text, pos) + (list{(key, value), ...rest}, pos) + } + } + } + and parseObject = (text, pos) => { + let pos = skip(text, pos) + if String.get(text, pos) == '}' { + (Object(list{}), pos + 1) + } else { + let (pairs, pos) = parseObjectValue(text, pos) + (Object(pairs), pos) + } + } +} + +@ocaml.doc(" Turns some text into a json object. throws on failure ") +let parse = text => { + let (item, pos) = Parser.parse(text, 0) + let pos = Parser.skip(text, pos) + if pos < String.length(text) { + failwith( + "Extra data after parse finished: " ++ String.sub(text, pos, String.length(text) - pos), + ) + } else { + item + } +} + +/* Accessor helpers */ +let bind = (v, fn) => + switch v { + | None => None + | Some(v) => fn(v) + } + +@ocaml.doc(" If `t` is an object, get the value associated with the given string key ") +let get = (key, t) => + switch t { + | Object(items) => List.getAssoc(items, key, \"=") + | _ => None + } + +@ocaml.doc(" If `t` is an array, get the value associated with the given index ") +let nth = (n, t) => + switch t { + | Array(items) => + if n < List.length(items) { + Some(List.getExn(items, n)) + } else { + None + } + | _ => None + } + +let string = t => + switch t { + | String(s) => Some(s) + | _ => None + } + +let number = t => + switch t { + | Number(s) => Some(s) + | _ => None + } + +let array = t => + switch t { + | Array(s) => Some(s) + | _ => None + } + +let obj = t => + switch t { + | Object(s) => Some(s) + | _ => None + } + +let bool = t => + switch t { + | True => Some(true) + | False => Some(false) + | _ => None + } + +let null = t => + switch t { + | Null => Some() + | _ => None + } + +let rec parsePath = (keyList, t) => + switch keyList { + | list{} => Some(t) + | list{head, ...rest} => + switch get(head, t) { + | None => None + | Some(value) => parsePath(rest, value) + } + } + +@ocaml.doc(" Get a deeply nested value from an object `t`. + * ``` + * open Json.Infix; + * let json = Json.parse({|{\"a\": {\"b\": {\"c\": 2}}}|}); + * let num = Json.getPath(\"a.b.c\", json) |?> Json.number; + * assert(num == Some(2.)) + * ``` + ") +let getPath = (path, t) => { + let keys = Parser.split_by(c => c == '.', path) + parsePath(keys, t) +} + diff --git a/analysis/examples/example-project/src/More.re b/analysis/examples/example-project/src/More.re deleted file mode 100644 index 94eb86f28..000000000 --- a/analysis/examples/example-project/src/More.re +++ /dev/null @@ -1,12 +0,0 @@ -/** Toplevel docs */; - -/** Some contents */ -let contnets = "here"; - -let inner = 20; - -let n = 10; - -let party = 30; - -let awesome = 200; \ No newline at end of file diff --git a/analysis/examples/example-project/src/More.rei b/analysis/examples/example-project/src/More.rei deleted file mode 100644 index 4bda491db..000000000 --- a/analysis/examples/example-project/src/More.rei +++ /dev/null @@ -1,5 +0,0 @@ - -let contnets: string; -let inner: int; -let n: int; -let party: int \ No newline at end of file diff --git a/analysis/examples/example-project/src/More.res b/analysis/examples/example-project/src/More.res new file mode 100644 index 000000000..a1775e21a --- /dev/null +++ b/analysis/examples/example-project/src/More.res @@ -0,0 +1,13 @@ +@@ocaml.doc(" Toplevel docs ") + +@ocaml.doc(" Some contents ") +let contnets = "here" + +let inner = 20 + +let n = 10 + +let party = 30 + +let awesome = 200 + diff --git a/analysis/examples/example-project/src/More.resi b/analysis/examples/example-project/src/More.resi new file mode 100644 index 000000000..023a7222c --- /dev/null +++ b/analysis/examples/example-project/src/More.resi @@ -0,0 +1,5 @@ +let contnets: string +let inner: int +let n: int +let party: int + diff --git a/analysis/examples/example-project/src/Other.re b/analysis/examples/example-project/src/Other.re deleted file mode 100644 index a6f1d8e86..000000000 --- a/analysis/examples/example-project/src/Other.re +++ /dev/null @@ -1,32 +0,0 @@ - -/* let later = 10; */ - -/* Ok testing things */ - -let something = 10; - -type person = {name: string, age: int}; - -type animals = Things(int) | People(string) | Mouse; - -let inner = 10; -/* More.outer; */ - - -let m = Things(1); - -/* working on things. */ - - -let z = {name: "hi", age: 20}; - -let later = 20; - -let concat = (~first, ~second) => first + second; - -type other = {person, height: float}; -let oo = {person: z, height: 34.2}; - -let show = o => { - let m = o.height; -}; diff --git a/analysis/examples/example-project/src/Other.res b/analysis/examples/example-project/src/Other.res new file mode 100644 index 000000000..d7a5bf432 --- /dev/null +++ b/analysis/examples/example-project/src/Other.res @@ -0,0 +1,30 @@ +/* let later = 10; */ + +/* Ok testing things */ + +let something = 10 + +type person = {name: string, age: int} + +type animals = Things(int) | People(string) | Mouse + +let inner = 10 +/* More.outer; */ + +let m = Things(1) + +/* working on things. */ + +let z = {name: "hi", age: 20} + +let later = 20 + +let concat = (~first, ~second) => first + second + +type other = {person: person, height: float} +let oo = {person: z, height: 34.2} + +let show = o => { + let m = o.height +} + diff --git a/analysis/examples/example-project/src/Serde.ml b/analysis/examples/example-project/src/Serde.ml deleted file mode 100644 index a1e19fa74..000000000 --- a/analysis/examples/example-project/src/Serde.ml +++ /dev/null @@ -1,348 +0,0 @@ -let rec (deserialize_Hello__TryIt____lockfile : - Json.t -> (TryIt.Hello.lockfile, string) Belt.Result.t) = - fun record -> - match record with - | ((Json.Object (items))[@explicit_arity ]) -> - (match Belt.List.getAssoc items "current" (=) with - | None -> - ((Belt.Result.Error - (((("No attribute ")[@reason.raw_literal "No attribute "]) ^ - "current"))) - [@explicit_arity ]) - | ((Some (json))[@explicit_arity ]) -> - (match (fun list -> - match list with - | ((Json.Array (items))[@explicit_arity ]) -> - let transformer json = - match json with - | ((Json.Array - (arg0::arg1::[]))[@explicit_arity ]) -> - (match (fun number -> - match number with - | ((Json.Number - (number))[@explicit_arity ]) - -> - ((Belt.Result.Ok - ((int_of_float number))) - [@explicit_arity ]) - | _ -> - ((Error - ((("Expected a float") - [@reason.raw_literal - "Expected a float"]))) - [@explicit_arity ])) arg1 - with - | Belt.Result.Ok arg1 -> - (match deserialize_Hello__TryIt____shortReference - arg0 - with - | Belt.Result.Ok arg0 -> - Belt.Result.Ok (arg0, arg1) - | Error error -> Error error) - | Error error -> Error error) - | _ -> - ((Belt.Result.Error - ((("Expected array") - [@reason.raw_literal "Expected array"]))) - [@explicit_arity ]) in - let rec loop items = - match items with - | [] -> ((Belt.Result.Ok ([])) - [@explicit_arity ]) - | one::rest -> - (match transformer one with - | ((Belt.Result.Error - (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (value))[@explicit_arity ]) -> - (match loop rest with - | ((Belt.Result.Error - (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (rest))[@explicit_arity ]) -> - ((Belt.Result.Ok ((value :: rest))) - [@explicit_arity ]))) in - loop items - | _ -> - ((Belt.Result.Error - ((("expected an array") - [@reason.raw_literal "expected an array"]))) - [@explicit_arity ])) json - with - | ((Belt.Result.Error (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error))[@explicit_arity ]) - | ((Belt.Result.Ok (attr_current))[@explicit_arity ]) -> - (match Belt.List.getAssoc items "pastVersions" (=) with - | None -> - ((Belt.Result.Error - (((("No attribute ") - [@reason.raw_literal "No attribute "]) ^ - "pastVersions"))) - [@explicit_arity ]) - | ((Some (json))[@explicit_arity ]) -> - (match (deserialize_Belt_HashMapInt____t - (fun list -> - match list with - | ((Json.Array - (items))[@explicit_arity ]) -> - let transformer json = - match json with - | ((Json.Array - (arg0::arg1::[]))[@explicit_arity - ]) - -> - (match (fun number -> - match number with - | ((Json.Number - (number)) - [@explicit_arity - ]) - -> - ((Belt.Result.Ok - ((int_of_float - number))) - [@explicit_arity - ]) - | _ -> - ((Error - ((("Expected a float") - [@reason.raw_literal - "Expected a float"]))) - [@explicit_arity - ])) arg1 - with - | Belt.Result.Ok arg1 -> - (match deserialize_Hello__TryIt____shortReference - arg0 - with - | Belt.Result.Ok arg0 -> - Belt.Result.Ok - (arg0, arg1) - | Error error -> - Error error) - | Error error -> Error error) - | _ -> - ((Belt.Result.Error - ((("Expected array") - [@reason.raw_literal - "Expected array"]))) - [@explicit_arity ]) in - let rec loop items = - match items with - | [] -> ((Belt.Result.Ok ([])) - [@explicit_arity ]) - | one::rest -> - (match transformer one with - | ((Belt.Result.Error - (error))[@explicit_arity ]) - -> - ((Belt.Result.Error - (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (value))[@explicit_arity ]) - -> - (match loop rest with - | ((Belt.Result.Error - (error))[@explicit_arity - ]) - -> - ((Belt.Result.Error - (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (rest))[@explicit_arity - ]) - -> - ((Belt.Result.Ok - ((value :: rest))) - [@explicit_arity ]))) in - loop items - | _ -> - ((Belt.Result.Error - ((("expected an array") - [@reason.raw_literal - "expected an array"]))) - [@explicit_arity ]))) json - with - | ((Belt.Result.Error (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error))[@explicit_arity ]) - | ((Belt.Result.Ok - (attr_pastVersions))[@explicit_arity ]) -> - (match Belt.List.getAssoc items "version" (=) - with - | None -> - ((Belt.Result.Error - (((("No attribute ") - [@reason.raw_literal - "No attribute "]) - ^ "version"))) - [@explicit_arity ]) - | ((Some (json))[@explicit_arity ]) -> - (match (fun number -> - match number with - | ((Json.Number - (number))[@explicit_arity ]) - -> - ((Belt.Result.Ok - ((int_of_float number))) - [@explicit_arity ]) - | _ -> - ((Error - ((("Expected a float") - [@reason.raw_literal - "Expected a float"]))) - [@explicit_arity ])) json - with - | ((Belt.Result.Error - (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (attr_version))[@explicit_arity ]) -> - Belt.Result.Ok - { - version = attr_version; - pastVersions = attr_pastVersions; - current = attr_current - })))))) - | _ -> - ((Belt.Result.Error - ((("Expected an object") - [@reason.raw_literal "Expected an object"]))) - [@explicit_arity ]) -and (deserialize_Hello__TryIt____shortReference : - Json.t -> (TryIt.Hello.shortReference, string) Belt.Result.t) = - fun value -> - (fun json -> - match json with - | ((Json.Array (arg0::arg1::arg2::[]))[@explicit_arity ]) -> - (match (fun string -> - match string with - | ((Json.String (string))[@explicit_arity ]) -> - ((Belt.Result.Ok (string))[@explicit_arity ]) - | _ -> - ((Error - ((("epected a string") - [@reason.raw_literal "epected a string"]))) - [@explicit_arity ])) arg2 - with - | Belt.Result.Ok arg2 -> - (match (fun list -> - match list with - | ((Json.Array (items))[@explicit_arity ]) -> - let transformer string = - match string with - | ((Json.String (string))[@explicit_arity ]) - -> ((Belt.Result.Ok (string)) - [@explicit_arity ]) - | _ -> - ((Error - ((("epected a string") - [@reason.raw_literal - "epected a string"]))) - [@explicit_arity ]) in - let rec loop items = - match items with - | [] -> ((Belt.Result.Ok ([])) - [@explicit_arity ]) - | one::rest -> - (match transformer one with - | ((Belt.Result.Error - (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (value))[@explicit_arity ]) -> - (match loop rest with - | ((Belt.Result.Error - (error))[@explicit_arity ]) -> - ((Belt.Result.Error (error)) - [@explicit_arity ]) - | ((Belt.Result.Ok - (rest))[@explicit_arity ]) -> - ((Belt.Result.Ok - ((value :: rest))) - [@explicit_arity ]))) in - loop items - | _ -> - ((Belt.Result.Error - ((("expected an array") - [@reason.raw_literal "expected an array"]))) - [@explicit_arity ])) arg1 - with - | Belt.Result.Ok arg1 -> - (match (fun string -> - match string with - | ((Json.String (string))[@explicit_arity ]) - -> ((Belt.Result.Ok (string)) - [@explicit_arity ]) - | _ -> - ((Error - ((("epected a string") - [@reason.raw_literal - "epected a string"]))) - [@explicit_arity ])) arg0 - with - | Belt.Result.Ok arg0 -> - Belt.Result.Ok (arg0, arg1, arg2) - | Error error -> Error error) - | Error error -> Error error) - | Error error -> Error error) - | _ -> - ((Belt.Result.Error - ((("Expected array")[@reason.raw_literal "Expected array"]))) - [@explicit_arity ])) value -and deserialize_Belt_HashMapInt____t : - 'arg0 . - (Json.t -> ('arg0, string) Belt.Result.t) -> - Json.t -> ('arg0 Belt_HashMapInt.t, string) Belt.Result.t - = - fun bTransformer -> - TransformHelpers.deserialize_Belt_HashMapInt____t bTransformer -let rec (serialize_Hello__TryIt____lockfile : TryIt.Hello.lockfile -> Json.t) - = - fun record -> - Json.Object - [("version", - (((fun i -> ((Json.Number ((float_of_int i)))[@explicit_arity ]))) - record.version)); - ("pastVersions", - ((serialize_Belt_HashMapInt____t - (fun list -> - Json.Array - (Belt.List.map list - (fun (arg0, arg1) -> - Json.Array - [serialize_Hello__TryIt____shortReference arg0; - ((fun i -> ((Json.Number ((float_of_int i))) - [@explicit_arity ]))) arg1])))) - record.pastVersions)); - ("current", - (((fun list -> - Json.Array - (Belt.List.map list - (fun (arg0, arg1) -> - Json.Array - [serialize_Hello__TryIt____shortReference arg0; - ((fun i -> ((Json.Number ((float_of_int i))) - [@explicit_arity ]))) arg1])))) record.current))] -and (serialize_Hello__TryIt____shortReference : - TryIt.Hello.shortReference -> Json.t) = - fun value -> - (fun (arg0, arg1, arg2) -> - Json.Array - [((fun s -> ((Json.String (s))[@explicit_arity ]))) arg0; - ((fun list -> - Json.Array - (Belt.List.map list - (fun s -> ((Json.String (s))[@explicit_arity ]))))) arg1; - ((fun s -> ((Json.String (s))[@explicit_arity ]))) arg2]) value -and serialize_Belt_HashMapInt____t : - 'arg0 . ('arg0 -> Json.t) -> 'arg0 Belt_HashMapInt.t -> Json.t = - fun bTransformer -> - TransformHelpers.serialize_Belt_HashMapInt____t bTransformer diff --git a/analysis/examples/example-project/src/Serde.res b/analysis/examples/example-project/src/Serde.res new file mode 100644 index 000000000..1c516c210 --- /dev/null +++ b/analysis/examples/example-project/src/Serde.res @@ -0,0 +1,222 @@ +let rec deserialize_Hello__TryIt____lockfile: Json.t => Belt.Result.t< + MyNamespace.Hello.lockfile, + string, +> = record => + switch record { + | Json.Object(items) => + switch Belt.List.getAssoc(items, "current", \"=") { + | None => Belt.Result.Error(@reason.raw_literal("No attribute ") "No attribute " ++ "current") + | Some(json) => + switch ( + list => + switch list { + | Json.Array(items) => + let transformer = json => + switch json { + | Json.Array(list{arg0, arg1}) => + switch ( + number => + switch number { + | Json.Number(number) => Belt.Result.Ok(int_of_float(number)) + | _ => Error(@reason.raw_literal("Expected a float") "Expected a float") + } + )(arg1) { + | Belt.Result.Ok(arg1) => + switch deserialize_Hello__TryIt____shortReference(arg0) { + | Belt.Result.Ok(arg0) => Belt.Result.Ok(arg0, arg1) + | Error(error) => Error(error) + } + | Error(error) => Error(error) + } + | _ => Belt.Result.Error(@reason.raw_literal("Expected array") "Expected array") + } + let rec loop = items => + switch items { + | list{} => Belt.Result.Ok(list{}) + | list{one, ...rest} => + switch transformer(one) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(value) => + switch loop(rest) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(rest) => Belt.Result.Ok(list{value, ...rest}) + } + } + } + loop(items) + | _ => Belt.Result.Error(@reason.raw_literal("expected an array") "expected an array") + } + )(json) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(attr_current) => + switch Belt.List.getAssoc(items, "pastVersions", \"=") { + | None => + Belt.Result.Error(@reason.raw_literal("No attribute ") "No attribute " ++ "pastVersions") + | Some(json) => + switch deserialize_Belt_HashMapInt____t(list => + switch list { + | Json.Array(items) => + let transformer = json => + switch json { + | Json.Array(list{arg0, arg1}) => + switch ( + number => + switch number { + | Json.Number(number) => Belt.Result.Ok(int_of_float(number)) + | _ => Error(@reason.raw_literal("Expected a float") "Expected a float") + } + )(arg1) { + | Belt.Result.Ok(arg1) => + switch deserialize_Hello__TryIt____shortReference(arg0) { + | Belt.Result.Ok(arg0) => Belt.Result.Ok(arg0, arg1) + | Error(error) => Error(error) + } + | Error(error) => Error(error) + } + | _ => Belt.Result.Error(@reason.raw_literal("Expected array") "Expected array") + } + let rec loop = items => + switch items { + | list{} => Belt.Result.Ok(list{}) + | list{one, ...rest} => + switch transformer(one) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(value) => + switch loop(rest) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(rest) => Belt.Result.Ok(list{value, ...rest}) + } + } + } + loop(items) + | _ => Belt.Result.Error(@reason.raw_literal("expected an array") "expected an array") + } + )(json) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(attr_pastVersions) => + switch Belt.List.getAssoc(items, "version", \"=") { + | None => + Belt.Result.Error(@reason.raw_literal("No attribute ") "No attribute " ++ "version") + | Some(json) => + switch ( + number => + switch number { + | Json.Number(number) => Belt.Result.Ok(int_of_float(number)) + | _ => Error(@reason.raw_literal("Expected a float") "Expected a float") + } + )(json) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(attr_version) => + Belt.Result.Ok({ + version: attr_version, + pastVersions: attr_pastVersions, + current: attr_current, + }) + } + } + } + } + } + } + | _ => Belt.Result.Error(@reason.raw_literal("Expected an object") "Expected an object") + } +and deserialize_Hello__TryIt____shortReference: Json.t => Belt.Result.t< + MyNamespace.Hello.shortReference, + string, +> = value => + ( + json => + switch json { + | Json.Array(list{arg0, arg1, arg2}) => + switch ( + string => + switch string { + | Json.String(string) => Belt.Result.Ok(string) + | _ => Error(@reason.raw_literal("epected a string") "epected a string") + } + )(arg2) { + | Belt.Result.Ok(arg2) => + switch ( + list => + switch list { + | Json.Array(items) => + let transformer = string => + switch string { + | Json.String(string) => Belt.Result.Ok(string) + | _ => Error(@reason.raw_literal("epected a string") "epected a string") + } + let rec loop = items => + switch items { + | list{} => Belt.Result.Ok(list{}) + | list{one, ...rest} => + switch transformer(one) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(value) => + switch loop(rest) { + | Belt.Result.Error(error) => Belt.Result.Error(error) + | Belt.Result.Ok(rest) => Belt.Result.Ok(list{value, ...rest}) + } + } + } + loop(items) + | _ => Belt.Result.Error(@reason.raw_literal("expected an array") "expected an array") + } + )(arg1) { + | Belt.Result.Ok(arg1) => + switch ( + string => + switch string { + | Json.String(string) => Belt.Result.Ok(string) + | _ => Error(@reason.raw_literal("epected a string") "epected a string") + } + )(arg0) { + | Belt.Result.Ok(arg0) => Belt.Result.Ok(arg0, arg1, arg2) + | Error(error) => Error(error) + } + | Error(error) => Error(error) + } + | Error(error) => Error(error) + } + | _ => Belt.Result.Error(@reason.raw_literal("Expected array") "Expected array") + } + )(value) +and deserialize_Belt_HashMapInt____t: 'arg0. ( + Json.t => Belt.Result.t<'arg0, string>, + Json.t, +) => Belt.Result.t, string> = bTransformer => + TransformHelpers.deserialize_Belt_HashMapInt____t(bTransformer) +let rec serialize_Hello__TryIt____lockfile: MyNamespace.Hello.lockfile => Json.t = record => Json.Object(list{ + ("version", (i => Json.Number(float_of_int(i)))(record.version)), + ( + "pastVersions", + serialize_Belt_HashMapInt____t(list => Json.Array( + Belt.List.map(list, ((arg0, arg1)) => Json.Array(list{ + serialize_Hello__TryIt____shortReference(arg0), + (i => Json.Number(float_of_int(i)))(arg1), + })), + ))(record.pastVersions), + ), + ( + "current", + ( + list => Json.Array( + Belt.List.map(list, ((arg0, arg1)) => Json.Array(list{ + serialize_Hello__TryIt____shortReference(arg0), + (i => Json.Number(float_of_int(i)))(arg1), + })), + ) + )(record.current), + ), +}) +and serialize_Hello__TryIt____shortReference: MyNamespace.Hello.shortReference => Json.t = value => + ( + ((arg0, arg1, arg2)) => Json.Array(list{ + (s => Json.String(s))(arg0), + (list => Json.Array(Belt.List.map(list, s => Json.String(s))))(arg1), + (s => Json.String(s))(arg2), + }) + )(value) +and serialize_Belt_HashMapInt____t: 'arg0. ( + 'arg0 => Json.t, + Belt_HashMapInt.t<'arg0>, +) => Json.t = bTransformer => TransformHelpers.serialize_Belt_HashMapInt____t(bTransformer) diff --git a/analysis/examples/example-project/src/TransformHelpers.re b/analysis/examples/example-project/src/TransformHelpers.re deleted file mode 100644 index b3d5a21cb..000000000 --- a/analysis/examples/example-project/src/TransformHelpers.re +++ /dev/null @@ -1,16 +0,0 @@ - -let deserialize_Belt__HashMapInt__t = (transformer, t) => { - assert(false) -}; - -let deserialize_Belt_HashMapInt____t = (a, b) => assert(false); - -let deserialize_Belt__HashMap__Int__t = (a, b) => assert(false); - -let serialize_Belt_HashMapInt____t = (a, b) => assert(false); - -let serialize_Belt__HashMap__Int__t = (a, b) => assert(false); - -let serialize_Belt_HashMapInt____t = (transformer, t) => { - assert(false) -}; diff --git a/analysis/examples/example-project/src/TransformHelpers.res b/analysis/examples/example-project/src/TransformHelpers.res new file mode 100644 index 000000000..b0ab64685 --- /dev/null +++ b/analysis/examples/example-project/src/TransformHelpers.res @@ -0,0 +1,12 @@ +let deserialize_Belt__HashMapInt__t = (transformer, t) => assert false + +let deserialize_Belt_HashMapInt____t = (a, b) => assert false + +let deserialize_Belt__HashMap__Int__t = (a, b) => assert false + +let serialize_Belt_HashMapInt____t = (a, b) => assert false + +let serialize_Belt__HashMap__Int__t = (a, b) => assert false + +let serialize_Belt_HashMapInt____t = (transformer, t) => assert false + diff --git a/analysis/src/BuildSystem.ml b/analysis/src/BuildSystem.ml index d38cf85eb..30404c6cf 100644 --- a/analysis/src/BuildSystem.ml +++ b/analysis/src/BuildSystem.ml @@ -19,7 +19,7 @@ let getBsPlatformDir rootPath = Log.log message; Error message -let getCompiledBase root = Files.ifExists (root /+ "lib" /+ "bs") +let getLibBs root = Files.ifExists (root /+ "lib" /+ "bs") let getStdlib base = match getBsPlatformDir base with diff --git a/analysis/src/FindFiles.ml b/analysis/src/FindFiles.ml index b324d9a2e..6c8bd8e29 100644 --- a/analysis/src/FindFiles.ml +++ b/analysis/src/FindFiles.ml @@ -5,7 +5,7 @@ let ifDebug debug name fn v = let ( /+ ) = Filename.concat (* Returns a list of paths, relative to the provided `base` *) -let getSourceDirectories ~includeDev base config = +let getSourceDirectories ~includeDev ~baseDir config = let open Infix in let rec handleItem current item = match item with @@ -25,10 +25,9 @@ let getSourceDirectories ~includeDev base config = match item |> Json.get "subdirs" with | None | Some Json.False -> [current /+ dir] | Some Json.True -> - Files.collectDirs (base /+ current /+ dir) - (* |> ifDebug(true, "Subdirs", String.concat(" - ")) *) + Files.collectDirs (baseDir /+ current /+ dir) |> List.filter (fun name -> name <> Filename.current_dir_name) - |> List.map (Files.relpath base) + |> List.map (Files.relpath baseDir) | Some item -> (current /+ dir) :: handleItem (current /+ dir) item) | _ -> failwith "Invalid subdirs entry" in @@ -39,14 +38,18 @@ let getSourceDirectories ~includeDev base config = let isCompiledFile name = Filename.check_suffix name ".cmt" || Filename.check_suffix name ".cmti" -let isSourceFile name = +let isImplementation name = Filename.check_suffix name ".re" - || Filename.check_suffix name ".rei" || Filename.check_suffix name ".res" - || Filename.check_suffix name ".resi" || Filename.check_suffix name ".ml" + +let isInterface name = + Filename.check_suffix name ".rei" + || Filename.check_suffix name ".resi" || Filename.check_suffix name ".mli" +let isSourceFile name = isImplementation name || isInterface name + let compiledNameSpace name = String.split_on_char '-' name |> List.map String.capitalize_ascii @@ -104,100 +107,70 @@ let collectFiles directory = let compileds = allFiles |> List.filter isCompiledFile |> filterDuplicates in let sources = allFiles |> List.filter isSourceFile |> filterDuplicates in compileds - |> List.map (fun path -> + |> Utils.filterMap (fun path -> let modName = getName path in - let compiled = directory /+ path in - let source = + let cmt = directory /+ path in + let resOpt = Utils.find (fun name -> if getName name = modName then Some (directory /+ name) else None) sources in - (modName, SharedTypes.Impl (compiled, source))) + match resOpt with + | None -> None + | Some res -> Some (modName, SharedTypes.Impl {cmt; res})) (* returns a list of (absolute path to cmt(i), relative path from base to source file) *) -let findProjectFiles ~debug namespace root sourceDirectories compiledBase = +let findProjectFiles ~namespace ~path ~sourceDirectories ~libBs = let files = sourceDirectories - |> List.map (Filename.concat root) - |> ifDebug debug "Source directories" (String.concat " - ") + |> List.map (Filename.concat path) + |> ifDebug true "Source directories" (String.concat " - ") |> List.map (fun name -> Files.collect name isSourceFile) |> List.concat |> Utils.dedup - |> ifDebug debug "Source files found" (String.concat " : ") - (* - |> filterDuplicates - |> Utils.filterMap(path => { - let rel = Files.relpath(root, path); - ifOneExists([ - compiledBase /+ cmtName(~namespace, rel), - compiledBase /+ cmiName(~namespace, rel), - ]) |?>> cm => (cm, path) - }) - |> ifDebug(debug, "With compiled base", (items) => String.concat("\n", List.map(((a, b)) => a ++ " : " ++ b, items))) - |> List.filter(((full, rel)) => Files.exists(full)) - /* TODO more than just Impl() */ - |> List.map(((cmt, src)) => (getName(src), SharedTypes.Impl(cmt, Some(src)))) - *) + |> ifDebug true "Source files found" (String.concat " : ") in + let interfaces = Hashtbl.create 100 in files |> List.iter (fun path -> - if - Filename.check_suffix path ".rei" - || Filename.check_suffix path ".resi" - || Filename.check_suffix path ".mli" - then ( + if isInterface path then ( Log.log ("Adding intf " ^ path); Hashtbl.replace interfaces (getName path) path)); + let normals = files - |> Utils.filterMap (fun path -> - if - Filename.check_suffix path ".re" - || Filename.check_suffix path ".res" - || Filename.check_suffix path ".ml" - then ( - let mname = getName path in - let intf = Hashtbl.find_opt interfaces mname in - Hashtbl.remove interfaces mname; - let base = compiledBaseName ~namespace (Files.relpath root path) in - match intf with - | Some intf -> - let cmti = (compiledBase /+ base) ^ ".cmti" in - let cmt = (compiledBase /+ base) ^ ".cmt" in + |> Utils.filterMap (fun file -> + if isImplementation file then ( + let moduleName = getName file in + let resi = Hashtbl.find_opt interfaces moduleName in + Hashtbl.remove interfaces moduleName; + let base = compiledBaseName ~namespace (Files.relpath path file) in + match resi with + | Some resi -> + let cmti = (libBs /+ base) ^ ".cmti" in + let cmt = (libBs /+ base) ^ ".cmt" in if Files.exists cmti then if Files.exists cmt then (* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *) - Some (mname, SharedTypes.IntfAndImpl (cmti, intf, cmt, path)) - else Some (mname, Intf (cmti, intf)) + Some + ( moduleName, + SharedTypes.IntfAndImpl {cmti; resi; cmt; res = file} ) + else None else ( (* Log.log("Just intf " ++ cmti) *) - Log.log - ("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase /+ base) - ); + Log.log ("Bad source file (no cmt/cmti/cmi) " ^ (libBs /+ base)); None) | None -> - let cmt = (compiledBase /+ base) ^ ".cmt" in - if Files.exists cmt then Some (mname, Impl (cmt, Some path)) + let cmt = (libBs /+ base) ^ ".cmt" in + if Files.exists cmt then Some (moduleName, Impl {cmt; res = file}) else ( - Log.log - ("Bad source file (no cmt/cmi) " ^ (compiledBase /+ base)); + Log.log ("Bad source file (no cmt/cmi) " ^ (libBs /+ base)); None)) - else ( - Log.log ("Bad source file (extension) " ^ path); - None)) + else None) in let result = - List.append normals - (Hashtbl.fold - (fun mname intf res -> - let base = compiledBaseName ~namespace (Files.relpath root intf) in - Log.log ("Extra intf " ^ intf); - let cmti = (compiledBase /+ base) ^ ".cmti" in - if Files.exists cmti then - (mname, SharedTypes.Intf (cmti, intf)) :: res - else res) - interfaces []) + normals |> List.map (fun (name, paths) -> match namespace with | None -> (name, paths) @@ -206,19 +179,12 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = match namespace with | None -> result | Some namespace -> - let mname = nameSpaceToName namespace in - let cmt = (compiledBase /+ namespace) ^ ".cmt" in - Log.log ("adding namespace " ^ namespace ^ " : " ^ mname ^ " : " ^ cmt); - (mname, Impl (cmt, None)) :: result - -(* -let loadStdlib = stdlib => { - collectFiles(stdlib) - |> List.filter(((_, (cmt, src))) => Files.exists(cmt)) -}; -*) + let moduleName = nameSpaceToName namespace in + let cmt = (libBs /+ namespace) ^ ".cmt" in + Log.log ("adding namespace " ^ namespace ^ " : " ^ moduleName ^ " : " ^ cmt); + (moduleName, Namespace {cmt}) :: result -let findDependencyFiles ~debug base config = +let findDependencyFiles base config = let open Infix in let deps = config |> Json.get "bs-dependencies" |?> Json.array |? [] @@ -236,57 +202,46 @@ let findDependencyFiles ~debug base config = |> List.map (fun name -> let result = ModuleResolution.resolveNodeModulePath ~startPath:base name - |?> fun loc -> - let innerPath = loc /+ "bsconfig.json" in + |?> fun path -> + let innerPath = path /+ "bsconfig.json" in Log.log ("Dep loc " ^ innerPath); match Files.readFile innerPath with | Some text -> ( let inner = Json.parse text in let namespace = getNamespace inner in - let directories = - getSourceDirectories ~includeDev:false loc inner + let sourceDirectories = + getSourceDirectories ~includeDev:false ~baseDir:path inner in - match BuildSystem.getCompiledBase loc with + match BuildSystem.getLibBs path with | None -> None - | Some compiledBase -> - if debug then Log.log ("Compiled base: " ^ compiledBase); + | Some libBs -> + Log.log ("Compiled base: " ^ libBs); let compiledDirectories = - directories |> List.map (Filename.concat compiledBase) + sourceDirectories |> List.map (Filename.concat libBs) in let compiledDirectories = match namespace with | None -> compiledDirectories - | Some _ -> compiledBase :: compiledDirectories + | Some _ -> libBs :: compiledDirectories in - let files = - findProjectFiles ~debug namespace loc directories - compiledBase + let projectFiles = + findProjectFiles ~namespace ~path ~sourceDirectories ~libBs in - (* - let files = switch (namespace) { - | None => - files - | Some(namespace) => - files - |> List.map(((name, paths)) => - (namespace ++ "-" ++ name, paths) - ) - }; - *) - Some (compiledDirectories, files)) + Some (compiledDirectories, projectFiles)) | None -> None in match result with - | Some dependency -> dependency + | Some (files, directories) -> (files, directories) | None -> Log.log ("Skipping nonexistent dependency: " ^ name); ([], [])) in - let directories, files = List.split depFiles in - let files = List.concat files in match BuildSystem.getStdlib base with | Error e -> Error e | Ok stdlibDirectory -> - let directories = stdlibDirectory :: List.concat directories in - let results = files @ collectFiles stdlibDirectory in - Ok (directories, results) + let compiledDirectories, projectFiles = + let files, directories = List.split depFiles in + (List.concat files, List.concat directories) + in + let allFiles = projectFiles @ collectFiles stdlibDirectory in + Ok (compiledDirectories, allFiles) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index 72be3691d..bbec85cc9 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -731,7 +731,7 @@ let resolveRawOpens ~env ~rawOpens ~package = in opens -let getItems ~full ~package ~rawOpens ~allModules ~pos ~parts = +let getItems ~full ~package ~rawOpens ~allFiles ~pos ~parts = Log.log ("Opens folkz > " ^ string_of_int (List.length rawOpens) @@ -773,7 +773,7 @@ let getItems ~full ~package ~rawOpens ~allModules ~pos ~parts = in (* TODO complete the namespaced name too *) let localModuleNames = - allModules + allFiles |> Utils.filterMap (fun name -> if Utils.startsWith name suffix && not (String.contains name '-') then Some {(emptyDeclared name) with item = FileModule name} @@ -1148,10 +1148,10 @@ let computeCompletions ~uri ~textOpt ~pos = | Some full -> let rawOpens = PartialParser.findOpens text offset in let package = full.package in - let allModules = package.localModules @ package.dependencyModules in + let allFiles = package.projectFiles @ package.dependenciesFiles in let findItems ~exact parts = let items = - getItems ~full ~package ~rawOpens ~allModules ~pos ~parts + getItems ~full ~package ~rawOpens ~allFiles ~pos ~parts in match parts |> List.rev with | last :: _ when exact -> diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index e77738086..d095503b7 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,13 +1,12 @@ open Infix (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *) -let makePathsForModule (localModules : (string * SharedTypes.paths) list) - (dependencyModules : (string * SharedTypes.paths) list) = +let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths = let pathsForModule = Hashtbl.create 30 in - dependencyModules + dependenciesFilesAndPaths |> List.iter (fun (modName, paths) -> Hashtbl.replace pathsForModule modName paths); - localModules + projectFilesAndPaths |> List.iter (fun (modName, paths) -> Hashtbl.replace pathsForModule modName paths); pathsForModule @@ -19,53 +18,48 @@ let newBsPackage rootPath = | Some raw -> ( let config = Json.parse raw in Log.log {|📣 📣 NEW BSB PACKAGE 📣 📣|}; - (* failwith("Wat"); *) Log.log ("- location: " ^ rootPath); - let compiledBase = BuildSystem.getCompiledBase rootPath in - match FindFiles.findDependencyFiles ~debug:true rootPath config with + let libBs = BuildSystem.getLibBs rootPath in + match FindFiles.findDependencyFiles rootPath config with | Error e -> Error e - | Ok (dependencyDirectories, dependencyModules) -> ( - match compiledBase with + | Ok (dependencyDirectories, dependenciesFilesAndPaths) -> ( + match libBs with | None -> Error "Please run the build first so that the editor can analyze the \ project's artifacts." - | Some compiledBase -> + | Some libBs -> Ok (let namespace = FindFiles.getNamespace config in - let localSourceDirs = - FindFiles.getSourceDirectories ~includeDev:true rootPath config + let sourceDirectories = + FindFiles.getSourceDirectories ~includeDev:true ~baseDir:rootPath + config in Log.log - ("Got source directories " ^ String.concat " - " localSourceDirs); - let localModules = - FindFiles.findProjectFiles ~debug:true namespace rootPath - localSourceDirs compiledBase - (* - |> List.map(((name, paths)) => (switch (namespace) { - | None => name - | Some(n) => name ++ "-" ++ n }, paths)); *) + ("Got source directories " ^ String.concat " - " sourceDirectories); + let projectFilesAndPaths = + FindFiles.findProjectFiles ~namespace ~path:rootPath + ~sourceDirectories ~libBs in Log.log - ("-- All local modules found: " - ^ string_of_int (List.length localModules)); - localModules + ("-- All project files found: " + ^ string_of_int (List.length projectFilesAndPaths)); + projectFilesAndPaths |> List.iter (fun (name, paths) -> Log.log name; match paths with - | SharedTypes.Impl (cmt, _) -> Log.log ("impl " ^ cmt) - | Intf (cmi, _) -> Log.log ("intf " ^ cmi) + | SharedTypes.Impl {cmt} -> Log.log ("impl " ^ cmt) | _ -> Log.log "Both"); let pathsForModule = - makePathsForModule localModules dependencyModules + makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths in let opens_from_namespace = match namespace with | None -> [] | Some namespace -> - let cmt = Filename.concat compiledBase namespace ^ ".cmt" in + let cmt = Filename.concat libBs namespace ^ ".cmt" in Log.log ("############ Namespaced as " ^ namespace ^ " at " ^ cmt); - Hashtbl.add pathsForModule namespace (Impl (cmt, None)); + Hashtbl.add pathsForModule namespace (Namespace {cmt}); [FindFiles.nameSpaceToName namespace] in Log.log ("Dependency dirs " ^ String.concat " " dependencyDirectories); @@ -88,17 +82,13 @@ let newBsPackage rootPath = List.rev_append opens_from_bsc_flags opens_from_namespace in Log.log ("Opens from bsconfig: " ^ (opens |> String.concat " ")); - let interModuleDependencies = - Hashtbl.create (List.length localModules) - in { SharedTypes.rootPath; - localModules = localModules |> List.map fst; - dependencyModules = dependencyModules |> List.map fst; + projectFiles = projectFilesAndPaths |> List.map fst; + dependenciesFiles = dependenciesFilesAndPaths |> List.map fst; pathsForModule; opens; namespace; - interModuleDependencies; }))) let findRoot ~uri packagesByRoot = diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 3cd852b66..e5b372827 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -1246,14 +1246,9 @@ let getFullFromCmt ~uri = BuildSystem.namespacedName package.namespace (FindFiles.getName path) in match Hashtbl.find_opt package.pathsForModule moduleName with - | Some paths -> ( + | Some paths -> let cmt = SharedTypes.getCmt ~interface:(Utils.endsWith path "i") paths in - match fullForCmt ~moduleName ~package ~uri cmt with - | None -> None - | Some full -> - Hashtbl.replace package.interModuleDependencies moduleName - (SharedTypes.hashList full.extra.externalReferences |> List.map fst); - Some full) + fullForCmt ~moduleName ~package ~uri cmt | None -> prerr_endline ("can't find module " ^ moduleName); None) @@ -1261,9 +1256,8 @@ let getFullFromCmt ~uri = let extraForModule ~package modname = if Hashtbl.mem package.pathsForModule modname then let paths = Hashtbl.find package.pathsForModule modname in - match SharedTypes.getSrc paths with - | None -> None - | Some src -> getFullFromCmt ~uri:(Uri2.fromPath src) + let uri = SharedTypes.getUri paths in + getFullFromCmt ~uri else None let fileForCmt ~moduleName ~cmt ~uri state = @@ -1291,12 +1285,8 @@ let fileForModule modname ~package = if Hashtbl.mem package.pathsForModule modname then ( let paths = Hashtbl.find package.pathsForModule modname in (* TODO: do better *) - let cmt = SharedTypes.getCmt paths in - let uri = - match SharedTypes.getSrc paths with - | Some sourcePath -> Uri2.fromPath sourcePath - | None -> Uri2.fromPath cmt - in + let cmt = SharedTypes.getCmt ~interface:false paths in + let uri = SharedTypes.getUri paths in Log.log ("FINDING docs for module " ^ SharedTypes.showPaths paths); Log.log ("FINDING " ^ cmt ^ " uri " ^ Uri2.toString uri); match fileForCmt ~moduleName:modname ~cmt ~uri state with diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 5d76caf48..3da82433e 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -188,12 +188,12 @@ let alternateDeclared ~(file : File.t) ~package declared tip = | Some paths -> ( maybeLog ("paths for " ^ file.moduleName); match paths with - | IntfAndImpl (_, intf, _, impl) -> ( + | IntfAndImpl {resi; res} -> ( maybeLog "Have both!!"; - let intfUri = Uri2.fromPath intf in - let implUri = Uri2.fromPath impl in - if intfUri = file.uri then - match ProcessCmt.getFullFromCmt ~uri:implUri with + let resiUri = Uri2.fromPath resi in + let resUri = Uri2.fromPath res in + if resiUri = file.uri then + match ProcessCmt.getFullFromCmt ~uri:resUri with | None -> None | Some {file; extra} -> ( match @@ -203,7 +203,7 @@ let alternateDeclared ~(file : File.t) ~package declared tip = | None -> None | Some declared -> Some (file, extra, declared)) else - match ProcessCmt.getFullFromCmt ~uri:intfUri with + match ProcessCmt.getFullFromCmt ~uri:resiUri with | None -> None | Some {file; extra} -> ( match @@ -305,13 +305,6 @@ let definition ~file ~package stamp tip = maybeLog ("Inner uri " ^ Uri2.toString uri); Some (uri, loc)) -let orLog message v = - match v with - | None -> - maybeLog message; - None - | _ -> v - let definitionForLocItem ~full:{file; package} locItem = match locItem.locType with | Typed (_, _, Definition (stamp, tip)) -> ( @@ -335,13 +328,11 @@ let definitionForLocItem ~full:{file; package} locItem = None | TopLevelModule name -> ( maybeLog ("Toplevel " ^ name); - let open Infix in - match - Hashtbl.find_opt package.pathsForModule name - |> orLog "No paths found" |?> getSrc |> orLog "No src found" - with + match Hashtbl.find_opt package.pathsForModule name with | None -> None - | Some src -> Some (Uri2.fromPath src, Utils.topLoc src)) + | Some paths -> + let uri = getUri paths in + Some (uri, Utils.topLoc (Uri2.toPath uri))) | LModule (LocalReference (stamp, tip)) | Typed (_, _, LocalReference (stamp, tip)) -> maybeLog ("Local defn " ^ tipToString tip); @@ -435,7 +426,7 @@ let forLocalStamp ~full:{file; extra; package} stamp tip = maybeLog ("Now checking path " ^ pathToString path); let thisModuleName = file.moduleName in let externals = - package.localModules + package.projectFiles |> List.filter (fun name -> name <> file.moduleName) |> Utils.filterMap (fun name -> match ProcessCmt.fileForModule ~package name with diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 55a145f6f..ca5ebeddf 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -114,29 +114,33 @@ end type filePath = string type paths = - | Impl of filePath * filePath option - | Intf of filePath * filePath - (* .cm(t)i, .mli, .cmt, .rei *) - | IntfAndImpl of filePath * filePath * filePath * filePath - -open Infix + | Impl of {cmt : filePath; res : filePath} + | Namespace of {cmt : filePath} + | IntfAndImpl of { + cmti : filePath; + resi : filePath; + cmt : filePath; + res : filePath; + } let showPaths paths = match paths with - | Impl (cmt, src) -> Printf.sprintf "Impl(%s, %s)" cmt (src |? "nil") - | Intf (cmti, src) -> Printf.sprintf "Intf(%s, %s)" cmti src - | IntfAndImpl (cmti, srci, cmt, src) -> - Printf.sprintf "IntfAndImpl(%s, %s, %s, %s)" cmti srci cmt src + | Impl {cmt; res} -> Printf.sprintf "Impl(%s, %s)" cmt res + | Namespace {cmt} -> Printf.sprintf "Namespace(%s)" cmt + | IntfAndImpl {cmti; resi; cmt; res} -> + Printf.sprintf "IntfAndImpl(%s, %s, %s, %s)" cmti resi cmt res -let getSrc p = +let getUri p = match p with - | Impl (_, s) -> s - | Intf (_, s) | IntfAndImpl (_, s, _, _) -> Some s + | Impl {res} -> Uri2.fromPath res + | Namespace {cmt} -> Uri2.fromPath cmt + | IntfAndImpl {resi} -> Uri2.fromPath resi -let getCmt ?(interface = true) p = +let getCmt ~interface p = match p with - | Impl (c, _) | Intf (c, _) -> c - | IntfAndImpl (cint, _, cimpl, _) -> if interface then cint else cimpl + | Impl {cmt} -> cmt + | Namespace {cmt} -> cmt + | IntfAndImpl {cmti; cmt} -> if interface then cmti else cmt let emptyDeclared name = { @@ -201,14 +205,13 @@ type extra = { opens : (Location.t, openTracker) Hashtbl.t; } -type moduleName = string +type file = string type package = { rootPath : filePath; - localModules : moduleName list; - interModuleDependencies : (moduleName, moduleName list) Hashtbl.t; - dependencyModules : moduleName list; - pathsForModule : (moduleName, paths) Hashtbl.t; + projectFiles : file list; + dependenciesFiles : file list; + pathsForModule : (file, paths) Hashtbl.t; namespace : string option; opens : string list; } @@ -238,8 +241,6 @@ let state = cmtCache = Hashtbl.create 30; } -let hashList h = Hashtbl.fold (fun a b c -> (a, b) :: c) h [] - let locKindToString = function | LocalReference (_, tip) -> "(LocalReference " ^ tipToString tip ^ ")" | GlobalReference _ -> "GlobalReference"