[SDK-268] Parses imports contained in a module (#558)

* adds a parser that extracts imports from a module header

* parses module header before suggesting imports

* use import syntax in stdlib

* adds the prelude to the env before chasing imports for completions

src/.gitignore

@@ -2,6 +2,7 @@
 /asc
 /as-ld
 /as-id
+/as-ide
 /asc.js
 /didc
 

src/languageServer/completion.ml

@@ -45,7 +45,7 @@ let make_index (): completion_index =
   let (libraries, scope) =
     Diag.run
       (Pipeline.chase_imports
-         Scope.empty
+         Pipeline.initial_stat_env
          (Pipeline__.Resolve_import.S.of_list (lib_files ()))) in
   Type.Env.fold
     (fun path ty acc ->
@@ -65,13 +65,43 @@ let string_of_index index =
          ^ string_of_list string_of_ide_decl decls
          ^ "\n")
 
+let import_relative_to_project_root root module_path dependency =
+  match Pipeline__.File_path.relative_to root module_path with
+  | None -> None
+  | Some root_to_module ->
+     root_to_module
+     |> Filename.dirname
+     |> Base.Fn.flip Filename.concat dependency
+     |> Pipeline__.File_path.normalise
+     |> Lib.Option.some
+
 (* Given the source of a module, figure out under what names what
    modules have been imported. Normalizes the imported modules
    filepaths relative to the project root *)
-let find_imported_modules file =
-  [ ("List", "lib/ListLib.as")
-  ; ("ListFns", "lib/ListFuncs.as")
-  ]
+let parse_module_header project_root current_file_path file =
+  let lexbuf = Lexing.from_string file in
+  let next () = Lexer.token Lexer.Normal lexbuf in
+  let res = ref [] in
+  let rec loop = function
+    | Parser.IMPORT ->
+       (match next () with
+        | Parser.ID alias ->
+           (match next () with
+            | Parser.TEXT path ->
+               let path =
+                 import_relative_to_project_root
+                   project_root
+                   current_file_path
+                   path in
+               (match path with
+                | Some path -> res := (alias, path) :: !res
+                | None -> ());
+               loop (next ())
+            | tkn -> loop tkn)
+        | tkn -> loop tkn)
+    | Parser.EOF -> List.rev !res
+    | tkn -> loop (next ()) in
+  loop (next ())
 
 (* Given a source file and a cursor position in that file, figure out
    the prefix relevant to searching completions. For example, given:
@@ -94,14 +124,6 @@ let find_completion_prefix logger file line column =
             | Parser.EOF -> Some ident
             | tkn ->
                let next_token_start = (Lexer.region lexbuf).Source.left in
-               let _ =
-                 logger
-                   "completion_prefix"
-                   (Printf.sprintf
-                      "%d:%d::%s\n"
-                      next_token_start.Source.line
-                      next_token_start.Source.column
-                      ident) in
                if pos_past_cursor next_token_start
                then Some ident
                else loop tkn)
@@ -112,10 +134,10 @@ let find_completion_prefix logger file line column =
 
 (* TODO(Christoph): Don't recompute the index whenever completions are
    requested *)
-let completions (* index *) logger file line column =
+let completions (* index *) logger project_root file_path file_contents line column =
   let index = make_index () in
-  let imported = find_imported_modules file in
-  match find_completion_prefix logger file line column with
+  let imported = parse_module_header project_root file_path file_contents in
+  match find_completion_prefix logger file_contents line column with
   | None ->
      imported
      |> List.map (fun (alias, _) -> alias, None)
@@ -137,11 +159,15 @@ let completions (* index *) logger file line column =
      | None ->
         [ (("ERROR: Couldn't find module for prefix: " ^ prefix), None) ]
 
-let completion_handler logger file position =
+let completion_handler logger project_root file_path file_contents position =
   let line = position.Lsp_t.position_line in
   let column = position.Lsp_t.position_character in
   let completion_item (lbl, detail) =
     Lsp_t.{ completion_item_label = lbl
           ; completion_item_detail = detail } in
   `CompletionResponse
-    (List.map completion_item (completions logger file line column))
+    (List.map completion_item
+       (completions logger project_root file_path file_contents line column))
+
+let test_completion () =
+  Printf.printf "%s\n" (string_of_index (make_index ()))

src/languageServer/completion_test.ml

@@ -22,6 +22,39 @@ let prefix_test_case file expected =
     Completion.find_completion_prefix dummy_logger file line column in
   Base.Option.equal String.equal prefix expected
 
+let import_relative_test_case root module_path import expected =
+  let actual =
+    Completion.import_relative_to_project_root root module_path import in
+  let show = function
+    | None -> "None"
+    | Some s -> "Some " ^ s in
+    if Base.Option.equal Base.String.equal actual expected
+    then true
+    else
+      (Printf.printf
+         "\nExpected: %s\nActual:   %s\n"
+         (show expected)
+         (show actual);
+       false)
+
+let parse_module_header_test_case project_root current_file file expected =
+  let actual =
+    Completion.parse_module_header
+      project_root
+      current_file file in
+  let display_result (alias, path) = Printf.sprintf "%s => \"%s\"" alias path in
+  let result = Base.List.equal
+    actual
+    expected
+    ~equal:(fun (x, y) (x', y') ->
+      String.equal x x' && String.equal y y' ) in
+  if not result then
+    Printf.printf
+      "\nExpected: %s\nActual:   %s"
+      (Completion.string_of_list display_result expected)
+      (Completion.string_of_list display_result actual) else ();
+  result
+
 
 let%test "it finds a simple prefix" =
   prefix_test_case "List.|" (Some "List")
@@ -68,3 +101,57 @@ func singleton(x : Int) : Stack =
   List.we|
   ListFns.singleton<Int>(x);
 }|} None
+
+let%test "it makes an import relative to the project root" =
+  import_relative_test_case
+    "/home/project"
+    "/home/project/src/main.as"
+    "lib/List.as"
+    (Some "src/lib/List.as")
+
+let%test "it preserves trailing slashes for directory imports" =
+  import_relative_test_case
+    "/home/project"
+    "/home/project/src/main.as"
+    "lib/List/"
+    (Some "src/lib/List/")
+
+let%test "it can handle parent directory relationships" =
+  import_relative_test_case
+    "/home/project"
+    "/home/project/src/main.as"
+    "../lib/List.as"
+    (Some "lib/List.as")
+
+let%test "it parses a simple module header" =
+  parse_module_header_test_case
+    "/project"
+    "/project/src/Main.as"
+    "import P \"lib/prelude.as\""
+    ["P", "src/lib/prelude.as"]
+
+let%test "it parses a simple module header" =
+  parse_module_header_test_case
+    "/project"
+    "/project/Main.as"
+    {|
+module {
+
+private import List "lib/ListLib.as";
+private import ListFuncs "lib/ListFuncs.as";
+
+type Stack = List.List<Int>;
+
+func push(x: Int, s: Stack): Stack =
+  List.cons<Int>(x, s);
+
+func empty(): Stack =
+  List.nil<Int>();
+
+func singleton(x: Int): Stack =
+  ListFuncs.doubleton<Int>(x, x);
+}
+|}
+    [ ("List", "lib/ListLib.as")
+    ; ("ListFuncs", "lib/ListFuncs.as")
+    ]

src/languageServer/languageServer.ml

@@ -95,6 +95,12 @@ let file_from_uri logger uri =
    | None ->
       let _ = logger "error" ("Failed to strip filename from: " ^ uri) in
       uri
+let abs_file_from_uri logger uri =
+  match Base.String.chop_prefix ~prefix:"file://" uri with
+   | Some file -> file
+   | None ->
+      let _ = logger "error" ("Failed to strip filename from: " ^ uri) in
+      uri
 
 let start () =
   let oc: out_channel = open_out_gen [Open_append; Open_creat] 0o666 "ls.log"; in
@@ -105,6 +111,7 @@ let start () =
   let show_message = Channel.show_message oc in
 
   let client_capabilities = ref None in
+  let project_root = Sys.getcwd () in
 
   let vfs = ref Vfs.empty in
 
@@ -200,7 +207,12 @@ let start () =
               Lsp_t.{ code = 1
                     ; message = "Tried to find completions for a file that hadn't been opened yet"}
          | Some file_content ->
-            Completion.completion_handler log_to_file file_content position
+            Completion.completion_handler
+              log_to_file
+              project_root
+              (abs_file_from_uri log_to_file uri)
+              file_content
+              position
             |> response_result_message id in
        response
        |> Lsp_j.string_of_response_message

src/pipeline/pipeline.mli

@@ -22,6 +22,7 @@ end
 val check_files  : string list -> unit Diag.result
 val check_string : string -> string -> unit Diag.result
 
+val initial_stat_env : Scope.scope
 val chase_imports : Scope.scope -> Resolve_import.S.t ->
   (Syntax.libraries * Scope.scope) Diag.result
 

stdlib/assocList.as

@@ -10,7 +10,7 @@ Implements the same interface as `Trie`, but as a linked-list of key-value pairs
 
 */
 
-private let List = import "list.as";
+private import List "list.as";
 
 // polymorphic association linked lists between keys and values
 type AssocList<K,V> = List.List<(K,V)>;

stdlib/docTable.as

@@ -43,11 +43,11 @@ type information.
 
  */
 
-let Hash = import "hash.as";
+private import Hash "hash.as";
 type Hash = Hash.Hash;
 
-//let Trie = import "trie.as";
-let Trie = import "trie2.as";
+//import Trie "trie.as";
+private import Trie "trie2.as";
 type Trie<K,V> = Trie.Trie<K,V>;
 type Key<K> = Trie.Key<K>;
 

stdlib/listTest.as

@@ -1,5 +1,5 @@
 type X = Nat;
-let List = import "list.as";
+import List "list.as";
 
   func opnatEq(a : ?Nat, b : ?Nat) : Bool {
     switch (a, b) {

stdlib/option.as

@@ -5,7 +5,7 @@ Functions for Option types.
 
 */
 
-let P = (import "prelude.as");
+private import P "prelude.as";
 
 type t<A> = ?A;
 

stdlib/result.as

@@ -1,5 +1,5 @@
 module {
-private let P = (import "prelude.as");
+private import P "prelude.as";
 
 /**
 

stdlib/set.as

@@ -1,5 +1,5 @@
 /**
- 
+
  Sets
  ========
 
@@ -17,9 +17,9 @@
    in the future, we might avoid this via https://dfinity.atlassian.net/browse/AST-32
 
 */
-
-let Trie = import "trie2.as";
-let Hash = import "hash.as";
+module {
+private import Trie "trie2.as";
+private import Hash "hash.as";
 
 type Hash = Hash.Hash;
 type Set<T> = Trie.Trie<T,()>;
@@ -75,3 +75,4 @@ type Set<T> = Trie.Trie<T,()>;
   };
 
   func unitEq (_:(),_:()):Bool{ true };
+}

stdlib/trie.as

@@ -61,13 +61,14 @@ See the full details in the definitions below:
 
 */
 
-let Hash = (import "hash.as").BitVec;
+private import H "hash.as";
+let Hash = H.BitVec;
 type Hash = Hash.t;
 
-let List = import "list.as";
+private import List "list.as";
 type List<T> = List.List<T>;
 
-let AssocList = import "assocList.as";
+private import AssocList "assocList.as";
 type AssocList<K,V> = AssocList.AssocList<K,V>;
 
 let HASH_BITS = 4;

stdlib/trie2.as

@@ -73,17 +73,18 @@ let MAX_LEAF_COUNT = 8; // <-- beats both 4 and 16 for me, now
 //let MAX_LEAF_COUNT = 16;
 //let MAX_LEAF_COUNT = 32;
 
-let P = (import "prelude.as");
+private import P "prelude.as";
 
-let Option = import "option.as";
+private import Option "option.as";
 
-let Hash = (import "hash.as").BitVec;
+private import H "hash.as";
+let Hash = H.BitVec;
 type Hash = Hash.t;
 
-let List = import "list.as";
+private import List "list.as";
 type List<T> = List.List<T>;
 
-let AssocList = import "assocList.as";
+private import AssocList "assocList.as";
 type AssocList<K,V> = AssocList.AssocList<K,V>;
 
 /** A `Key` for the trie has an associated hash value */