From 87e816306d3a418e824387a6007cef23f1980391 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Wed, 26 May 2021 23:27:55 +0200
Subject: [PATCH] Better import failure error reporting

---
 .../bin/preserves-schema-rkt.rkt              | 10 +++-------
 .../preserves/preserves-schema/compiler.rkt   | 20 ++++++++++++-------
 .../preserves/preserves-schema/main.rkt       |  5 +++--
 3 files changed, 19 insertions(+), 16 deletions(-)

diff --git a/implementations/racket/preserves/preserves-schema/bin/preserves-schema-rkt.rkt b/implementations/racket/preserves/preserves-schema/bin/preserves-schema-rkt.rkt
index 2030f8c..f15de9c 100644
--- a/implementations/racket/preserves/preserves-schema/bin/preserves-schema-rkt.rkt
+++ b/implementations/racket/preserves/preserves-schema/bin/preserves-schema-rkt.rkt
@@ -110,13 +110,9 @@
                       (values (schema-full-output-path s)
                               (schema->module-stx (last (schema-module-path s))
                                                   (lambda (module-path)
-                                                    (hash-ref index
-                                                              module-path
-                                                              (lambda ()
-                                                                (error 'preserves-schema-rkt
-                                                                       "Undefined module: ~a"
-                                                                       module-path))))
-                                                  (schema-value s)))))
+                                                    (hash-ref index module-path #f))
+                                                  (schema-value s)
+                                                  #:filename (schema-full-output-path s)))))
 
                   (for [((output-path stx) (in-hash outputs))]
                     (make-parent-directory* output-path)
diff --git a/implementations/racket/preserves/preserves-schema/compiler.rkt b/implementations/racket/preserves/preserves-schema/compiler.rkt
index dce72f8..53c75af 100644
--- a/implementations/racket/preserves/preserves-schema/compiler.rkt
+++ b/implementations/racket/preserves/preserves-schema/compiler.rkt
@@ -25,7 +25,7 @@
 (define (map-Schema-definitions proc schema)
   (fold-Schema-definitions (lambda (n p acc) (cons (proc n p) acc)) '() schema))
 
-(define (module-imports schema lookup-module-path)
+(define (module-imports name schema lookup-module-path filename)
   (define imports (make-hash))
   (define (import-ref! r)
     (match-define (Ref module-path _name) r)
@@ -61,7 +61,13 @@
     [(EmbeddedTypeName-Ref r) (import-ref! r)])
   (map-Schema-definitions (lambda (n p) (walk p)) schema)
   (for/list [(import (in-hash-keys imports))]
-    `(require (prefix-in ,(module-path-prefix import) ,(lookup-module-path import)))))
+    (match (lookup-module-path import)
+      [#f (error 'module-imports
+                 "Reference to unknown module ~a in module ~a~a"
+                 (string-join (map symbol->string import) ".")
+                 name
+                 (if filename (format " (~a)" filename) ""))]
+      [path `(require (prefix-in ,(module-path-prefix import) ,path))])))
 
 (define (embedded-defs schema)
   (match (Schema-embeddedType schema)
@@ -104,11 +110,11 @@
 (define (unparser-defs schema)
   (map-Schema-definitions definition-unparser schema))
 
-(define (schema->module-stx name lookup-module-path schema)
+(define (schema->module-stx name lookup-module-path schema #:filename [filename #f])
   (schema-check-problems! schema #:name name)
   `(module ,name racket/base
      (provide (all-defined-out))
-     ,@(module-imports schema lookup-module-path)
+     ,@(module-imports name schema lookup-module-path filename)
      ,@(embedded-defs schema)
      (require preserves)
      (require preserves-schema/support)
@@ -127,9 +133,9 @@
   (define-runtime-path schema-binary "../../../../schema/schema.bin")
   (define metaschema (parse-Schema (with-input-from-file schema-binary read-preserve)))
   (define metaschema-module-source (schema->module-stx 'gen-schema
-                                                       (lambda (module-path)
-                                                         (error 'compiler-rkt-main "~a" module-path))
-                                                       metaschema))
+                                                       (lambda (module-path) #f)
+                                                       metaschema
+                                                       #:filename schema-binary))
 
   (if #t
       (with-output-to-file "gen/schema.rkt" #:exists 'replace
diff --git a/implementations/racket/preserves/preserves-schema/main.rkt b/implementations/racket/preserves/preserves-schema/main.rkt
index f5473fb..9e6ccc0 100644
--- a/implementations/racket/preserves/preserves-schema/main.rkt
+++ b/implementations/racket/preserves/preserves-schema/main.rkt
@@ -11,5 +11,6 @@
     (define-values (_dirname filename _must-be-dir) (split-path src))
     (schema->module-stx
      (string->symbol (path->string (path-replace-extension filename "")))
-     (lambda (module-path) (error 'read-preserves-schema-module "~a" module-path))
-     (port->schema src p))))
+     (lambda (module-path) #f)
+     (port->schema src p)
+     #:filename src)))