@@ -116,15 +116,15 @@ desugarImports modules = do
116116 exports <- findExports modules
117117 mapM (renameInModule' exports) modules
118118 where
119− renameInModule' exports m@(Module mn _) = do
119+ renameInModule' exports m = rethrowForModule m $ do
120120 imports <- resolveImports exports m
121− rethrowForModule m (renameInModule imports m)
121+ renameInModule imports m
122122
123123-- |
124124-- Rethrow an error with the name of the current module in the case of a failure
125125--
126126rethrowForModule :: Module -> Either String a -> Either String a
127−rethrowForModule (Module mn _) = flip catchError $ \e -> throwError ("Error in module '" ++ (show mn) ++ "':\n" ++ e)
127+rethrowForModule (Module mn _) = flip catchError $ \e -> throwError ("Error in module '" ++ show mn ++ "':\n" ++ e)
128128
129129-- |
130130-- Replaces all local names with qualified names within a module.
@@ -220,25 +220,21 @@ resolveImports env (Module currentModule decls) =
220220 -- Import something explicitly
221221 importExplicit :: ModuleName -> ImportEnvironment -> ImportType -> Either String ImportEnvironment
222222 importExplicit mn imp (NameImport name) = do
223+ checkValueExists env mn name
223224 values' <- updateImports mn (importedValues imp) name
224225 return $ imp { importedValues = values' }
225226 importExplicit mn imp (TypeImport name dctors) = do
226− allDctors <- allExportedDataConstructors env mn name
227+ checkTypeExists env mn name
227228 types' <- updateImports mn (importedTypes imp) name
228− dctors' <- maybe (return allDctors) (check "data constructor" allDctors) dctors
229+ let allDctors = allExportedDataConstructors env mn name
230+ dctors' <- maybe (return allDctors) (mapM $ checkDctorExists mn allDctors) dctors
229231 dctors'' <- foldM (updateImports mn) (importedDataConstructors imp) dctors'
230232 return $ imp { importedTypes = types', importedDataConstructors = dctors'' }
231233 importExplicit mn imp (TypeClassImport name) = do
234+ checkClassExists env mn name
232235 typeClasses' <- updateImports mn (importedTypeClasses imp) name
233236 return $ imp { importedTypeClasses = typeClasses' }
234237
235− -- Check that each item in a list of explicit imports does actually exist
236− check :: (Show a, Eq a) => String -> [a] -> [a] -> Either String [a]
237− check t all selected = case selected \\ all of
238− [] -> return selected
239− (unknown:[]) -> throwError $ "Unknown " ++ t ++ " '" ++ show unknown ++ "'"
240− unknowns -> throwError $ "Unknown " ++ t ++ "s '" ++ (intercalate "', '" (show `map` unknowns)) ++ "'"
241−
242238 -- Import everything from a module
243239 importAll :: ImportEnvironment -> ModuleName -> ExportEnvironment -> Either String ImportEnvironment
244240 importAll imp mn env = do
@@ -250,8 +246,8 @@ resolveImports env (Module currentModule decls) =
250246 (S.toList . fromMaybe S.empty $ mn `M.lookup` exportedTypeClasses env)
251247
252248 -- Find all exported data constructors for a given type
253− allExportedDataConstructors :: ExportEnvironment -> ModuleName -> ProperName -> Either String [ProperName]
254− allExportedDataConstructors env mn name = maybe (throwError $ "Unable to find exported data constructors for type " ++ show name) return $ do
249+ allExportedDataConstructors :: ExportEnvironment -> ModuleName -> ProperName -> [ProperName]
250+ allExportedDataConstructors env mn name = fromMaybe [] $ do
255251 s <- mn `M.lookup` exportedTypes env
256252 name `lookup` S.toList s
257253
@@ -264,3 +260,30 @@ resolveImports env (Module currentModule decls) =
264260 then "Definition '" ++ show name ++ "' conflicts with import '" ++ show (Qualified (Just mn) name) ++ "'"
265261 else "Conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just mn) name) ++ "'"
266262
263+ -- Ensure that an explicitly imported value exists in the module it is being imported from
264+ checkValueExists :: ExportEnvironment -> ModuleName -> Ident -> Either String Ident
265+ checkValueExists env mn = checkImportExists "value" mn values
266+ where values = S.toList $ fromMaybe S.empty $ mn `M.lookup` exportedValues env
267+
268+ -- Ensure that an explicitly imported type exists in the module it is being imported from
269+ checkTypeExists :: ExportEnvironment -> ModuleName -> ProperName -> Either String ProperName
270+ checkTypeExists env mn = checkImportExists "type" mn types
271+ where types = fst `map` S.toList (fromMaybe S.empty $ mn `M.lookup` exportedTypes env)
272+
273+ -- Ensure that an explicitly imported class exists in the module it is being imported from
274+ checkClassExists :: ExportEnvironment -> ModuleName -> ProperName -> Either String ProperName
275+ checkClassExists env mn = checkImportExists "type class" mn classes
276+ where classes = S.toList $ fromMaybe S.empty $ mn `M.lookup` exportedTypeClasses env
277+
278+ -- Ensure that an explicitly imported data constructor exists for the type it is being imported
279+ -- from
280+ checkDctorExists :: ModuleName -> [ProperName] -> ProperName -> Either String ProperName
281+ checkDctorExists = checkImportExists "data constructor"
282+
283+ -- Check that an explicitly imported item exists in the module it is being imported from
284+ checkImportExists :: (Show a, Eq a) => String -> ModuleName -> [a] -> a -> Either String a
285+ checkImportExists t mn exports item =
286+ if item `elem` exports
287+ then return item
288+ else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just mn) item) ++ "'"
289+