fix: make sure import collisions are reported correctly

compiler/common/Error/Error.hs

@@ -18,6 +18,8 @@ data TypeError
   | UnificationError Type Type
   | BadEscapeSequence
   | EmptyChar
+  | TypeAlreadyDefined String
+  | ImportCollision String
   -- Pred: The instance we add
   -- Pred: The wrong predicate
   -- Pred: The predicate from the interface declaration

compiler/main/Canonicalize/ADT.hs

@@ -24,8 +24,8 @@ import Explain.Location
 import Data.Hashable (hash)
 
 
-canonicalizeTypeDecls :: Env -> FilePath -> [Src.TypeDecl] -> CanonicalM (Env, [Can.TypeDecl])
-canonicalizeTypeDecls env astPath tds = do
+canonicalizeTypeDecls :: Env -> FilePath -> [String] -> [Src.TypeDecl] -> CanonicalM (Env, [Can.TypeDecl])
+canonicalizeTypeDecls env astPath typeNamesInScope tds = do
   env' <- foldM (addTypeToEnv astPath) env tds
   let tds' =
         sortBy
@@ -41,35 +41,39 @@ canonicalizeTypeDecls env astPath tds = do
           )
           tds
 
-  (env'', tds'', toRetry) <- canonicalizeTypeDecls' True env' astPath tds'
+  (env'', tds'', toRetry) <- canonicalizeTypeDecls' True typeNamesInScope env' astPath tds'
   if null toRetry then
     return (env'', tds'')
   else do
-    (env''', tds''', _) <- canonicalizeTypeDecls' False env'' astPath toRetry
+    (env''', tds''', _) <- canonicalizeTypeDecls' False typeNamesInScope env'' astPath toRetry
     return (env''', tds'' <> tds''')
 
 
 -- Last value in the tuple is the failed types that should be retried, mainly for forward use of type aliases
 -- if after a first pass that value isn't empty, we just retry all failed ones
-canonicalizeTypeDecls' :: Bool -> Env -> FilePath -> [Src.TypeDecl] -> CanonicalM (Env, [Can.TypeDecl], [Src.TypeDecl])
-canonicalizeTypeDecls' _ env _       []         = return (env, [], [])
-canonicalizeTypeDecls' firstPass env astPath [typeDecl] = do
-  if firstPass then
-    catchError
-      (do
-        (env', tds') <- canonicalizeTypeDecl env astPath typeDecl
-        return (env', [tds'], [])
-      )
-      (\_ ->
-        return (env, [], [typeDecl])
-      )
-  else do
-    (env', tds') <- canonicalizeTypeDecl env astPath typeDecl
-    return (env', [tds'], [])
-canonicalizeTypeDecls' firstPass env astPath (typeDecl : tds) = do
-  (env' , tds', toRetry') <- canonicalizeTypeDecls' firstPass env astPath [typeDecl]
-  (env'', tds'', toRetry'') <- canonicalizeTypeDecls' firstPass env' astPath tds
-  return (env'', tds' <> tds'', toRetry' <> toRetry'')
+canonicalizeTypeDecls' :: Bool -> [String] -> Env -> FilePath -> [Src.TypeDecl] -> CanonicalM (Env, [Can.TypeDecl], [Src.TypeDecl])
+canonicalizeTypeDecls' firstPass typeNamesInScope env astPath typeDecls = case typeDecls of
+  [] ->
+    return (env, [], [])
+
+  typeDecl : next -> do
+    when (Src.getTypeDeclName typeDecl `elem` typeNamesInScope) $ do
+      throwError $ CompilationError (TypeAlreadyDefined $ Src.getTypeDeclName typeDecl) (Context astPath (Src.getArea typeDecl))
+    (env', tds', toRetry') <-
+      if firstPass then
+        catchError
+          (do
+            (env', tds') <- canonicalizeTypeDecl env astPath typeNamesInScope typeDecl
+            return (env', [tds'], [])
+          )
+          (\_ ->
+            return (env, [], [typeDecl])
+          )
+      else do
+        (env', td') <- canonicalizeTypeDecl env astPath typeNamesInScope typeDecl
+        return (env', [td'], [])
+    (env'', tds'', toRetry'') <- canonicalizeTypeDecls' firstPass (Src.getTypeDeclName typeDecl : typeNamesInScope) env' astPath next
+    return (env'', tds' <> tds'', toRetry' <> toRetry'')
 
 
 verifyTypeVars :: Area -> FilePath -> Name -> [Name] -> CanonicalM ()
@@ -107,8 +111,8 @@ addTypeToEnv astPath env (Src.Source area _ typeDecl) = case typeDecl of
     return env
 
 
