Add import validation graders for checking required and allowed imports

.github/workflows/ci.yml

@@ -41,6 +41,10 @@ jobs:
         working-directory: pkgs/core
         run: pnpm run integration:tower
 
+      - name: (core) imports integration test
+        working-directory: pkgs/core
+        run: pnpm run integration:imports
+
   nix:
     strategy:
       fail-fast: false

pkgs/core/package.json

@@ -15,6 +15,7 @@
     "integration:gcd": "pnpm run pyret-trove -- -p tests/integration/inspect-gcd.arr",
     "integration:fold": "pnpm run pyret-trove -- -p tests/integration/inspect-fold.arr",
     "integration:tower": "pnpm run pyret-trove -- -p tests/integration/inspect-tower.arr",
+    "integration:imports": "pnpm run pyret-trove -- -p tests/integration/inspect-imports.arr",
     "clean": "rm -rf -- ./pyret"
   },
   "dependencies": {

pkgs/core/src/graders/imports.arr

@@ -0,0 +1,195 @@
+import file("../core.arr") as C
+import file("../grading.arr") as G
+import file("../grading-builders.arr") as GB
+import file("../common/ast.arr") as CA
+import file("../common/markdown.arr") as MD
+
+import ast as A
+
+include either
+include from C:
+  type Id
+end
+
+provide:
+  data ImportRequiredBlock,
+  data ImportAllowlistBlock,
+  mk-import-required,
+  mk-import-allowlist,
+  check-import-required as _check-import-required,
+  check-import-allowlist as _check-import-allowlist,
+  fmt-import-required as _fmt-import-required,
+  fmt-import-allowlist as _fmt-import-allowlist
+end
+
+# --- Shared helpers ---
+
+fun get-imports(path :: String):
+  cases (Either) CA.parse-path(path):
+    | left(err) => left(err)
+    | right(ast) =>
+      cases (A.Program) ast:
+        | s-program(_, _, _, _, _, imports, _) => right(imports)
+      end
+  end
+end
+
+fun import-module-name(imp) -> Option<String>:
+  doc: ```
+  Extract the module name string from an import or include AST node.
+  Returns none for import forms we don't recognize (e.g. file imports).
+  ```
+  fun import-type-name(it):
+    cases (A.ImportType) it:
+      | s-const-import(_, mod) => some(mod)
+      | else => none
+    end
+  end
+  ask:
+    | A.is-s-import(imp) then: import-type-name(imp.file)
+    | A.is-s-include(imp) then: import-type-name(imp.mod)
+    | A.is-s-import-fields(imp) then: import-type-name(imp.file)
+    | otherwise: none
+  end
+end
+
+fun import-binding-name(imp) -> Option<String>:
+  doc: ```
+  Extract the binding name from an import AST node.
+  Returns none for include statements (which don't bind to a name).
+  ```
+  ask:
+    | A.is-s-import(imp) then:
+      cases (A.Name) imp.name:
+        | s-name(_, s) => some(s)
+        | else => none
+      end
+    | otherwise: none
+  end
+end
+
+# --- Guard 1: Import Required ---
+
+data ImportRequiredBlock:
+  | ir-parser-error(err :: CA.ParsePathErr)
+  | import-not-found(module-name :: String)
+  | wrong-binding(module-name :: String, expected :: String, actual :: String)
+end
+
+fun check-import-required(
+  path :: String,
+  module-name :: String,
+  binding :: Option<String>
+) -> Option<ImportRequiredBlock>:
+  cases (Either) get-imports(path):
+    | left(err) => some(ir-parser-error(err))
+    | right(imports) =>
+      matching = imports.filter(lam(imp):
+        import-module-name(imp) == some(module-name)
+      end)
+      cases (List) matching:
+        | empty => some(import-not-found(module-name))
+        | link(first, _) =>
+          cases (Option) binding:
+            | none => none
+            | some(expected-binding) =>
+              actual = import-binding-name(first)
+              cases (Option) actual:
+                | none => none
+                | some(actual-binding) =>
+                  if actual-binding == expected-binding:
+                    none
+                  else:
+                    some(wrong-binding(module-name, expected-binding, actual-binding))
+                  end
+              end
+          end
+      end
+  end
+end
+
+fun fmt-import-required(reason :: ImportRequiredBlock) -> GB.ComboAggregate:
+  student = cases (ImportRequiredBlock) reason:
+    | ir-parser-error(_) =>
+      "Cannot check your imports because we cannot parse your file."
+    | import-not-found(mod) =>
+      "Cannot find an import for module " + MD.escape-inline-code(mod) +
+      ". Make sure you have `import " + MD.escape-inline-code(mod) +
+      " as ...` at the top of your file."
+    | wrong-binding(mod, expected, actual) =>
+      "Module " + MD.escape-inline-code(mod) +
+      " is imported as " + MD.escape-inline-code(actual) +
+      ", but it should be imported as " + MD.escape-inline-code(expected) + "."
+  end ^ G.output-markdown
+  staff = none
+  {student; staff}
+end
+
+fun mk-import-required(
+  id :: Id,
+  deps :: List<Id>,
+  path :: String,
+  module-name :: String,
+  binding :: Option<String>
+):
+  name = "Required import " + module-name
+  checker = lam(): check-import-required(path, module-name, binding) end
+  GB.mk-guard(id, deps, checker, name, fmt-import-required)
+end
+
+# --- Guard 2: Import Allowlist ---
+
+data ImportAllowlistBlock:
+  | ia-parser-error(err :: CA.ParsePathErr)
+  | forbidden-imports(names :: List<String>, allowed :: List<String>)
+end
+
+fun check-import-allowlist(
+  path :: String,
+  allowed :: List<String>
+) -> Option<ImportAllowlistBlock>:
+  cases (Either) get-imports(path):
+    | left(err) => some(ia-parser-error(err))
+    | right(imports) =>
+      forbidden = imports
+        .map(import-module-name)
+        .filter(is-some)
+        .map(lam(s): s.value end)
+        .filter(lam(mod): not(allowed.member(mod)) end)
+      if forbidden.length() == 0:
+        none
+      else:
+        some(forbidden-imports(forbidden, allowed))
+      end
+  end
+end
+
+fun fmt-import-allowlist(reason :: ImportAllowlistBlock) -> GB.ComboAggregate:
+  student = cases (ImportAllowlistBlock) reason:
+    | ia-parser-error(_) =>
+      "Cannot check your imports because we cannot parse your file."
+    | forbidden-imports(names, allowed) =>
+      forbidden-str = names
+        .map(MD.escape-inline-code)
+        .join-str(", ")
+      allowed-str = allowed
+        .map(MD.escape-inline-code)
+        .join-str(", ")
+      "Your program imports modules that are not allowed for this assignment: "
+        + forbidden-str + ". "
+        + "Only the following modules are permitted: " + allowed-str + "."
+  end ^ G.output-markdown
+  staff = none
+  {student; staff}
+end
+
+fun mk-import-allowlist(
+  id :: Id,
+  deps :: List<Id>,
+  path :: String,
+  allowed :: List<String>
+):
+  name = "Allowed imports"
+  checker = lam(): check-import-allowlist(path, allowed) end
+  GB.mk-guard(id, deps, checker, name, fmt-import-allowlist)
+end

pkgs/core/src/graders/main.arr

@@ -25,6 +25,7 @@ import file("./const-def.arr") as const-def
 import file("./test-diversity.arr") as test-diversity
 import file("./training-wheels.arr") as training-wheels
 import file("./image-artifact.arr") as image-artifact
+import file("./imports.arr") as imports
 
 # NOTE: only provides the functions, everything else should be an
 # implementation detail and can be imported directly from the module
@@ -38,3 +39,4 @@ provide from const-def: * end
 provide from test-diversity: * end
 provide from training-wheels: * end
 provide from image-artifact: * end
+provide from imports: * end

pkgs/core/tests/examples/double-grading/wheat.arr

@@ -0,0 +1,3 @@
+fun double(x):
+  x * 2
+end

pkgs/core/tests/examples/double.arr

@@ -0,0 +1,8 @@
+import image as I
+
+fun double(x):
+  x * 2
+where:
+  double(3) is 6
+  double(0) is 0
+end

pkgs/core/tests/files/has-imports.arr

@@ -0,0 +1,4 @@
+import tables as T
+import image as I
+
+1 + 1

pkgs/core/tests/files/no-imports.arr

@@ -0,0 +1 @@
+fun double(x): x * 2 end

pkgs/core/tests/graders/imports.arr

@@ -0,0 +1,61 @@
+import file("../meta/path-utils.arr") as P
+include file("../../src/graders/imports.arr")
+import file("../../src/common/ast.arr") as CA
+
+check-import-required = _check-import-required
+check-import-allowlist = _check-import-allowlist
+fmt-import-required = _fmt-import-required
+fmt-import-allowlist = _fmt-import-allowlist
+
+check "import-required: found with correct binding":
+  check-import-required(P.file("has-imports.arr"), "tables", some("T")) is none
+  check-import-required(P.file("has-imports.arr"), "image", some("I")) is none
+end
+
+check "import-required: found with any binding":
+  check-import-required(P.file("has-imports.arr"), "tables", none) is none
+  check-import-required(P.file("has-imports.arr"), "image", none) is none
+end
+
+check "import-required: not found":
+  check-import-required(P.file("has-imports.arr"), "math", none)
+    is some(import-not-found("math"))
+  check-import-required(P.file("no-imports.arr"), "tables", none)
+    is some(import-not-found("tables"))
+end
+
+check "import-required: wrong binding":
+  check-import-required(P.file("has-imports.arr"), "tables", some("Tbl"))
+    is some(wrong-binding("tables", "Tbl", "T"))
+end
+
+check "import-allowlist: all allowed":
+  check-import-allowlist(P.file("has-imports.arr"), [list: "tables", "image"]) is none
+  check-import-allowlist(P.file("has-imports.arr"), [list: "tables", "image", "math"]) is none
+end
+
+check "import-allowlist: no imports":
+  check-import-allowlist(P.file("no-imports.arr"), [list: "tables"]) is none
+  check-import-allowlist(P.file("no-imports.arr"), [list:]) is none
+end
+
+check "import-allowlist: forbidden":
+  result = check-import-allowlist(P.file("has-imports.arr"), [list: "tables"])
+  result is some(forbidden-imports([list: "image"], [list: "tables"]))
+end
+
+check "import-allowlist: all forbidden":
+  result = check-import-allowlist(P.file("has-imports.arr"), [list:])
+  result is some(forbidden-imports([list: "tables", "image"], [list:]))
+end
+
+check "fmt-import-required: smoke":
+  fmt-import-required(ir-parser-error(CA.path-doesnt-exist("/invalid.arr"))) does-not-raise
+  fmt-import-required(import-not-found("tables")) does-not-raise
+  fmt-import-required(wrong-binding("tables", "T", "Tbl")) does-not-raise
+end
+
+check "fmt-import-allowlist: smoke":
+  fmt-import-allowlist(ia-parser-error(CA.path-doesnt-exist("/invalid.arr"))) does-not-raise
+  fmt-import-allowlist(forbidden-imports([list: "image"], [list: "tables"])) does-not-raise
+end

pkgs/core/tests/graders/main.arr

@@ -22,3 +22,4 @@ import file("./const-def.arr") as _
 import file("./test-diversity.arr") as _
 import file("./training-wheels.arr") as _
 import file("./image-artifact.arr") as _
+import file("./imports.arr") as _

pkgs/core/tests/integration/inspect-imports.arr

@@ -0,0 +1,34 @@
+import file("../meta/path-utils.arr") as P
+include file("../meta/inspect-grade.arr")
+include file("../../src/main.arr")
+include file("../../src/tools/main.arr")
+
+student-path = P.example("double.arr")
+wheat-path = P.example("double-grading/wheat.arr")
+
+graders =
+  [list:
+    mk-well-formed("wf", [list:], student-path),
+    mk-import-required(
+      "import-image",
+      [list: "wf"],
+      student-path, "image", some("I")
+    ),
+    mk-fn-def(
+      "double-defined",
+      [list: "import-image"],
+      student-path, "double", 1
+    ),
+    mk-wheat(
+      "double-wheat",
+      [list: "double-defined"],
+      student-path, wheat-path, "double",
+      1
+    )
+  ]
+
+result = inspect-grade(graders, true, false)
+
+check "aggregate-to-flat smoke":
+  grading-helpers.aggregate-to-flat(result.aggregated) does-not-raise
+end