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

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 qualified Data.Text as T
import qualified Data.Map as M

import Language.PureScript.AST.Declarations
import Language.PureScript.AST.SourcePos
import Language.PureScript.Crash
import Language.PureScript.Errors
import Language.PureScript.Names
import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)
import Language.PureScript.Sugar.Names.Env
import Language.PureScript.Sugar.Names.Imports
import qualified Language.PureScript.Constants.Prim 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