module Language.PureScript.Sugar.Names.Env
  ( ImportRecord(..)
  , ImportProvenance(..)
  , Imports(..)
  , nullImports
  , Exports(..)
  , nullExports
  , Env
  , primEnv
  , primExports
  , envModuleExports
  , ExportMode(..)
  , exportType
  , exportTypeOp
  , exportTypeClass
  , exportValue
  , exportValueOp
  , checkImportConflicts
  ) where

import Prelude

import Control.Monad (forM_, when)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Writer.Class (MonadWriter(..))

import Data.Function (on)
import Data.Foldable (find)
import Data.List (groupBy, sortOn, delete)
import Data.Maybe (mapMaybe)
import Safe (headMay)
import Data.Map qualified as M
import Data.Set qualified as S

import Language.PureScript.Constants.Prim qualified as C
import Language.PureScript.AST (ExportSource(..), SourceSpan, internalModuleSourceSpan, nullSourceSpan)
import Language.PureScript.Crash (internalError)
import Language.PureScript.Environment
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage')
import Language.PureScript.Names (Ident, ModuleName, Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, getQual)

-- |
-- The details for an import: the name of the thing that is being imported
-- (`A.x` if importing from `A`), the module that the thing was originally
-- defined in (for re-export resolution), and the import provenance (see below).
--
data ImportRecord a =
  ImportRecord
    { forall a. ImportRecord a -> Qualified a
importName :: Qualified a
    , forall a. ImportRecord a -> ModuleName
importSourceModule :: ModuleName
    , forall a. ImportRecord a -> SourceSpan
importSourceSpan :: SourceSpan
    , forall a. ImportRecord a -> ImportProvenance
importProvenance :: ImportProvenance
    }
    deriving (ImportRecord a -> ImportRecord a -> Bool
forall a. Eq a => ImportRecord a -> ImportRecord a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportRecord a -> ImportRecord a -> Bool
$c/= :: forall a. Eq a => ImportRecord a -> ImportRecord a -> Bool
== :: ImportRecord a -> ImportRecord a -> Bool
$c== :: forall a. Eq a => ImportRecord a -> ImportRecord a -> Bool
Eq, ImportRecord a -> ImportRecord a -> Bool
ImportRecord a -> ImportRecord a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ImportRecord a)
forall a. Ord a => ImportRecord a -> ImportRecord a -> Bool
forall a. Ord a => ImportRecord a -> ImportRecord a -> Ordering
forall a.
Ord a =>
ImportRecord a -> ImportRecord a -> ImportRecord a
min :: ImportRecord a -> ImportRecord a -> ImportRecord a
$cmin :: forall a.
Ord a =>
ImportRecord a -> ImportRecord a -> ImportRecord a
max :: ImportRecord a -> ImportRecord a -> ImportRecord a
$cmax :: forall a.
Ord a =>
ImportRecord a -> ImportRecord a -> ImportRecord a
>= :: ImportRecord a -> ImportRecord a -> Bool
$c>= :: forall a. Ord a => ImportRecord a -> ImportRecord a -> Bool
> :: ImportRecord a -> ImportRecord a -> Bool
$c> :: forall a. Ord a => ImportRecord a -> ImportRecord a -> Bool
<= :: ImportRecord a -> ImportRecord a -> Bool
$c<= :: forall a. Ord a => ImportRecord a -> ImportRecord a -> Bool
< :: ImportRecord a -> ImportRecord a -> Bool
$c< :: forall a. Ord a => ImportRecord a -> ImportRecord a -> Bool
compare :: ImportRecord a -> ImportRecord a -> Ordering
$ccompare :: forall a. Ord a => ImportRecord a -> ImportRecord a -> Ordering
Ord, Int -> ImportRecord a -> ShowS
forall a. Show a => Int -> ImportRecord a -> ShowS
forall a. Show a => [ImportRecord a] -> ShowS
forall a. Show a => ImportRecord a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportRecord a] -> ShowS
$cshowList :: forall a. Show a => [ImportRecord a] -> ShowS
show :: ImportRecord a -> String
$cshow :: forall a. Show a => ImportRecord a -> String
showsPrec :: Int -> ImportRecord a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ImportRecord a -> ShowS
Show)

