module Language.PureScript.Linter.Imports
  ( lintImports
  , Name(..)
  , UsedImports()
  ) where

import Prelude
import Protolude (ordNub)

import Control.Monad (join, unless, foldM, (<=<))
import Control.Monad.Writer.Class (MonadWriter(..))

import Data.Function (on)
import Data.Foldable (for_)
import Data.List (find, intersect, groupBy, sort, sortOn, (\\))
import Data.Maybe (mapMaybe)
import Data.Monoid (Sum(..))
import Data.Traversable (forM)
import Data.Text qualified as T
import Data.Map qualified as M

import Language.PureScript.AST.Declarations (Declaration(..), DeclarationRef(..), ExportSource, ImportDeclarationType(..), Module(..), getTypeRef, isExplicit)
import Language.PureScript.AST.SourcePos (SourceSpan)
import Language.PureScript.Crash (internalError)
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage(..), errorMessage')
import Language.PureScript.Names
import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)
import Language.PureScript.Sugar.Names.Env (Env, Exports(..), ImportRecord(..), Imports(..), envModuleExports, nullImports)
import Language.PureScript.Sugar.Names.Imports (ImportDef, findImports)
import Language.PureScript.Constants.Prim qualified as C

-- |
-- Map of module name to list of imported names from that module which have
-- been used.
--
type UsedImports = M.Map ModuleName [Qualified Name]

-- |
-- Find and warn on:
--
-- * Unused import statements (qualified or unqualified)
--
-- * Unused references in an explicit import list
--
-- * Implicit imports of modules
--
-- * Implicit imports into a virtual module (unless the virtual module only has
--   members from one module imported)
--
-- * Imports using `hiding` (this is another form of implicit importing)
--
lintImports
  :: forall m
   . MonadWriter MultipleErrors m
  => Module
  -> Env
  -> UsedImports
  -> m ()
lintImports :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Module -> Env -> UsedImports -> m ()
lintImports (Module SourceSpan
_ [Comment]
_ ModuleName
_ [Declaration]
_ Maybe [DeclarationRef]
Nothing) Env
_ UsedImports
_ =
  forall a. HasCallStack => [Char] -> a
internalError [Char]
"lintImports needs desugared exports"
lintImports (Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
mdecls (Just [DeclarationRef]
mexports)) Env
env UsedImports
usedImps = do

  -- TODO: this needs some work to be easier to understand

  let scope :: Imports
scope = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Imports
nullImports (\(SourceSpan
_, Imports
imps', Exports
_) -> Imports
imps') (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mn Env
env)
      usedImps' :: UsedImports
usedImps' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Imports -> ModuleName -> UsedImports -> UsedImports
elaborateUsed Imports
scope) UsedImports
usedImps [ModuleName]
exportedModules
      numOpenImports :: Int
numOpenImports = forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Sum a
Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Int
countOpenImports) [Declaration]
mdecls
      allowImplicit :: Bool
allowImplicit = Int
numOpenImports forall a. Eq a => a -> a -> Bool
== Int
1
      imports :: [(ModuleName, [ImportDef])]
imports = forall k a. Map k a -> [(k, a)]
M.toAscList ([Declaration] -> Map ModuleName [ImportDef]
findImports [Declaration]
mdecls)

  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(ModuleName, [ImportDef])]
imports forall a b. (a -> b) -> a -> b
$ \(ModuleName
mni, [ImportDef]
decls) ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ModuleName -> Bool
isPrim ModuleName
mni) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ImportDef]
decls forall a b. (a -> b) -> a -> b
$ \(SourceSpan
ss, ImportDeclarationType
declType, Maybe ModuleName
qualifierName) -> do
        let names :: [Qualified Name]
names = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] ModuleName
mni UsedImports
usedImps'
        forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> SourceSpan
-> ImportDeclarationType
-> Bool
-> m Bool
lintImportDecl Env
env ModuleName
mni Maybe ModuleName
qualifierName [Qualified Name]
names SourceSpan
ss ImportDeclarationType
declType Bool
allowImplicit

  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall k a. Map k a -> [(k, a)]
M.toAscList ([(ModuleName, [ImportDef])]
-> Map ModuleName [(SourceSpan, ImportDeclarationType, ModuleName)]
byQual [(ModuleName, [ImportDef])]
imports)) forall a b. (a -> b) -> a -> b
$ \(ModuleName
mnq, [(SourceSpan, ImportDeclarationType, ModuleName)]
entries) -> do
    let mnis :: [ModuleName]
