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
type UsedImports = M.Map ModuleName [Qualified Name]
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
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
_ -> []
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
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
isPrim :: ModuleName -> Bool
isPrim :: ModuleName -> Bool
isPrim = (forall a. Eq a => a -> a -> Bool
== ModuleName
C.Prim)
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
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
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
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
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' :: 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