From e84bace7eec341b430bc8a6c7332129dae9e9388 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira <janmasrovira@gmail.com>
Date: Tue, 21 Jan 2025 13:49:01 +0100
Subject: [PATCH] Improve error message for ambiguous export (#3289)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The error message now lists all possibilities. It also uses the correct
word to describe the namespace.
E.g.
Before
```
/home/jan/projects/anoma-applib/Applib.juvix:1:8-14: error:
The symbol ExternalIdentity is exported multiple times in the module Applib
```
After
```
/home/jan/projects/anoma-applib/Applib.juvix:1:8-14: error:
The module ExternalIdentity is exported multiple times in the module Applib
• Defined in /home/jan/projects/anoma-applib/Applib/Identities.juvix:13:8-24
• Defined in /home/jan/projects/anoma-applib/Anoma/Identity/External.juvix:7:6-22
```
---
 src/Juvix/Compiler/Concrete/Data/NameSpace.hs |  6 +++++
 .../FromParsed/Analysis/Scoping.hs            | 23 +++++++++----------
 .../Analysis/Scoping/Error/Types.hs           | 14 ++++++++++-
 .../Compiler/Store/Scoped/Data/SymbolEntry.hs |  3 +++
 4 files changed, 33 insertions(+), 13 deletions(-)

diff --git a/src/Juvix/Compiler/Concrete/Data/NameSpace.hs b/src/Juvix/Compiler/Concrete/Data/NameSpace.hs
index 3ab2c14fd7..a6ec52b425 100644
--- a/src/Juvix/Compiler/Concrete/Data/NameSpace.hs
+++ b/src/Juvix/Compiler/Concrete/Data/NameSpace.hs
@@ -36,6 +36,12 @@ type family NameSpaceEntryType s = res | res -> s where
   NameSpaceEntryType 'NameSpaceModules = ModuleSymbolEntry
   NameSpaceEntryType 'NameSpaceFixities = FixitySymbolEntry
 
+nameSpaceElemName :: (IsString str) => NameSpace -> str
+nameSpaceElemName = \case
+  NameSpaceSymbols -> "symbol"
+  NameSpaceModules -> "module"
+  NameSpaceFixities -> "fixity"
+
 entryName :: forall ns. (SingI ns) => Lens' (NameSpaceEntryType ns) S.Name
 entryName = case sing :: SNameSpace ns of
   SNameSpaceSymbols -> \f -> \case
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
index cdbeb9468b..aa25882f5b 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
@@ -925,18 +925,17 @@ exportScope Scope {..} = do
 
         err :: NonEmpty (NameSpaceEntryType ns) -> Sem r a
         err es =
-          throw
-            ( ErrMultipleExport
-                ( MultipleExportConflict
-                    _scopePath
-                    s
-                    ( case sing :: SNameSpace ns of
-                        SNameSpaceSymbols -> ExportEntriesSymbols es
-                        SNameSpaceModules -> ExportEntriesModules es
-                        SNameSpaceFixities -> ExportEntriesFixities es
-                    )
-                )
-            )
+          throw $
+            ErrMultipleExport
+              MultipleExportConflict
+                { _multipleExportModule = _scopePath,
+                  _multipleExportSymbol = s,
+                  _multipleExportNameSpace = fromSing (sing :: SNameSpace ns),
+                  _multipleExportEntries = case sing :: SNameSpace ns of
+                    SNameSpaceSymbols -> ExportEntriesSymbols es
+                    SNameSpaceModules -> ExportEntriesModules es
+                    SNameSpaceFixities -> ExportEntriesFixities es
+                }
 
 getLocalModules :: (Member (State ScoperState) r) => ExportInfo -> Sem r (HashMap S.NameId ScopedModule)
 getLocalModules ExportInfo {..} = do
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
index 9b6333e066..dff090e783 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs
@@ -279,6 +279,7 @@ data ExportEntries
 data MultipleExportConflict = MultipleExportConflict
   { _multipleExportModule :: S.AbsModulePath,
     _multipleExportSymbol :: Symbol,
+    _multipleExportNameSpace :: NameSpace,
     _multipleExportEntries :: ExportEntries
   }
   deriving stock (Show)
@@ -297,10 +298,21 @@ instance ToGenericError MultipleExportConflict where
           opts' = fromGenericOptions opts
           i = getLoc _multipleExportModule
           msg =
-            "The symbol"
+            "The"
+              <+> nameSpaceElemName _multipleExportNameSpace
               <+> ppCode opts' _multipleExportSymbol
               <+> "is exported multiple times in the module"
               <+> ppCode opts' _multipleExportModule
+                <> hardline
+                <> itemize
+                  ( case _multipleExportEntries of
+                      ExportEntriesSymbols s -> ppEntry <$> s
+                      ExportEntriesModules s -> ppEntry <$> s
+                      ExportEntriesFixities s -> ppEntry <$> s
+                  )
+            where
+              ppEntry :: (HasLoc e) => e -> Doc CodeAnn
+              ppEntry e = "Defined in" <+> annotate (AnnKind KNameTopModule) (pretty (getLoc e))
 
 data NotInScope = NotInScope
   { _notInScopeSymbol :: Symbol,
diff --git a/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs b/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs
index de1435bd21..bb57683c45 100644
--- a/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs
+++ b/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs
@@ -85,6 +85,9 @@ instance HasNameKind ModuleSymbolEntry where
 instance HasLoc ModuleSymbolEntry where
   getLoc (ModuleSymbolEntry s) = s ^. S.nameDefined
 
+instance HasLoc FixitySymbolEntry where
+  getLoc (FixitySymbolEntry s) = s ^. S.nameDefined
+
 symbolEntryNameId :: SymbolEntry -> NameId
 symbolEntryNameId = (^. symbolEntry . S.nameId)