-- |
-- Used to track how an import was introduced into scope. This allows us to
-- handle the one-open-import special case that allows a name conflict to become
-- a warning rather than being an unresolvable situation.
--
data ImportProvenance
  = FromImplicit
  | FromExplicit
  | Local
  | Prim
  deriving (ImportProvenance -> ImportProvenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportProvenance -> ImportProvenance -> Bool
$c/= :: ImportProvenance -> ImportProvenance -> Bool
== :: ImportProvenance -> ImportProvenance -> Bool
$c== :: ImportProvenance -> ImportProvenance -> Bool
Eq, Eq ImportProvenance
ImportProvenance -> ImportProvenance -> Bool
ImportProvenance -> ImportProvenance -> Ordering
ImportProvenance -> ImportProvenance -> ImportProvenance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImportProvenance -> ImportProvenance -> ImportProvenance
$cmin :: ImportProvenance -> ImportProvenance -> ImportProvenance
max :: ImportProvenance -> ImportProvenance -> ImportProvenance
$cmax :: ImportProvenance -> ImportProvenance -> ImportProvenance
>= :: ImportProvenance -> ImportProvenance -> Bool
$c>= :: ImportProvenance -> ImportProvenance -> Bool
> :: ImportProvenance -> ImportProvenance -> Bool
$c> :: ImportProvenance -> ImportProvenance -> Bool
<= :: ImportProvenance -> ImportProvenance -> Bool
$c<= :: ImportProvenance -> ImportProvenance -> Bool
< :: ImportProvenance -> ImportProvenance -> Bool
$c< :: ImportProvenance -> ImportProvenance -> Bool
compare :: ImportProvenance -> ImportProvenance -> Ordering
$ccompare :: ImportProvenance -> ImportProvenance -> Ordering
Ord, Int -> ImportProvenance -> ShowS
[ImportProvenance] -> ShowS
ImportProvenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportProvenance] -> ShowS
$cshowList :: [ImportProvenance] -> ShowS
show :: ImportProvenance -> String
$cshow :: ImportProvenance -> String
showsPrec :: Int -> ImportProvenance -> ShowS
$cshowsPrec :: Int -> ImportProvenance -> ShowS
Show)

type ImportMap a = M.Map (Qualified a) [ImportRecord a]

