Parse records and keyed collection queries

test/test_main.ml

@@ -180,10 +180,104 @@ let parse_cases =
           (match parsed.Syntax.e with Syntax.EInt 7 -> true | _ -> false) );
   ]
 
+let root () = try Sys.getenv "DELTA_ROOT" with Not_found -> "."
+
+let fixture name = Filename.concat (root ()) (Filename.concat "test/fixtures" name)
+
+let read_fixture name = Native.read_file (fixture name)
+
+let program_error text =
+  try
+    ignore (Parse.program text);
+    None
+  with Diagnostic.Error diagnostic -> Some diagnostic
+
+let program_cases =
+  [
+    ( "the required example parses into declarations",
+      fun () ->
+        let parsed = Parse.program (read_fixture "expensive_order.delta") in
+        check_equal_int "one record declaration" 1 (List.length parsed.Syntax.prog_records);
+        let record = List.hd parsed.Syntax.prog_records in
+        check_equal_string "record name" "order" record.Syntax.rd_name;
+        check_equal_int "two fields" 2 (List.length record.Syntax.rd_fields);
+        check_equal_string "input name" "orders" parsed.Syntax.prog_input.Syntax.in_name;
+        check_equal_string "input type" "collection order"
+          (Syntax.string_of_tyexpr parsed.Syntax.prog_input.Syntax.in_ty);
+        check_equal_int "one helper" 1 (List.length parsed.Syntax.prog_helpers);
+        let helper = List.hd parsed.Syntax.prog_helpers in
+        check_equal_string "helper name" "tax" helper.Syntax.h_name;
+        check_equal_int "one parameter" 1 (List.length helper.Syntax.h_params);
+        check_equal_string "query name" "expensive_orders" parsed.Syntax.prog_query.Syntax.q_name );
+    ( "a query pipeline of filter and map is right nested",
+      fun () ->
+        let parsed = Parse.program (read_fixture "expensive_order.delta") in
+        match parsed.Syntax.prog_query.Syntax.q_body.Syntax.e with
+        | Syntax.EApp (mapper, upstream) ->
+            check "outer operator is map" (match mapper.Syntax.e with Syntax.EMap _ -> true | _ -> false);
+            check "upstream is a filter" (match upstream.Syntax.e with Syntax.EApp (f, _) -> (match f.Syntax.e with Syntax.EFilter _ -> true | _ -> false) | _ -> false)
+        | _ -> fail "shape" "expected a pipeline application" );
+    ( "sum and count parse as collection operators",
+      fun () ->
+        let parsed = Parse.program (read_fixture "revenue.delta") in
+        check "sum query is an application of sum"
+          (match parsed.Syntax.prog_query.Syntax.q_body.Syntax.e with
+          | Syntax.EApp (sum, _) -> (match sum.Syntax.e with Syntax.ESum -> true | _ -> false)
+          | _ -> false);
+        let parsed = Parse.program (read_fixture "count_large.delta") in
+        check "count query is an application of count"
+          (match parsed.Syntax.prog_query.Syntax.q_body.Syntax.e with
+          | Syntax.EApp (count, _) -> (match count.Syntax.e with Syntax.ECount -> true | _ -> false)
+          | _ -> false) );
+    ( "a trailing semicolon in a record declaration is accepted",
+      fun () ->
+        let parsed =
+          Parse.program "type row = { a : int; b : string; }\ninput rows : collection row\nquery q = rows\n"
+        in
+        check_equal_int "two fields" 2 (List.length (List.hd parsed.Syntax.prog_records).Syntax.rd_fields) );
+    ( "declarations may appear in any order",
+      fun () ->
+        let parsed =
+          Parse.program "query q = rows\nlet f n = n\ninput rows : collection row\ntype row = { a : int }\n"
+        in
+        check_equal_string "input" "rows" parsed.Syntax.prog_input.Syntax.in_name );
+    ( "a program without an input is rejected",
+      fun () ->
+        match program_error "query q = 1\n" with
+        | None -> fail "input" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message"
+              "the program declares no input collection: add `input NAME : collection T`"
+              diagnostic.Diagnostic.message );
+    ( "a program without a query is rejected",
+      fun () ->
+        match program_error "input rows : collection row\ntype row = { a : int }\n" with
+        | None -> fail "query" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "<none>: error: the program declares no query: add `query NAME = EXPRESSION`"
+              (Diagnostic.to_string diagnostic) );
+    ( "a second input declaration points at the offending one",
+      fun () ->
+        match program_error "input a : collection int\ninput b : collection int\nquery q = a\n" with
+        | None -> fail "input" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "program.delta:2:1: error: the program declares more than one input collection"
+              (Diagnostic.to_string { diagnostic with Diagnostic.file = "program.delta" }) );
+    ( "a malformed record declaration reports a span",
+      fun () ->
+        match program_error "type row = { a int }\n" with
+        | None -> fail "record" "expected a diagnostic"
+        | Some diagnostic ->
+            check "diagnostic points at line 1"
+              (diagnostic.Diagnostic.span.Location.start.Location.line = 1);
+            check "message is non empty" (String.length diagnostic.Diagnostic.message > 0) );
+  ]
+
 let () =
   Test_harness.run_suite "location" location_cases;
   Test_harness.run_suite "ident" ident_cases;
   Test_harness.run_suite "diagnostic" diagnostic_cases;
   Test_harness.run_suite "parse" parse_cases;
+  Test_harness.run_suite "program" program_cases;
   Printf.printf "%d cases, %d failures\n" (Test_harness.case_count ()) (Test_harness.failure_count ());
   exit (if Test_harness.failure_count () = 0 then 0 else 1)