mnis = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(SourceSpan
_, ImportDeclarationType
_, ModuleName
mni) -> ModuleName
mni) [(SourceSpan, ImportDeclarationType, ModuleName)]
entries
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleName]
mnis forall a. Eq a => a -> a -> Bool
== Int
1) forall a b. (a -> b) -> a -> b
$ do
      let implicits :: [(SourceSpan, ImportDeclarationType, ModuleName)]
implicits = forall a. (a -> Bool) -> [a] -> [a]
filter (\(SourceSpan
_, ImportDeclarationType
declType, ModuleName
_) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ImportDeclarationType -> Bool
isExplicit ImportDeclarationType
declType) [(SourceSpan, ImportDeclarationType, ModuleName)]
entries
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(SourceSpan, ImportDeclarationType, ModuleName)]
implicits forall a b. (a -> b) -> a -> b
$ \(SourceSpan
ss, ImportDeclarationType
_, ModuleName
mni) -> do
        let names :: [Qualified Name]
names = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] ModuleName
mni UsedImports
usedImps'
            usedRefs :: [DeclarationRef]
usedRefs = SourceSpan
-> Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> [DeclarationRef]
findUsedRefs SourceSpan
ss Env
env ModuleName
mni (forall a. a -> Maybe a
Just ModuleName
mnq) [Qualified Name]
names
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DeclarationRef]
usedRefs) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          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
$ ModuleName -> ModuleName -> [DeclarationRef] -> SimpleErrorMessage
ImplicitQualifiedImport ModuleName
mni ModuleName
mnq forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True) [DeclarationRef]
usedRefs

  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(ModuleName, [ImportDef])]
imports forall a b. (a -> b) -> a -> b
$ \(ModuleName
mnq, [ImportDef]
imps) -> do

    [ImportDef]
warned <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall (m :: * -> *).
MonadWriter MultipleErrors m =>
ModuleName
-> [ImportDef] -> (ImportDef, ImportDef) -> m [ImportDef]
checkDuplicateImports ModuleName
mnq) [] (forall a. [a] -> [(a, a)]
selfCartesianSubset [ImportDef]
imps)

    let unwarned :: [ImportDef]
unwarned = [ImportDef]
imps forall a. Eq a => [a] -> [a] -> [a]
\\ [ImportDef]
warned
        duplicates :: [ImportDef]
