{-
    Suggest using better export declarations

<TEST>
main = 1
module Foo where foo = 1 -- module Foo(module Foo) where
module Foo(foo) where foo = 1
module Foo(module Foo) where foo = 1 -- @Ignore module Foo(...) where
module Foo(module Foo, foo) where foo = 1 -- module Foo(..., foo) where
</TEST>
-}
{-# LANGUAGE TypeFamilies #-}

module Hint.Export(exportHint) where

import Hint.Type(ModuHint, ModuleEx(..),ideaNote,ignore,Note(..))

import GHC.Hs
import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader

exportHint :: ModuHint
exportHint :: ModuHint
exportHint Scope
_ (ModuleEx (L SrcSpan
s m :: HsModule
m@HsModule {hsmodName :: HsModule -> Maybe (Located ModuleName)
hsmodName = Just Located ModuleName
name, hsmodExports :: HsModule -> Maybe (Located [LIE GhcPs])
hsmodExports = Maybe (Located [LIE GhcPs])
exports}) ApiAnns
_)
  | Maybe (Located [LIE GhcPs])
Nothing <- Maybe (Located [LIE GhcPs])
exports =
      let r :: HsModule
r = HsModule
o{ hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodExports = Located [LIE GhcPs] -> Maybe (Located [LIE GhcPs])
forall a. a -> Maybe a
Just ([LIE GhcPs] -> Located [LIE GhcPs]
forall e. e -> Located e
noLoc [IE GhcPs -> LIE GhcPs
forall e. e -> Located e
noLoc (XIEModuleContents GhcPs -> Located ModuleName -> IE GhcPs
forall pass.
XIEModuleContents pass -> Located ModuleName -> IE pass
IEModuleContents NoExtField
XIEModuleContents GhcPs
noExtField Located ModuleName
name)] )} in
      [(String
-> GenLocated SrcSpan HsModule
-> GenLocated SrcSpan HsModule
-> [Refactoring SrcSpan]
-> Idea
forall a.
Outputable a =>
String -> Located a -> Located a -> [Refactoring SrcSpan] -> Idea
ignore String
"Use module export list" (SrcSpan -> HsModule -> GenLocated SrcSpan HsModule
forall l e. l -> e -> GenLocated l e
L SrcSpan
s HsModule
o) (HsModule -> GenLocated SrcSpan HsModule
forall e. e -> Located e
noLoc HsModule
r) []){ideaNote :: [Note]
ideaNote = [String -> Note
Note String
"an explicit list is usually better"]}]
  | Just (L SrcSpan
_ [LIE GhcPs]
xs) <- Maybe (Located [LIE GhcPs])
exports
  , [LIE GhcPs]
mods <- [LIE GhcPs
x | LIE GhcPs
x <- [LIE GhcPs]
xs, LIE GhcPs -> Bool
forall l pass. GenLocated l (IE pass) -> Bool
isMod LIE GhcPs
x]
  , String
modName <- ModuleName -> String
moduleNameString (Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
name)
  , [String]
names <- [ ModuleName -> String
moduleNameString (Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
n) | (L SrcSpan
_ (IEModuleContents XIEModuleContents GhcPs
_ Located ModuleName
n)) <- [LIE GhcPs]
mods]
  , [LIE GhcPs]
exports' <- [LIE GhcPs
x | LIE GhcPs
x <- [LIE GhcPs]
xs, Bool -> Bool
not (String -> LIE GhcPs -> Bool
forall l pass. String -> GenLocated l (IE pass) -> Bool
matchesModName String
modName LIE GhcPs
x)]
  , String
modName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
names =
      let dots :: RdrName
dots = OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
" ... ")
          r :: HsModule
r = HsModule
o{ hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodExports = Located [LIE GhcPs] -> Maybe (Located [LIE GhcPs])
forall a. a -> Maybe a
Just ([LIE GhcPs] -> Located [LIE GhcPs]
forall e. e -> Located e
noLoc (IE GhcPs -> LIE GhcPs
forall e. e -> Located e
noLoc (XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
noExtField (IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall e. e -> Located e
noLoc (Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName (RdrName -> Located RdrName
forall e. e -> Located e
noLoc RdrName
dots)))) LIE GhcPs -> [LIE GhcPs] -> [LIE GhcPs]
forall a. a -> [a] -> [a]
: [LIE GhcPs]
exports') )}
      in
        [String
-> GenLocated SrcSpan HsModule
-> GenLocated SrcSpan HsModule
-> [Refactoring SrcSpan]
-> Idea
forall a.
Outputable a =>
String -> Located a -> Located a -> [Refactoring SrcSpan] -> Idea
ignore String
"Use explicit module export list" (SrcSpan -> HsModule -> GenLocated SrcSpan HsModule
forall l e. l -> e -> GenLocated l e
L SrcSpan
s HsModule
o) (HsModule -> GenLocated SrcSpan HsModule
forall e. e -> Located e
noLoc HsModule
r) []]
      where
          o :: HsModule
o = HsModule
m{hsmodImports :: [LImportDecl GhcPs]
hsmodImports=[], hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls=[], hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDeprecMessage=Maybe (Located WarningTxt)
forall a. Maybe a
Nothing, hsmodHaddockModHeader :: Maybe LHsDocString
hsmodHaddockModHeader=Maybe LHsDocString
forall a. Maybe a
Nothing }
          isMod :: GenLocated l (IE pass) -> Bool
isMod (L l
_ (IEModuleContents XIEModuleContents pass
_ Located ModuleName
_)) = Bool
True
          isMod GenLocated l (IE pass)
_ = Bool
False

          matchesModName :: String -> GenLocated l (IE pass) -> Bool
matchesModName String
m (L l
_ (IEModuleContents XIEModuleContents pass
_ (L SrcSpan
_ ModuleName
n))) = ModuleName -> String
moduleNameString ModuleName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
m
          matchesModName String
_ GenLocated l (IE pass)
_ = Bool
False

exportHint Scope
_ ModuleEx
_ = []