@@ -15,6 +15,7 @@
15{-# LANGUAGE RankNTypes #-}
15{-# LANGUAGE RankNTypes #-}
16{-# LANGUAGE ScopedTypeVariables #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE TupleSections #-}
17{-# LANGUAGE TupleSections #-}
18+{-# LANGUAGE LambdaCase #-}
19module Language.PureScript.Sugar.Names.Exports
20module Language.PureScript.Sugar.Names.Exports
20 ( findExportable
21 ( findExportable
@@ -29,6 +30,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
29import Data.Foldable (traverse_)
30import Data.Foldable (traverse_)
31import Control.Monad
32import Control.Monad
33+import Control.Monad.Writer.Class (MonadWriter(..))
32import Control.Monad.Error.Class (MonadError(..))
34import Control.Monad.Error.Class (MonadError(..))
34import qualified Data.Map as M
36import qualified Data.Map as M
@@ -66,14 +68,31 @@ findExportable (Module _ _ mn ds _) =
66-- Resolves the exports for a module, filtering out members that have not been
68-- Resolves the exports for a module, filtering out members that have not been
67-- exported and elaborating re-exports of other modules.
69-- exported and elaborating re-exports of other modules.
69−resolveExports :: forall m. (Applicative m, MonadError MultipleErrors m) => Env -> ModuleName -> Imports -> Exports -> [DeclarationRef] -> m Exports
71+resolveExports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Env -> ModuleName -> Imports -> Exports -> [DeclarationRef] -> m Exports
70resolveExports env mn imps exps refs =
72resolveExports env mn imps exps refs =
71 rethrow (addHint (ErrorInModule mn)) $ do
73 rethrow (addHint (ErrorInModule mn)) $ do
72 filtered <- filterModule mn exps refs
74 filtered <- filterModule mn exps refs
75+ let (dupeRefs, dupeDctors) = findDuplicateRefs refs
76+ warnDupeRefs dupeRefs
77+ warnDupeDctors dupeDctors
73 foldM elaborateModuleExports filtered refs
78 foldM elaborateModuleExports filtered refs
82+ warnDupeRefs :: [DeclarationRef] -> m ()
83+ warnDupeRefs = traverse_ $ \case
84+ TypeRef name _ -> warnDupe $ "type " ++ runProperName name
85+ ValueRef name -> warnDupe $ "value " ++ runIdent name
86+ TypeClassRef name -> warnDupe $ "class " ++ runProperName name
87+ ModuleRef name -> warnDupe $ "module " ++ runModuleName name
90+ warnDupeDctors :: [ProperName] -> m ()
91+ warnDupeDctors = traverse_ (warnDupe . ("data constructor " ++) . runProperName)
93+ warnDupe :: String -> m ()
94+ warnDupe ref = tell . errorMessage $ DuplicateExportRef ref
77 -- Takes the current module's imports, the accumulated list of exports, and a
96 -- Takes the current module's imports, the accumulated list of exports, and a
78 -- `DeclarationRef` for an explicit export. When the ref refers to another
97 -- `DeclarationRef` for an explicit export. When the ref refers to another
79 -- module, export anything from the imports that matches for that module.
98 -- module, export anything from the imports that matches for that module.