duplicates
          = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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` ImportDef -> Maybe ModuleName
defQual)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ImportDef -> Maybe ModuleName
defQual
          forall a b. (a -> b) -> a -> b
$ [ImportDef]
unwarned

    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ImportDef]
duplicates forall a b. (a -> b) -> a -> b
$ \(SourceSpan
pos, ImportDeclarationType
_, Maybe ModuleName
_) ->
      forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
pos forall a b. (a -> b) -> a -> b
$ ModuleName -> SimpleErrorMessage
DuplicateSelectiveImport ModuleName
mnq

    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ImportDef]
imps forall a. Eq a => [a] -> [a] -> [a]
\\ ([ImportDef]
warned forall a. [a] -> [a] -> [a]
++ [ImportDef]
duplicates)) forall a b. (a -> b) -> a -> b
$ \(SourceSpan
pos, ImportDeclarationType
typ, Maybe ModuleName
_) ->
      forall (m :: * -> *).
MonadWriter MultipleErrors m =>
SourceSpan
-> (Name -> SimpleErrorMessage) -> [DeclarationRef] -> m ()
warnDuplicateRefs SourceSpan
pos Name -> SimpleErrorMessage
DuplicateImportRef forall a b. (a -> b) -> a -> b
$ case ImportDeclarationType
typ of
        Explicit [DeclarationRef]
refs -> [DeclarationRef]
refs
        Hiding [DeclarationRef]
refs -> [DeclarationRef]
refs
        ImportDeclarationType
_ -> []

  -- Check re-exported modules to see if we are re-exporting a qualified module
  -- that has unspecified imports.
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DeclarationRef]
mexports forall a b. (a -> b) -> a -> b
$ \case
    ModuleRef SourceSpan
_ ModuleName
mnq ->
      case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mnq ([(ModuleName, [ImportDef])]
-> Map ModuleName [(SourceSpan, ImportDeclarationType, ModuleName)]
byQual [(ModuleName, [ImportDef])]
imports) of
        -- We only match the single-entry case here as otherwise there will be
        -- a different warning about implicit imports potentially colliding
        -- anyway
        Just [(SourceSpan
ss, ImportDeclarationType
Implicit, ModuleName
mni)] -> do
          let names :: [Qualified Name]
names = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] ModuleName
mni UsedImports
usedImps'
              usedRefs :: [DeclarationRef]
usedRefs = SourceSpan
-> Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> [DeclarationRef]
findUsedRefs SourceSpan
ss Env
env ModuleName
mni (forall a. a -> Maybe a
Just ModuleName
mnq) [Qualified Name]
names
          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
$
            ModuleName -> ModuleName -> [DeclarationRef] -> SimpleErrorMessage
ImplicitQualifiedImportReExport ModuleName
mni ModuleName
mnq
              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True) [DeclarationRef]
usedRefs
        Maybe [(SourceSpan, ImportDeclarationType, ModuleName)]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    DeclarationRef
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  where

  defQual :: ImportDef -> Maybe ModuleName
  defQual :: ImportDef -> Maybe ModuleName
defQual (SourceSpan
_, ImportDeclarationType
_, Maybe ModuleName
q) = Maybe ModuleName
q

  selfCartesianSubset :: [a] -> [(a, a)]
  selfCartesianSubset :: forall a. [a] -> [(a, a)]
selfCartesianSubset (a
x : [a]
xs) = [(a
x, a
y) | a
y <- [a]
xs] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [(a, a)]
selfCartesianSubset [a]
xs
  selfCartesianSubset [] = []

  countOpenImports :: Declaration -> Int
  countOpenImports :: Declaration -> Int
countOpenImports (ImportDeclaration SourceAnn
_ ModuleName
mn' ImportDeclarationType
Implicit Maybe ModuleName
Nothing)
    | Bool -> Bool
not (ModuleName -> Bool
isPrim ModuleName
mn' Bool -> Bool -> Bool
|| ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
mn') = Int
1
  countOpenImports (ImportDeclaration SourceAnn
_ ModuleName
mn' (Hiding [DeclarationRef]
_) Maybe ModuleName
Nothing)
    | Bool -> Bool
not (ModuleName -> Bool
isPrim ModuleName
mn' Bool -> Bool -> Bool
|| ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
mn') = Int
1
  countOpenImports Declaration
_ = Int
0

  -- Checks whether a module is the Prim module - used to suppress any checks
  -- made, as Prim is always implicitly imported.
  isPrim :: ModuleName -> Bool
  isPrim :: ModuleName -> Bool
isPrim = (forall a. Eq a => a -> a -> Bool
== ModuleName
C.M_Prim)

  -- Creates a map of virtual modules mapped to all the declarations that
  -- import to that module, with the corresponding source span, import type,
  -- and module being imported
  byQual
    :: [(ModuleName, [(SourceSpan, ImportDeclarationType, Maybe ModuleName)])]
    -> M.Map ModuleName [(SourceSpan, ImportDeclarationType, ModuleName)]
  byQual :: [(ModuleName, [ImportDef])]
-> Map ModuleName [(SourceSpan, ImportDeclarationType, ModuleName)]
byQual = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {t :: * -> *} {k} {c} {a} {b}.
(Foldable t, Ord k) =>
(c, t (a, b, Maybe k)) -> Map k [(a, b, c)] -> Map k [(a, b, c)]
goImp forall k a. Map k a
M.empty
    where
    goImp :: (c, t (a, b, Maybe k)) -> Map k [(a, b, c)] -> Map k [(a, b, c)]
goImp (c
mni, t (a, b, Maybe k)
xs) Map k [(a, b, c)]
acc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {k} {c} {a} {b}.
Ord k =>
c -> (a, b, Maybe k) -> Map k [(a, b, c)] -> Map k [(a, b, c)]
goDecl c
mni) Map k [(a, b, c)]
acc t (a, b, Maybe k)
xs
    goDecl :: c -> (a, b, Maybe k) -> Map k [(a, b, c)] -> Map k [(a, b, c)]
goDecl c
mni (a
ss', b
declType, Just k
qmn) Map k [(a, b, c)]
acc =
      let entry :: (a, b, c)
entry = (a
ss', b
declType, c
mni)
      in forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(a, b, c)
entry] ((a, b, c)
entry forall a. a -> [a] -> [a]
:)) k
qmn Map k [(a, b, c)]
acc
    goDecl c
_ (a, b, Maybe k)
_ Map k [(a, b, c)]
acc = Map k [(a, b, c)]
acc

  -- The list of modules that are being re-exported by the current module. Any
  -- module that appears in this list is always considered to be used.
  exportedModules :: [ModuleName]
  exportedModules :: [ModuleName]
exportedModules = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe ModuleName
extractModule [DeclarationRef]
mexports
    where
    extractModule :: DeclarationRef -> Maybe ModuleName
extractModule (ModuleRef SourceSpan
_ ModuleName
mne) = forall a. a -> Maybe a
Just ModuleName
mne
    extractModule DeclarationRef
_ = forall a. Maybe a
Nothing

  -- Elaborates the UsedImports to include values from modules that are being
  -- re-exported. This ensures explicit export hints are printed for modules
  -- that are implicitly exported and then re-exported.
  elaborateUsed :: Imports -> ModuleName -> UsedImports -> UsedImports
  elaborateUsed :: Imports -> ModuleName -> UsedImports -> UsedImports
elaborateUsed Imports
scope ModuleName
mne UsedImports
used =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleName, Qualified Name) -> UsedImports -> UsedImports
go UsedImports
used
      forall a b. (a -> b) -> a -> b
$ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap (ProperName 'ClassName)
importedTypeClasses Imports
scope) ProperName 'ClassName -> Name
TyClassName
      forall a. [a] -> [a] -> [a]
++ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap (OpName 'TypeOpName)
importedTypeOps Imports
scope) OpName 'TypeOpName -> Name
TyOpName
      forall a. [a] -> [a] -> [a]
++ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap (ProperName 'TypeName)
importedTypes Imports
scope) ProperName 'TypeName -> Name
TyName
      forall a. [a] -> [a] -> [a]
++ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap (ProperName 'ConstructorName)
importedDataConstructors Imports
scope) ProperName 'ConstructorName -> Name
DctorName
      forall a. [a] -> [a] -> [a]
++ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap Ident
importedValues Imports
scope) Ident -> Name
IdentName
      forall a. [a] -> [a] -> [a]
++ forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
mne (Imports -> ImportMap (OpName 'ValueOpName)
importedValueOps Imports
scope) OpName 'ValueOpName -> Name
ValOpName
    where
    go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports
    go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports
go (ModuleName
q, Qualified Name
name) = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Qualified Name
name] (Qualified Name
name forall a. a -> [a] -> [a]
:)) ModuleName
q

  extractByQual
    :: ModuleName
    -> M.Map (Qualified a) [ImportRecord a]
    -> (a -> Name)
    -> [(ModuleName, Qualified Name)]
  extractByQual :: forall a.
ModuleName
-> Map (Qualified a) [ImportRecord a]
-> (a -> Name)
-> [(ModuleName, Qualified Name)]
extractByQual ModuleName
k Map (Qualified a) [ImportRecord a]
m a -> Name
toName = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Qualified a, [ImportRecord a])
-> Maybe (ModuleName, Qualified Name)
go (forall k a. Map k a -> [(k, a)]
M.toList Map (Qualified a) [ImportRecord a]
m)
    where
    go :: (Qualified a, [ImportRecord a])
-> Maybe (ModuleName, Qualified Name)
go (q :: Qualified a
q@(Qualified QualifiedBy
mnq a
_), [ImportRecord a]
is)
      | forall a. Qualified a -> Bool
isUnqualified Qualified a
q =
          case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
k) (forall a b. (a -> b) -> [a] -> [b]
map forall a. ImportRecord a -> Qualified a
importName [ImportRecord a]
is) of
            Just (Qualified QualifiedBy
_ a
name) -> forall a. a -> Maybe a
Just (ModuleName
k, forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
mnq (a -> Name
toName a
name))
            Maybe (Qualified a)
_ -> forall a. Maybe a
Nothing
      | forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
k Qualified a
q =
          case forall a. ImportRecord a -> Qualified a
importName (forall a. [a] -> a
head [ImportRecord a]
is) of
            Qualified (ByModuleName ModuleName
mn') a
name -> forall a. a -> Maybe a
Just (ModuleName
mn', forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
mnq (a -> Name
toName a
name))
            Qualified a
_ -> forall a. HasCallStack => [Char] -> a
internalError [Char]
"unqualified name in extractByQual"
    go (Qualified a, [ImportRecord a])
_ = forall a. Maybe a
Nothing


-- Replace explicit type refs with data constructor lists from listing the
-- used constructors explicitly `T(X, Y, [...])` to `T(..)` for suggestion
-- message.
-- Done everywhere when suggesting a completely new explicit imports list, otherwise
-- maintain the existing form.
simplifyTypeRef :: (ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef :: (ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef ProperName 'TypeName -> Bool
shouldOpen (TypeRef SourceSpan
ss ProperName 'TypeName
name (Just [ProperName 'ConstructorName]
dctors))
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProperName 'ConstructorName]
dctors) Bool -> Bool -> Bool
&& ProperName 'TypeName -> Bool
shouldOpen ProperName 'TypeName
name = SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss ProperName 'TypeName
name forall a. Maybe a
Nothing
simplifyTypeRef ProperName 'TypeName -> Bool
_ DeclarationRef
other = DeclarationRef
other

lintImportDecl
  :: forall m
   . MonadWriter MultipleErrors m
  => Env
  -> ModuleName
  -> Maybe ModuleName
  -> [Qualified Name]
  -> SourceSpan
  -> ImportDeclarationType
  -> Bool
  -> m Bool
lintImportDecl :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> SourceSpan
-> ImportDeclarationType
-> Bool
-> m Bool
lintImportDecl Env
env ModuleName
mni Maybe ModuleName
qualifierName [Qualified Name]
names SourceSpan
ss ImportDeclarationType
declType Bool
allowImplicit =
  case ImportDeclarationType
declType of
    ImportDeclarationType
Implicit -> case Maybe ModuleName
qualifierName of
      Maybe ModuleName
Nothing ->
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DeclarationRef]
allRefs
        then m Bool
unused
        else Bool -> m Bool -> m Bool
unless' Bool
allowImplicit ((ModuleName -> [DeclarationRef] -> SimpleErrorMessage) -> m Bool
checkImplicit ModuleName -> [DeclarationRef] -> SimpleErrorMessage
ImplicitImport)
      Just ModuleName
q -> Bool -> m Bool -> m Bool
unless' (ModuleName
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Qualified a -> Maybe ModuleName
getQual [Qualified Name]
names) m Bool
unused
    Hiding [DeclarationRef]
_ -> Bool -> m Bool -> m Bool
unless' Bool
allowImplicit ((ModuleName -> [DeclarationRef] -> SimpleErrorMessage) -> m Bool
checkImplicit ModuleName -> [DeclarationRef] -> SimpleErrorMessage
HidingImport)
    Explicit [] -> m Bool
unused
    Explicit [DeclarationRef]
declrefs -> [DeclarationRef] -> m Bool
checkExplicit [DeclarationRef]
declrefs

  where

  checkImplicit
    :: (ModuleName -> [DeclarationRef] -> SimpleErrorMessage)
    -> m Bool
  checkImplicit :: (ModuleName -> [DeclarationRef] -> SimpleErrorMessage) -> m Bool
checkImplicit ModuleName -> [DeclarationRef] -> SimpleErrorMessage
warning =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DeclarationRef]
allRefs
    then m Bool
unused
    else SimpleErrorMessage -> m Bool
warn (ModuleName -> [DeclarationRef] -> SimpleErrorMessage
warning ModuleName
mni (forall a b. (a -> b) -> [a] -> [b]
map ((ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True) [DeclarationRef]
allRefs))

  checkExplicit
    :: [DeclarationRef]
    -> m Bool
  checkExplicit :: [DeclarationRef] -> m Bool
checkExplicit [DeclarationRef]
declrefs = do
    let idents :: [Name]
idents = forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe Name
runDeclRef [DeclarationRef]
declrefs)
        dctors :: [ProperName 'ConstructorName]
dctors = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (ProperName 'ConstructorName)
getDctorName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qualifierName) [Qualified Name]
names
        usedNames :: [Name]
usedNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ProperName 'ConstructorName -> Maybe (ProperName 'TypeName))
-> Name -> Maybe Name
matchName (ModuleName
-> ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
typeForDCtor ModuleName
mni) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qualifierName) [Qualified Name]
names
        diff :: [Name]
diff = [Name]
idents forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
usedNames

    Bool
didWarn <- case (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
diff, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
idents) of
      (Int
0, Int
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      (Int
n, Int
m) | Int
n forall a. Eq a => a -> a -> Bool
== Int
m -> m Bool
unused
      (Int, Int)
_ -> SimpleErrorMessage -> m Bool
warn (ModuleName
-> [Name]
-> Maybe ModuleName
-> [DeclarationRef]
-> SimpleErrorMessage
UnusedExplicitImport ModuleName
mni [Name]
diff Maybe ModuleName
qualifierName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> DeclarationRef
simplifyTypeRef' [DeclarationRef]
allRefs)

    [Bool]
didWarn' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
getTypeRef [DeclarationRef]
declrefs) forall a b. (a -> b) -> a -> b
$ \(ProperName 'TypeName
tn, Maybe [ProperName 'ConstructorName]
c) -> do
      let allCtors :: [ProperName 'ConstructorName]
allCtors = ModuleName -> ProperName 'TypeName -> [ProperName 'ConstructorName]
dctorsForType ModuleName
mni ProperName 'TypeName
tn
      -- If we've not already warned a type is unused, check its data constructors
      Bool -> m Bool -> m Bool
unless' (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
tn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
usedNames) forall a b. (a -> b) -> a -> b
$
        case (Maybe [ProperName 'ConstructorName]
c, [ProperName 'ConstructorName]
dctors forall a. Eq a => [a] -> [a] -> [a]
`intersect` [ProperName 'ConstructorName]
allCtors) of
          (Maybe [ProperName 'ConstructorName]
_, []) | Maybe [ProperName 'ConstructorName]
c forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just [] -> SimpleErrorMessage -> m Bool
warn (ModuleName
-> ProperName 'TypeName
-> Maybe ModuleName
-> [DeclarationRef]
-> SimpleErrorMessage
UnusedDctorImport ModuleName
mni ProperName 'TypeName
tn Maybe ModuleName
qualifierName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> DeclarationRef
simplifyTypeRef' [DeclarationRef]
allRefs)
          (Just [ProperName 'ConstructorName]
ctors, [ProperName 'ConstructorName]
dctors') ->
            let ddiff :: [ProperName 'ConstructorName]
ddiff = [ProperName 'ConstructorName]
ctors forall a. Eq a => [a] -> [a] -> [a]
\\ [ProperName 'ConstructorName]
dctors'
            in Bool -> m Bool -> m Bool
unless' (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProperName 'ConstructorName]
ddiff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleErrorMessage -> m Bool
warn forall a b. (a -> b) -> a -> b
$ ModuleName
-> ProperName 'TypeName
-> [ProperName 'ConstructorName]
-> Maybe ModuleName
-> [DeclarationRef]
-> SimpleErrorMessage
UnusedDctorExplicitImport ModuleName
mni ProperName 'TypeName
tn [ProperName 'ConstructorName]
ddiff Maybe ModuleName
qualifierName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> DeclarationRef
simplifyTypeRef' [DeclarationRef]
allRefs
          (Maybe [ProperName 'ConstructorName],
 [ProperName 'ConstructorName])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
didWarn Bool -> Bool -> Bool
|| forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
didWarn')

    where
      simplifyTypeRef' :: DeclarationRef -> DeclarationRef
      simplifyTypeRef' :: DeclarationRef -> DeclarationRef
simplifyTypeRef' = (ProperName 'TypeName -> Bool) -> DeclarationRef -> DeclarationRef
simplifyTypeRef (\ProperName 'TypeName
name -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ProperName 'TypeName -> DeclarationRef -> Bool
isMatch ProperName 'TypeName
name) [DeclarationRef]
declrefs)
        where
          isMatch :: ProperName 'TypeName -> DeclarationRef -> Bool
isMatch ProperName 'TypeName
name (TypeRef SourceSpan
_ ProperName 'TypeName
name' Maybe [ProperName 'ConstructorName]
Nothing) = ProperName 'TypeName
name forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
name'
          isMatch ProperName 'TypeName
_ DeclarationRef
_ = Bool
False

  unused :: m Bool
  unused :: m Bool
unused = SimpleErrorMessage -> m Bool
warn (ModuleName -> Maybe ModuleName -> SimpleErrorMessage
UnusedImport ModuleName
mni Maybe ModuleName
qualifierName)

  warn :: SimpleErrorMessage -> m Bool
  warn :: SimpleErrorMessage -> m Bool
warn SimpleErrorMessage
err = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss SimpleErrorMessage
err) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  -- Unless the boolean is true, run the action. Return false when the action is
  -- not run, otherwise return whatever the action does.
  --
  -- The return value is intended for cases where we want to track whether some
  -- work was done, as there may be further conditions in the action that mean
  -- it ends up doing nothing.
  unless' :: Bool -> m Bool -> m Bool
  unless' :: Bool -> m Bool -> m Bool
unless' Bool
False m Bool
m = m Bool
m
  unless' Bool
True m Bool
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  allRefs :: [DeclarationRef]
  allRefs :: [DeclarationRef]
allRefs = SourceSpan
-> Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> [DeclarationRef]
findUsedRefs SourceSpan
ss Env
env ModuleName
mni Maybe ModuleName
qualifierName [Qualified Name]
names

  dtys
    :: ModuleName
    -> M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)
  dtys :: ModuleName
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
dtys ModuleName
mn = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b, Exports) -> Exports
envModuleExports) forall a b. (a -> b) -> a -> b
$ ModuleName
mn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Env
env

  dctorsForType
    :: ModuleName
    -> ProperName 'TypeName
    -> [ProperName 'ConstructorName]
  dctorsForType :: ModuleName -> ProperName 'TypeName -> [ProperName 'ConstructorName]
dctorsForType ModuleName
mn ProperName 'TypeName
tn = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ProperName 'TypeName
tn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` ModuleName
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
dtys ModuleName
mn

  typeForDCtor
    :: ModuleName
    -> ProperName 'ConstructorName
    -> Maybe (ProperName 'TypeName)
  typeForDCtor :: ModuleName
-> ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
typeForDCtor ModuleName
mn ProperName 'ConstructorName
pn = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ProperName 'ConstructorName
pn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k a. Map k a -> [(k, a)]
M.toList (ModuleName
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
dtys ModuleName
mn))