-canonicalizeTypeDecl :: Env -> FilePath -> Src.TypeDecl -> CanonicalM (Env, Can.TypeDecl)
-canonicalizeTypeDecl env astPath td@(Src.Source area _ typeDecl) = case typeDecl of
+canonicalizeTypeDecl :: Env -> FilePath -> [String] -> Src.TypeDecl -> CanonicalM (Env, Can.TypeDecl)
+canonicalizeTypeDecl env astPath typeNamesInScope td@(Src.Source area _ typeDecl) = case typeDecl of
   adt@Src.ADT{} ->
     if isLower . head $ Src.adtname adt then
       throwError $ CompilationError (NotCapitalizedADTName $ Src.adtname adt) (Context astPath area)

compiler/main/Canonicalize/AST.hs

@@ -277,10 +277,57 @@ buildImportInfos env Src.AST { Src.aimports } =
   in  env { envImportInfo = info }
 
 
+checkImportCollision :: FilePath -> [String] -> Src.Import -> CanonicalM [String]
+checkImportCollision modulePath foundNames imp = case imp of
+  Src.Source _ _ Src.TypeImport{} ->
+    return foundNames
+
+  Src.Source _ _ (Src.NamedImport names _ _) ->
+    foldM
+      (\processed (Src.Source area _ n) ->
+        if n `elem` processed then
+          throwError $ CompilationError (ImportCollision n) (Context modulePath area)
+        else
+          return $ n : processed
+      )
+      foundNames
+      names
+
+  Src.Source _ _ (Src.DefaultImport (Src.Source area _ n) _ _) ->
+    if n `elem` foundNames then
+      throwError $ CompilationError (ImportCollision n) (Context modulePath area)
+    else
+      return $ n : foundNames
+
+
+checkTypeImportCollision :: FilePath -> [String] -> Src.Import -> CanonicalM [String]
+checkTypeImportCollision modulePath foundNames imp = case imp of
+  Src.Source _ _ (Src.TypeImport names _ _) ->
+    foldM
+      (\processed (Src.Source area _ n) ->
+        if n `elem` processed then
+          throwError $ CompilationError (ImportCollision n) (Context modulePath area)
+        else
+          return $ n : processed
+      )
+      foundNames
+      names
+
+  Src.Source _ _ (Src.NamedImport names _ _) ->
+    return foundNames
+
+  Src.Source _ _ (Src.DefaultImport (Src.Source _ _ n) _ _) ->
+    return foundNames
+
+
+
 canonicalizeAST :: FilePath -> Options -> Env -> Src.AST -> CanonicalM (Can.AST, Env, [InstanceToDerive])
 canonicalizeAST dictionaryModulePath options env sourceAst@Src.AST{ Src.apath = Just astPath, Src.aimports } = do
   mapM_ (validateImport astPath) aimports
 