-- |
-- The imported declarations for a module, including the module's own members.
--
data Imports = Imports
  {
  -- |
  -- Local names for types within a module mapped to their qualified names
  --
    Imports -> ImportMap (ProperName 'TypeName)
importedTypes :: ImportMap (ProperName 'TypeName)
  -- |
  -- Local names for type operators within a module mapped to their qualified names
  --
  , Imports -> ImportMap (OpName 'TypeOpName)
importedTypeOps :: ImportMap (OpName 'TypeOpName)
  -- |
  -- Local names for data constructors within a module mapped to their qualified names
  --
  , Imports -> ImportMap (ProperName 'ConstructorName)
importedDataConstructors :: ImportMap (ProperName 'ConstructorName)
  -- |
  -- Local names for classes within a module mapped to their qualified names
  --
  , Imports -> ImportMap (ProperName 'ClassName)
importedTypeClasses :: ImportMap (ProperName 'ClassName)
  -- |
  -- Local names for values within a module mapped to their qualified names
  --
  , Imports -> ImportMap Ident
importedValues :: ImportMap Ident
  -- |
  -- Local names for value operators within a module mapped to their qualified names
  --
  , Imports -> ImportMap (OpName 'ValueOpName)
importedValueOps :: ImportMap (OpName 'ValueOpName)
  -- |
  -- The name of modules that have been imported into the current scope that
  -- can be re-exported. If a module is imported with `as` qualification, the
  -- `as` name appears here, otherwise the original name.
  --
  , Imports -> Set ModuleName
importedModules :: S.Set ModuleName
  -- |
  -- The "as" names of modules that have been imported qualified.
  --
  , Imports -> Set ModuleName
importedQualModules :: S.Set ModuleName
  -- |
  -- Local names for kinds within a module mapped to their qualified names
  --
  , Imports -> ImportMap (ProperName 'TypeName)
importedKinds :: ImportMap (ProperName 'TypeName)
  } deriving (Int -> Imports -> ShowS
[Imports] -> ShowS
Imports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Imports] -> ShowS
$cshowList :: [Imports] -> ShowS
show :: Imports -> String
$cshow :: Imports -> String
showsPrec :: Int -> Imports -> ShowS
$cshowsPrec :: Int -> Imports -> ShowS
Show)

nullImports :: Imports
nullImports :: Imports
nullImports = ImportMap (ProperName 'TypeName)
-> ImportMap (OpName 'TypeOpName)
-> ImportMap (ProperName 'ConstructorName)
-> ImportMap (ProperName 'ClassName)
-> ImportMap Ident
-> ImportMap (OpName 'ValueOpName)
-> Set ModuleName
-> Set ModuleName
-> ImportMap (ProperName 'TypeName)
-> Imports
Imports forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall a. Set a
S.empty forall a. Set a
S.empty forall k a. Map k a
M.empty

-- |
-- The exported declarations from a module.
--
data Exports = Exports
  {
  -- |
  -- The exported types along with the module they originally came from.
  --
    Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)
  -- |
  -- The exported type operators along with the module they originally came
  -- from.
  --
  , Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps :: M.Map (OpName 'TypeOpName) ExportSource
  -- |
  -- The exported classes along with the module they originally came from.
  --
  , Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses :: M.Map (ProperName 'ClassName) ExportSource
  -- |
  -- The exported values along with the module they originally came from.
  --
  , Exports -> Map Ident ExportSource
exportedValues :: M.Map Ident ExportSource
  -- |
  -- The exported value operators along with the module they originally came
  -- from.
  --
  , Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource
  } deriving (Int -> Exports -> ShowS
[Exports] -> ShowS
Exports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exports] -> ShowS
$cshowList :: [Exports] -> ShowS
show :: Exports -> String
$cshow :: Exports -> String
showsPrec :: Int -> Exports -> ShowS
$cshowsPrec :: Int -> Exports -> ShowS
Show)

-- |
-- An empty 'Exports' value.
--
nullExports :: Exports
nullExports :: Exports
nullExports = Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
-> Map (OpName 'TypeOpName) ExportSource
-> Map (ProperName 'ClassName) ExportSource
-> Map Ident ExportSource
-> Map (OpName 'ValueOpName) ExportSource
-> Exports
Exports forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty

-- |
-- The imports and exports for a collection of modules. The 'SourceSpan' is used
-- to store the source location of the module with a given name, used to provide
-- useful information when there is a duplicate module definition.
--
type Env = M.Map ModuleName (SourceSpan, Imports, Exports)

-- |
-- Extracts the 'Exports' from an 'Env' value.
--
envModuleExports :: (a, b, Exports) -> Exports
envModuleExports :: forall a b. (a, b, Exports) -> Exports
envModuleExports (a
_, b
_, Exports
exps) = Exports
exps

-- |
-- The exported types from the @Prim@ module
--
primExports :: Exports
primExports :: Exports
primExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses

-- |
-- The exported types from the @Prim.Boolean@ module
--
primBooleanExports :: Exports
primBooleanExports :: Exports
primBooleanExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes forall a. Monoid a => a
mempty

-- |
-- The exported types from the @Prim.Coerce@ module
--
primCoerceExports :: Exports
primCoerceExports :: Exports
primCoerceExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses

-- |
-- The exported types from the @Prim.Ordering@ module
--
primOrderingExports :: Exports
primOrderingExports :: Exports
primOrderingExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes forall a. Monoid a => a
mempty

-- |
-- The exported types from the @Prim.Row@ module
--
primRowExports :: Exports
primRowExports :: Exports
primRowExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses

-- |
-- The exported types from the @Prim.RowList@ module
--
primRowListExports :: Exports
primRowListExports :: Exports
primRowListExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses

-- |
-- The exported types from the @Prim.Symbol@ module
--
primSymbolExports :: Exports
primSymbolExports :: Exports
primSymbolExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses

-- |
-- The exported types from the @Prim.Int@ module
primIntExports :: Exports
primIntExports :: Exports
primIntExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses

-- |
-- The exported types from the @Prim.TypeError@ module
--
primTypeErrorExports :: Exports
primTypeErrorExports :: Exports
primTypeErrorExports = forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses

-- |
-- Create a set of exports for a Prim module.
--
mkPrimExports
  :: M.Map (Qualified (ProperName 'TypeName)) a
  -> M.Map (Qualified (ProperName 'ClassName)) b
  -> Exports
mkPrimExports :: forall a b.
Map (Qualified (ProperName 'TypeName)) a
-> Map (Qualified (ProperName 'ClassName)) b -> Exports
mkPrimExports Map (Qualified (ProperName 'TypeName)) a
ts Map (Qualified (ProperName 'ClassName)) b
cs =
  Exports
nullExports
    { exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedTypes = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall {a} {a}. Qualified a -> (a, ([a], ExportSource))
mkTypeEntry forall a b. (a -> b) -> [a] -> [b]
`map` forall k a. Map k a -> [k]
M.keys Map (Qualified (ProperName 'TypeName)) a
ts
    , exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeClasses = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall {a}. Qualified a -> (a, ExportSource)
mkClassEntry forall a b. (a -> b) -> [a] -> [b]
`map` forall k a. Map k a -> [k]
M.keys Map (Qualified (ProperName 'ClassName)) b
cs
    }
  where
  mkTypeEntry :: Qualified a -> (a, ([a], ExportSource))
mkTypeEntry (Qualified (ByModuleName ModuleName
mn) a
name) = (a
name, ([], ModuleName -> ExportSource
primExportSource ModuleName
mn))
  mkTypeEntry Qualified a
_ = forall a. HasCallStack => String -> a
internalError
    String
"mkPrimExports.mkTypeEntry: a name is qualified BySourcePos instead of ByModuleName"

  mkClassEntry :: Qualified a -> (a, ExportSource)
mkClassEntry (Qualified (ByModuleName ModuleName
mn) a
name) = (a
name, ModuleName -> ExportSource
primExportSource ModuleName
mn)
  mkClassEntry Qualified a
_ = forall a. HasCallStack => String -> a
internalError
    String
"mkPrimExports.mkClassEntry: a name is qualified BySourcePos instead of ByModuleName"

  primExportSource :: ModuleName -> ExportSource
primExportSource ModuleName
mn =
    ExportSource
      { exportSourceImportedFrom :: Maybe ModuleName
exportSourceImportedFrom = forall a. Maybe a
Nothing
      , exportSourceDefinedIn :: ModuleName
exportSourceDefinedIn = ModuleName
mn
      }

-- | Environment which only contains the Prim modules.
primEnv :: Env
primEnv :: Env
primEnv = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ ( ModuleName
C.M_Prim
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim>", Imports
nullImports, Exports
primExports)
    )
  , ( ModuleName
C.M_Prim_Boolean
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Boolean>", Imports
nullImports, Exports
primBooleanExports)
    )
  , ( ModuleName
C.M_Prim_Coerce
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Coerce>", Imports
nullImports, Exports
primCoerceExports)
    )
  , ( ModuleName
C.M_Prim_Ordering
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Ordering>", Imports
nullImports, Exports
primOrderingExports)
    )
  , ( ModuleName
C.M_Prim_Row
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Row>", Imports
nullImports, Exports
primRowExports)
    )
  , ( ModuleName
C.M_Prim_RowList
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.RowList>", Imports
nullImports, Exports
primRowListExports)
    )
  , ( ModuleName
C.M_Prim_Symbol
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Symbol>", Imports
nullImports, Exports
primSymbolExports)
    )
  , ( ModuleName
C.M_Prim_Int
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.Int>", Imports
nullImports, Exports
primIntExports)
    )
  , ( ModuleName
C.M_Prim_TypeError
    , (String -> SourceSpan
internalModuleSourceSpan String
"<Prim.TypeError>", Imports
nullImports, Exports
primTypeErrorExports)
    )
  ]

-- |
-- When updating the `Exports` the behaviour is slightly different depending
-- on whether we are exporting values defined within the module or elaborating
-- re-exported values. This type is used to indicate which behaviour should be
-- used.
--
data ExportMode = Internal | ReExport
  deriving (ExportMode -> ExportMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportMode -> ExportMode -> Bool
$c/= :: ExportMode -> ExportMode -> Bool
== :: ExportMode -> ExportMode -> Bool
$c== :: ExportMode -> ExportMode -> Bool
Eq, Int -> ExportMode -> ShowS
[ExportMode] -> ShowS
ExportMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportMode] -> ShowS
$cshowList :: [ExportMode] -> ShowS
show :: ExportMode -> String
$cshow :: ExportMode -> String
showsPrec :: Int -> ExportMode -> ShowS
$cshowsPrec :: Int -> ExportMode -> ShowS
Show)

-- |
-- Safely adds a type and its data constructors to some exports, returning an
-- error if a conflict occurs.
--
exportType
  :: MonadError MultipleErrors m
  => SourceSpan
  -> ExportMode
  -> Exports
  -> ProperName 'TypeName
  -> [ProperName 'ConstructorName]
  -> ExportSource
  -> m Exports
exportType :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> ExportSource
-> m Exports
exportType SourceSpan
ss ExportMode
exportMode Exports
exps ProperName 'TypeName
name [ProperName 'ConstructorName]
dctors ExportSource
src = do
  let exTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes = Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps
      exClasses :: Map (ProperName 'ClassName) ExportSource
exClasses = Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps
      dctorNameCounts :: [(ProperName 'ConstructorName, Int)]
      dctorNameCounts :: [(ProperName 'ConstructorName, Int)]
dctorNameCounts = forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Num a => a -> a -> a
(+) (forall a b. (a -> b) -> [a] -> [b]
map (,Int
1) [ProperName 'ConstructorName]
dctors)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProperName 'ConstructorName, Int)]
dctorNameCounts forall a b. (a -> b) -> a -> b
$ \(ProperName 'ConstructorName
dctorName, Int
count) ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctorName) (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctorName)
  case ExportMode
exportMode of
    ExportMode
Internal -> do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name) (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map (ProperName 'ClassName) ExportSource
exClasses) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name) (ProperName 'ClassName -> Name
TyClassName (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'TypeName
name))
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProperName 'ConstructorName]
dctors forall a b. (a -> b) -> a -> b
$ \ProperName 'ConstructorName
dctor -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ProperName 'ConstructorName
dctor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctor) (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctor)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ConstructorName
dctor forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map (ProperName 'ClassName) ExportSource
exClasses) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctor) (ProperName 'ClassName -> Name
TyClassName (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ConstructorName
dctor))
    ExportMode
ReExport -> do
      let mn :: ModuleName
mn = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (ProperName 'ClassName) ExportSource
exClasses) forall a b. (a -> b) -> a -> b
$ \ExportSource
src' ->
        let mn' :: ModuleName
mn' = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src' in
        forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> Name -> m a
throwExportConflict' SourceSpan
ss ModuleName
mn ModuleName
mn' (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name) (ProperName 'ClassName -> Name
TyClassName (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'TypeName
name))
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ProperName 'TypeName
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$ \([ProperName 'ConstructorName]
_, ExportSource
src') ->
        let mn' :: ModuleName
mn' = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src' in
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModuleName
mn forall a. Eq a => a -> a -> Bool
/= ModuleName
mn') forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> m a
throwExportConflict SourceSpan
ss ModuleName
mn ModuleName
mn' (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProperName 'ConstructorName]
dctors forall a b. (a -> b) -> a -> b
$ \ProperName 'ConstructorName
dctor ->
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ProperName 'ConstructorName
dctor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
`find` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$ \([ProperName 'ConstructorName]
_, ExportSource
src') ->
          let mn' :: ModuleName
mn' = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src' in
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModuleName
mn forall a. Eq a => a -> a -> Bool
/= ModuleName
mn') forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> m a
throwExportConflict SourceSpan
ss ModuleName
mn ModuleName
mn' (ProperName 'ConstructorName -> Name
DctorName ProperName 'ConstructorName
dctor)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports
exps { exportedTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exportedTypes = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe ([ProperName 'ConstructorName], ExportSource)
-> Maybe ([ProperName 'ConstructorName], ExportSource)
updateOrInsert ProperName 'TypeName
name Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes }
  where
  updateOrInsert :: Maybe ([ProperName 'ConstructorName], ExportSource)
-> Maybe ([ProperName 'ConstructorName], ExportSource)
updateOrInsert Maybe ([ProperName 'ConstructorName], ExportSource)
Nothing = forall a. a -> Maybe a
Just ([ProperName 'ConstructorName]
dctors, ExportSource
src)
  updateOrInsert (Just ([ProperName 'ConstructorName]
dctors', ExportSource
_)) = forall a. a -> Maybe a
Just ([ProperName 'ConstructorName]
dctors forall a. [a] -> [a] -> [a]
++ [ProperName 'ConstructorName]
dctors', ExportSource
src)

-- |
-- Safely adds a type operator to some exports, returning an error if a
-- conflict occurs.
--
exportTypeOp
  :: MonadError MultipleErrors m
  => SourceSpan
  -> Exports
  -> OpName 'TypeOpName
  -> ExportSource
  -> m Exports
exportTypeOp :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'TypeOpName -> ExportSource -> m Exports
exportTypeOp SourceSpan
ss Exports
exps OpName 'TypeOpName
op ExportSource
src = do
  Map (OpName 'TypeOpName) ExportSource
typeOps <- forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SourceSpan
-> (a -> Name)
-> a
-> ExportSource
-> Map a ExportSource
-> m (Map a ExportSource)
addExport SourceSpan
ss OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
op ExportSource
src (Exports -> Map (OpName 'TypeOpName) ExportSource
exportedTypeOps Exports
exps)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports
exps { exportedTypeOps :: Map (OpName 'TypeOpName) ExportSource
exportedTypeOps = Map (OpName 'TypeOpName) ExportSource
typeOps }

-- |
-- Safely adds a class to some exports, returning an error if a conflict occurs.
--
exportTypeClass
  :: MonadError MultipleErrors m
  => SourceSpan
  -> ExportMode
  -> Exports
  -> ProperName 'ClassName
  -> ExportSource
  -> m Exports
exportTypeClass :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> ExportMode
-> Exports
-> ProperName 'ClassName
-> ExportSource
-> m Exports
exportTypeClass SourceSpan
ss ExportMode
exportMode Exports
exps ProperName 'ClassName
name ExportSource
src = do
  let exTypes :: Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes = Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExportMode
exportMode forall a. Eq a => a -> a -> Bool
== ExportMode
Internal) forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
name forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
name) (ProperName 'TypeName -> Name
TyName (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
name))
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` Map
  (ProperName 'TypeName)
  ([ProperName 'ConstructorName], ExportSource)
exTypes) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict (ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
name) (ProperName 'ConstructorName -> Name
DctorName (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
name))
  Map (ProperName 'ClassName) ExportSource
classes <- forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SourceSpan
-> (a -> Name)
-> a
-> ExportSource
-> Map a ExportSource
-> m (Map a ExportSource)
addExport SourceSpan
ss ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
name ExportSource
src (Exports -> Map (ProperName 'ClassName) ExportSource
exportedTypeClasses Exports
exps)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports
exps { exportedTypeClasses :: Map (ProperName 'ClassName) ExportSource
exportedTypeClasses = Map (ProperName 'ClassName) ExportSource
classes }

-- |
-- Safely adds a value to some exports, returning an error if a conflict occurs.
--
exportValue
  :: MonadError MultipleErrors m
  => SourceSpan
  -> Exports
  -> Ident
  -> ExportSource
  -> m Exports
exportValue :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan -> Exports -> Ident -> ExportSource -> m Exports
exportValue SourceSpan
ss Exports
exps Ident
name ExportSource
src = do
  Map Ident ExportSource
values <- forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SourceSpan
-> (a -> Name)
-> a
-> ExportSource
-> Map a ExportSource
-> m (Map a ExportSource)
addExport SourceSpan
ss Ident -> Name
IdentName Ident
name ExportSource
src (Exports -> Map Ident ExportSource
exportedValues Exports
exps)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports
exps { exportedValues :: Map Ident ExportSource
exportedValues = Map Ident ExportSource
values }

-- |
-- Safely adds a value operator to some exports, returning an error if a
-- conflict occurs.
--
exportValueOp
  :: MonadError MultipleErrors m
  => SourceSpan
  -> Exports
  -> OpName 'ValueOpName
  -> ExportSource
  -> m Exports
exportValueOp :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> Exports -> OpName 'ValueOpName -> ExportSource -> m Exports
exportValueOp SourceSpan
ss Exports
exps OpName 'ValueOpName
op ExportSource
src = do
  Map (OpName 'ValueOpName) ExportSource
valueOps <- forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SourceSpan
-> (a -> Name)
-> a
-> ExportSource
-> Map a ExportSource
-> m (Map a ExportSource)
addExport SourceSpan
ss OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
op ExportSource
src (Exports -> Map (OpName 'ValueOpName) ExportSource
exportedValueOps Exports
exps)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exports
exps { exportedValueOps :: Map (OpName 'ValueOpName) ExportSource
exportedValueOps = Map (OpName 'ValueOpName) ExportSource
valueOps }

-- |
-- Adds an entry to a list of exports unless it is already present, in which
-- case an error is returned.
--
addExport
  :: (MonadError MultipleErrors m, Ord a)
  => SourceSpan
  -> (a -> Name)
  -> a
  -> ExportSource
  -> M.Map a ExportSource
  -> m (M.Map a ExportSource)
addExport :: forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SourceSpan
-> (a -> Name)
-> a
-> ExportSource
-> Map a ExportSource
-> m (Map a ExportSource)
addExport SourceSpan
ss a -> Name
toName a
name ExportSource
src Map a ExportSource
exports =
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
name Map a ExportSource
exports of
    Just ExportSource
src' ->
      let
        mn :: ModuleName
mn = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src
        mn' :: ModuleName
mn' = ExportSource -> ModuleName
exportSourceDefinedIn ExportSource
src'
      in
        if ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
mn'
          then forall (m :: * -> *) a. Monad m => a -> m a
return Map a ExportSource
exports
          else forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> m a
throwExportConflict SourceSpan
ss ModuleName
mn ModuleName
mn' (a -> Name
toName a
name)
    Maybe ExportSource
Nothing ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
name ExportSource
src Map a ExportSource
exports

-- |
-- Raises an error for when there is more than one definition for something.
--
throwDeclConflict
  :: MonadError MultipleErrors m
  => Name
  -> Name
  -> m a
throwDeclConflict :: forall (m :: * -> *) a.
MonadError MultipleErrors m =>
Name -> Name -> m a
throwDeclConflict Name
new Name
existing =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleErrorMessage -> MultipleErrors
errorMessage forall a b. (a -> b) -> a -> b
$ Name -> Name -> SimpleErrorMessage
DeclConflict Name
new Name
existing

-- |
-- Raises an error for when there are conflicting names in the exports.
--
throwExportConflict
  :: MonadError MultipleErrors m
  => SourceSpan
  -> ModuleName
  -> ModuleName
  -> Name
  -> m a
throwExportConflict :: forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> m a
throwExportConflict SourceSpan
ss ModuleName
new ModuleName
existing Name
name =
  forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> Name -> m a
throwExportConflict' SourceSpan
ss ModuleName
new ModuleName
existing Name
name Name
name

-- |
-- Raises an error for when there are conflicting names in the exports. Allows
-- different categories of names. E.g. class and type names conflicting.
--
throwExportConflict'
  :: MonadError MultipleErrors m
  => SourceSpan
  -> ModuleName
  -> ModuleName
  -> Name
  -> Name
  -> m a
throwExportConflict' :: forall (m :: * -> *) a.
MonadError MultipleErrors m =>
SourceSpan -> ModuleName -> ModuleName -> Name -> Name -> m a
throwExportConflict' SourceSpan
ss ModuleName
new ModuleName
existing Name
newName Name
existingName =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$
    Qualified Name -> Qualified Name -> SimpleErrorMessage
ExportConflict (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
new) Name
newName) (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
existing) Name
existingName)

-- |
-- When reading a value from the imports, check that there are no conflicts in
-- scope.
--
checkImportConflicts
  :: forall m a
   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
  => SourceSpan
  -> ModuleName
  -> (a -> Name)
  -> [ImportRecord a]
  -> m (ModuleName, ModuleName)
checkImportConflicts :: forall (m :: * -> *) a.
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
SourceSpan
-> ModuleName
-> (a -> Name)
-> [ImportRecord a]
-> m (ModuleName, ModuleName)
checkImportConflicts SourceSpan
ss ModuleName
currentModule a -> Name
toName [ImportRecord a]
xs =
  let
    byOrig :: [ImportRecord a]
byOrig = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. ImportRecord a -> ModuleName
importSourceModule [ImportRecord a]
xs
    groups :: [[ImportRecord a]]
groups = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. ImportRecord a -> ModuleName
importSourceModule) [ImportRecord a]
byOrig
    nonImplicit :: [ImportRecord a]
nonImplicit = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= ImportProvenance
FromImplicit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ImportRecord a -> ImportProvenance
importProvenance) [ImportRecord a]
xs
    name :: Name
name = a -> Name
toName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Qualified a -> a
disqualify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ImportRecord a -> Qualified a
importName forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ImportRecord a]
xs
    conflictModules :: [ModuleName]
conflictModules = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. Qualified a -> Maybe ModuleName
getQual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ImportRecord a -> Qualified a
importName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) [[ImportRecord a]]
groups
  in
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ImportRecord a]]
groups forall a. Ord a => a -> a -> Bool
> Int
1
    then case [ImportRecord a]
nonImplicit of
      [ImportRecord (Qualified (ByModuleName ModuleName
mnNew) a
_) ModuleName
mnOrig SourceSpan
_ ImportProvenance
_] -> do
        let warningModule :: Maybe ModuleName
warningModule = if ModuleName
mnNew forall a. Eq a => a -> a -> Bool
== ModuleName
currentModule then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ModuleName
mnNew
            ss' :: SourceSpan
ss' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SourceSpan
nullSourceSpan forall a. ImportRecord a -> SourceSpan
importSourceSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
headMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== ImportProvenance
FromImplicit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ImportRecord a -> ImportProvenance
importProvenance) forall a b. (a -> b) -> a -> b
$ [ImportRecord a]
xs
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss' forall a b. (a -> b) -> a -> b
$ Name -> Maybe ModuleName -> [ModuleName] -> SimpleErrorMessage
ScopeShadowing Name
name Maybe ModuleName
warningModule forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete ModuleName
mnNew [ModuleName]
conflictModules
        forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
mnNew, ModuleName
mnOrig)
      [ImportRecord a]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ Name -> [ModuleName] -> SimpleErrorMessage
ScopeConflict Name
name [ModuleName]
conflictModules
    else
      case forall a. [a] -> a
head [ImportRecord a]
byOrig of
        ImportRecord (Qualified (ByModuleName ModuleName
mnNew) a
_) ModuleName
mnOrig SourceSpan
_ ImportProvenance
_ ->
          forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
mnNew, ModuleName
mnOrig)
        ImportRecord a
_ ->
          forall a. HasCallStack => String -> a
internalError String
"checkImportConflicts: ImportRecord should be qualified"