findUsedRefs
  :: SourceSpan
  -> Env
  -> ModuleName
  -> Maybe ModuleName
  -> [Qualified Name]
  -> [DeclarationRef]
findUsedRefs :: SourceSpan
-> Env
-> ModuleName
-> Maybe ModuleName
-> [Qualified Name]
-> [DeclarationRef]
findUsedRefs SourceSpan
ss Env
env ModuleName
mni Maybe ModuleName
qn [Qualified Name]
names =
  let
    classRefs :: [DeclarationRef]
classRefs = SourceSpan -> ProperName 'ClassName -> DeclarationRef
TypeClassRef SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (ProperName 'ClassName)
getClassName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    valueRefs :: [DeclarationRef]
valueRefs = SourceSpan -> Ident -> DeclarationRef
ValueRef SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe Ident
getIdentName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    valueOpRefs :: [DeclarationRef]
valueOpRefs = SourceSpan -> OpName 'ValueOpName -> DeclarationRef
ValueOpRef SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (OpName 'ValueOpName)
getValOpName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    typeOpRefs :: [DeclarationRef]
typeOpRefs = SourceSpan -> OpName 'TypeOpName -> DeclarationRef
TypeOpRef SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (OpName 'TypeOpName)
getTypeOpName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    types :: [ProperName 'TypeName]
types = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (ProperName 'TypeName)
getTypeName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    dctors :: [ProperName 'ConstructorName]
dctors = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe (ProperName 'ConstructorName)
getDctorName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Maybe ModuleName -> Qualified a -> Maybe a
disqualifyFor Maybe ModuleName
qn) [Qualified Name]
names
    typesWithDctors :: Map (ProperName 'TypeName) [ProperName 'ConstructorName]
typesWithDctors = [ProperName 'ConstructorName]
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
reconstructTypeRefs [ProperName 'ConstructorName]
dctors
    typesWithoutDctors :: [ProperName 'TypeName]
typesWithoutDctors = forall a. (a -> Bool) -> [a] -> [a]
filter (forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map (ProperName 'TypeName) [ProperName 'ConstructorName]
typesWithDctors) [ProperName 'TypeName]
types
    typesRefs :: [DeclarationRef]
typesRefs
      = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss) (forall a. a -> Maybe a
Just [])) [ProperName 'TypeName]
typesWithoutDctors
      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(ProperName 'TypeName
ty, [ProperName 'ConstructorName]
ds) -> SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
ss ProperName 'TypeName
ty (forall a. a -> Maybe a
Just [ProperName 'ConstructorName]
ds)) (forall k a. Map k a -> [(k, a)]
M.toList Map (ProperName 'TypeName) [ProperName 'ConstructorName]
typesWithDctors)
  in forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [DeclarationRef]
classRefs forall a. [a] -> [a] -> [a]
++ [DeclarationRef]
typeOpRefs forall a. [a] -> [a] -> [a]
++ [DeclarationRef]
typesRefs forall a. [a] -> [a] -> [a]
++ [DeclarationRef]
valueRefs forall a. [a] -> [a] -> [a]
++ [DeclarationRef]
valueOpRefs

  where

  reconstructTypeRefs
    :: [ProperName 'ConstructorName]
    -> M.Map (ProperName 'TypeName) [ProperName 'ConstructorName]
  reconstructTypeRefs :: [ProperName 'ConstructorName]
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
reconstructTypeRefs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ProperName 'ConstructorName
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
accumDctors forall k a. Map k a
M.empty
    where
    accumDctors :: ProperName 'ConstructorName
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
-> Map (ProperName 'TypeName) [ProperName 'ConstructorName]
accumDctors ProperName 'ConstructorName
dctor =
      forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ProperName 'ConstructorName
dctor] (ProperName 'ConstructorName
dctor forall a. a -> [a] -> [a]
:)) (ModuleName -> ProperName 'ConstructorName -> ProperName 'TypeName
findTypeForDctor ModuleName
mni ProperName 'ConstructorName
dctor)

  findTypeForDctor
    :: ModuleName
    -> ProperName 'ConstructorName
    -> ProperName 'TypeName
  findTypeForDctor :: ModuleName -> ProperName 'ConstructorName -> ProperName 'TypeName
findTypeForDctor ModuleName
mn ProperName 'ConstructorName
dctor =
    case ModuleName
mn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Env
env of
      Just (SourceSpan
_, Imports
_, Exports
exps) ->
        case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k a. Map k a -> [(k, a)]
M.toList (Exports
-> Map
     (ProperName 'TypeName)
     ([ProperName 'ConstructorName], ExportSource)
exportedTypes Exports
exps)) of
          Just (ProperName 'TypeName
ty, ([ProperName 'ConstructorName], ExportSource)
_) -> ProperName 'TypeName
ty
          Maybe
  (ProperName 'TypeName,
   ([ProperName 'ConstructorName], ExportSource))
Nothing -> forall a. HasCallStack => [Char] -> a
internalError forall a b. (a -> b) -> a -> b
$ [Char]
"missing type for data constructor " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (forall (a :: ProperNameType). ProperName a -> Text
runProperName ProperName 'ConstructorName
dctor) forall a. [a] -> [a] -> [a]
++ [Char]
" in findTypeForDctor"
      Maybe (SourceSpan, Imports, Exports)
Nothing -> forall a. HasCallStack => [Char] -> a
internalError forall a b. (a -> b) -> a -> b
$ [Char]
"missing module " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (ModuleName -> Text
runModuleName ModuleName
mn)  forall a. [a] -> [a] -> [a]
++ [Char]
" in findTypeForDctor"

matchName
  :: (ProperName 'ConstructorName -> Maybe (ProperName 'TypeName))
  -> Name
  -> Maybe Name
matchName :: (ProperName 'ConstructorName -> Maybe (ProperName 'TypeName))
-> Name -> Maybe Name
matchName ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
lookupDc (DctorName ProperName 'ConstructorName
x) = ProperName 'TypeName -> Name
TyName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
lookupDc ProperName 'ConstructorName
x
matchName ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
_ ModName{} = forall a. Maybe a
Nothing
matchName ProperName 'ConstructorName -> Maybe (ProperName 'TypeName)
_ Name
name = forall a. a -> Maybe a
Just Name
name

runDeclRef :: DeclarationRef -> Maybe Name
runDeclRef :: DeclarationRef -> Maybe Name
runDeclRef (ValueRef SourceSpan
_ Ident
ident) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ident -> Name
IdentName Ident
ident
runDeclRef (ValueOpRef SourceSpan
_ OpName 'ValueOpName
op) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
op
runDeclRef (TypeRef SourceSpan
_ ProperName 'TypeName
pn Maybe [ProperName 'ConstructorName]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ProperName 'TypeName -> Name
TyName ProperName 'TypeName
pn
runDeclRef (TypeOpRef SourceSpan
_ OpName 'TypeOpName
op) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
op
runDeclRef (TypeClassRef SourceSpan
_ ProperName 'ClassName
pn) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
pn
runDeclRef DeclarationRef
_ = forall a. Maybe a
Nothing

checkDuplicateImports
  :: MonadWriter MultipleErrors m
  => ModuleName
  -> [ImportDef]
  -> (ImportDef, ImportDef)
  -> m [ImportDef]
checkDuplicateImports :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
ModuleName
-> [ImportDef] -> (ImportDef, ImportDef) -> m [ImportDef]
checkDuplicateImports ModuleName
mn [ImportDef]
xs ((SourceSpan
_, ImportDeclarationType
t1, Maybe ModuleName
q1), (SourceSpan
pos, ImportDeclarationType
t2, Maybe ModuleName
q2)) =
  if ImportDeclarationType
t1 forall a. Eq a => a -> a -> Bool
== ImportDeclarationType
t2 Bool -> Bool -> Bool
&& Maybe ModuleName
q1 forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
q2
  then do
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
pos forall a b. (a -> b) -> a -> b
$ ModuleName
-> ImportDeclarationType -> Maybe ModuleName -> SimpleErrorMessage
DuplicateImport ModuleName
mn ImportDeclarationType
t2 Maybe ModuleName
q2
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (SourceSpan
pos, ImportDeclarationType
t2, Maybe ModuleName
q2) forall a. a -> [a] -> [a]
: [ImportDef]
xs
  else forall (m :: * -> *) a. Monad m => a -> m a
return [ImportDef]
xs