+  foldM_ (checkImportCollision astPath) [] aimports
+  importedTypeNames <- foldM (checkTypeImportCollision astPath) [] aimports
+
   let env'  = buildImportInfos env sourceAst
   let env'' = env'
             { envCurrentPath = astPath
@@ -293,7 +340,7 @@ canonicalizeAST dictionaryModulePath options env sourceAst@Src.AST{ Src.apath =
   resetNameAccesses
   resetJS
 
-  (env''', typeDecls)   <- canonicalizeTypeDecls env'' astPath $ Src.atypedecls sourceAst
+  (env''', typeDecls)   <- canonicalizeTypeDecls env'' astPath importedTypeNames $ Src.atypedecls sourceAst
   imports               <- mapM (canonicalize env''' (optTarget options)) $ Src.aimports sourceAst
   exps                  <- mapM (canonicalize env''' (optTarget options)) $ Src.aexps sourceAst
   (env'''', interfaces) <- canonicalizeInterfaces env''' $ Src.ainterfaces sourceAst

compiler/main/Explain/Format.hs

@@ -814,6 +814,15 @@ createSimpleErrorDiagnostic color _ typeError = case typeError of
     <> "assignments share the scope and using a local name that is\n"
     <> "defined in the global scope of a module is not allowed."
 
+  TypeAlreadyDefined name ->
+    "Type already defined\n\n"
+    <> "The type '" <> name <> "' is already defined\n\n"
+    <> "Hint: Change the name of the type.\n"
+
+  ImportCollision name ->
+    "Import collision\n\n"
+    <> "The imported name '" <> name <> "' is already used\n\n"
+
   NameAlreadyExported name ->
     "Already exported\n\n"
     <> "Export already defined. You are trying to export the\n"
@@ -1789,6 +1798,44 @@ createErrorDiagnostic color context typeError = case typeError of
               <> "defined in the global scope of a module is not allowed."
           ]
 
+  ImportCollision name ->
+    case context of
+      Context modulePath (Area (Loc _ startL startC) (Loc _ endL endC)) ->
+        Diagnose.Err
+          Nothing
+          "Import collision"
+          [ ( Diagnose.Position (startL, startC) (endL, endC) modulePath
+            , Diagnose.This $ "The imported name '" <> name <> "' is already used"
+            )
+          ]
+          []
+
+      NoContext ->
+        Diagnose.Err
+          Nothing
+          "Import collision"
+          []
+          []
+
+  TypeAlreadyDefined name ->
+    case context of
+      Context modulePath (Area (Loc _ startL startC) (Loc _ endL endC)) ->
+        Diagnose.Err
+          Nothing
+          "Type already defined"
+          [ ( Diagnose.Position (startL, startC) (endL, endC) modulePath
+            , Diagnose.This $ "The type '" <> name <> "' is already defined"
+            )
+          ]
+          [Diagnose.Hint "Change the name of the type"]
+
+      NoContext ->
+        Diagnose.Err
+          Nothing
+          "Type already defined"
+          []
+          [Diagnose.Hint "Change the name of the type"]
+
   NameAlreadyExported name ->
     case context of
       Context modulePath (Area (Loc _ startL startC) (Loc _ endL endC)) ->

compiler/test/Blackbox/RunnerSpec.hs

@@ -153,6 +153,9 @@ spec = do
         , "compiler/test/Blackbox/test-cases/number-inference-error"
         , "compiler/test/Blackbox/test-cases/while"
         , "compiler/test/Blackbox/test-cases/arrays-and-mutations"
+        , "compiler/test/Blackbox/test-cases/type-import-collision"
+        , "compiler/test/Blackbox/test-cases/import-collision"
+        , "compiler/test/Blackbox/test-cases/redefined-type"
         ]
 
   forM_ cases $ \casePath -> do

compiler/test/Blackbox/test-cases/import-collision/Entrypoint.mad

@@ -0,0 +1,4 @@
+import { Something } from "./ModuleA"
+import Something from "./ModuleB"
+
+main = () => {}

compiler/test/Blackbox/test-cases/import-collision/ModuleA.mad

@@ -0,0 +1 @@
+export type Something = Something

compiler/test/Blackbox/test-cases/import-collision/ModuleB.mad

@@ -0,0 +1 @@
+export alias Something = {}

compiler/test/Blackbox/test-cases/import-collision/expected-js

@@ -0,0 +1,7 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/import-collision/Entrypoint.mad@2:8-2:17
+     │
+   2 │ import Something from \"./ModuleB\"
+     •        ┬──────── 
+     •        ╰╸ The imported name 'Something' is already used
+─────╯
+

compiler/test/Blackbox/test-cases/import-collision/expected-llvm

@@ -0,0 +1,7 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/import-collision/Entrypoint.mad@2:8-2:17
+     │
+   2 │ import Something from \"./ModuleB\"
+     •        ┬──────── 
+     •        ╰╸ The imported name 'Something' is already used
+─────╯
+

compiler/test/Blackbox/test-cases/redefined-type/Entrypoint.mad

@@ -0,0 +1,5 @@
+import type { Something } from "./ModuleA"
+
+alias Something = {}
+
+main = () => {}

compiler/test/Blackbox/test-cases/redefined-type/ModuleA.mad

@@ -0,0 +1 @@
+export type Something = Something

compiler/test/Blackbox/test-cases/redefined-type/expected-js

@@ -0,0 +1,9 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/redefined-type/Entrypoint.mad@3:1-3:21
+     │
+   3 │ alias Something = {}
+     • ┬───────────────────
+     • ╰╸ The type 'Something' is already defined
+     •
+     │ Hint: Change the name of the type
+─────╯
+

compiler/test/Blackbox/test-cases/redefined-type/expected-llvm

@@ -0,0 +1,9 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/redefined-type/Entrypoint.mad@3:1-3:21
+     │
+   3 │ alias Something = {}
+     • ┬───────────────────
+     • ╰╸ The type 'Something' is already defined
+     •
+     │ Hint: Change the name of the type
+─────╯
+

compiler/test/Blackbox/test-cases/type-import-collision/Entrypoint.mad

@@ -0,0 +1,4 @@
+import type { Something } from "./ModuleA"
+import type { Something } from "./ModuleB"
+
+main = () => {}

compiler/test/Blackbox/test-cases/type-import-collision/ModuleA.mad

@@ -0,0 +1 @@
+export type Something = Something

compiler/test/Blackbox/test-cases/type-import-collision/ModuleB.mad

@@ -0,0 +1 @@
+export alias Something = {}

compiler/test/Blackbox/test-cases/type-import-collision/expected-js

@@ -0,0 +1,7 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/type-import-collision/Entrypoint.mad@2:15-2:24
+     │
+   2 │ import type { Something } from \"./ModuleB\"
+     •               ┬──────── 
+     •               ╰╸ The imported name 'Something' is already used
+─────╯
+

compiler/test/Blackbox/test-cases/type-import-collision/expected-llvm

@@ -0,0 +1,7 @@
+     ╭──▶ compiler/test/Blackbox/test-cases/type-import-collision/Entrypoint.mad@2:15-2:24
+     │
+   2 │ import type { Something } from \"./ModuleB\"
+     •               ┬──────── 
+     •               ╰╸ The imported name 'Something' is already used
+─────╯
+