{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase, PatternGuards, RecordWildCards #-}
{-
    Reduce the number of import declarations.
    Two import declarations can be combined if:
      (note, A[] is A with whatever import list, or none)

    import A[]; import A[] = import A[]
    import A(B); import A(C) = import A(B,C)
    import A; import A(C) = import A
    import A; import A hiding (C) = import A
    import A[]; import A[] as Y = import A[] as Y

<TEST>
import A; import A -- import A
import A; import A; import A -- import A
import A(Foo) ; import A -- import A
import A ;import A(Foo) -- import A
import A(Bar(..)); import {-# SOURCE #-} A
import A; import B
import A(B) ; import A(C) -- import A(B,C)
import A; import A hiding (C) -- import A
import A; import A as Y -- import A as Y
import A; import qualified A as Y
import A as B; import A as C
import A as A -- import A
import qualified A as A -- import qualified A
import A; import B; import A -- import A
import qualified A; import A
import B; import A; import A -- import A
import A hiding(Foo); import A hiding(Bar)
import A (foo) \
import A (bar) \
import A (baz) -- import A ( foo, bar, baz )
</TEST>
-}


module Hint.Import(importHint) where

import Hint.Type(ModuHint,ModuleEx(..),Idea(..),Severity(..),suggest,toSSA,rawIdea)
import Refact.Types hiding (ModuleName)
import Refact.Types qualified as R
import Data.Tuple.Extra
import Data.List.Extra
import Data.Generics.Uniplate.DataOnly
import Data.Maybe
import Control.Applicative
import Prelude

import GHC.Data.FastString
import GHC.Types.SourceText
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.PkgQual

import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

rawPkgQualToMaybe :: RawPkgQual -> Maybe StringLiteral
rawPkgQualToMaybe :: RawPkgQual -> Maybe StringLiteral
rawPkgQualToMaybe RawPkgQual
x =
  case RawPkgQual
x of
    RawPkgQual
NoRawPkgQual -> forall a. Maybe a
Nothing
    RawPkgQual StringLiteral
lit -> forall a. a -> Maybe a
Just StringLiteral
lit

importHint :: ModuHint
importHint :: ModuHint
importHint Scope
_ ModuleEx {ghcModule :: ModuleEx -> Located (HsModule GhcPs)
ghcModule=L SrcSpan
_ HsModule{hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports=[LImportDecl GhcPs]
ms}} =
  -- Ideas for combining multiple imports.
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([LImportDecl GhcPs] -> [Idea]
reduceImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (
    forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [((ModuleName
n, Maybe String
pkg), GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) | GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i <- [LImportDecl GhcPs]
ms
              , forall pass. ImportDecl pass -> IsBootInterface
ideclSource (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i) forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot
              , let i' :: ImportDecl GhcPs
i' = forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i
              , let n :: ModuleName
n = forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i'
              , let pkg :: Maybe String
pkg  = FastString -> String
unpackFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPkgQual -> Maybe StringLiteral
rawPkgQualToMaybe (forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
i')]) forall a. [a] -> [a] -> [a]
++
  -- Ideas for removing redundant 'as' clauses.
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LImportDecl GhcPs -> [Idea]
stripRedundantAlias [LImportDecl GhcPs]
ms

reduceImports :: [LImportDecl GhcPs] -> [Idea]
reduceImports :: [LImportDecl GhcPs] -> [Idea]
reduceImports [] = []
reduceImports ms :: [LImportDecl GhcPs]
ms@(LImportDecl GhcPs
m:[LImportDecl GhcPs]
_) =
  [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Hint.Type.Warning String
"Use fewer imports" (forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc LImportDecl GhcPs
m)) ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> String
f [LImportDecl GhcPs]
ms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> String
f [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
x) [] [Refactoring SrcSpan]
rs
  | Just ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
x, [Refactoring SrcSpan]
rs) <- [[LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplify [LImportDecl GhcPs]
ms]]
  where f :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> String
f = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> String
unsafePrettyPrint

simplify :: [LImportDecl GhcPs]
         -> Maybe ([LImportDecl GhcPs], [Refactoring R.SrcSpan])
simplify :: [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplify [] = forall a. Maybe a
Nothing
simplify (LImportDecl GhcPs
x : [LImportDecl GhcPs]
xs) = case LImportDecl GhcPs
-> [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplifyHead LImportDecl GhcPs
x [LImportDecl GhcPs]
xs of
    Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
Nothing -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LImportDecl GhcPs
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplify [LImportDecl GhcPs]
xs
    Just ([LImportDecl GhcPs]
xs, [Refactoring SrcSpan]
rs) ->
      let deletions :: [Refactoring SrcSpan]
deletions = forall a. (a -> Bool) -> [a] -> [a]
filter (\case Delete{} -> Bool
True; Refactoring SrcSpan
_ -> Bool
False) [Refactoring SrcSpan]
rs
       in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([LImportDecl GhcPs]
xs, [Refactoring SrcSpan]
rs) (forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (forall a. [a] -> [a] -> [a]
++ [Refactoring SrcSpan]
deletions)) forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplify [LImportDecl GhcPs]
xs

simplifyHead :: LImportDecl GhcPs
             -> [LImportDecl GhcPs]
             -> Maybe ([LImportDecl GhcPs], [Refactoring R.SrcSpan])
simplifyHead :: LImportDecl GhcPs
-> [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplifyHead LImportDecl GhcPs
x (LImportDecl GhcPs
y : [LImportDecl GhcPs]
ys) = case LImportDecl GhcPs
-> LImportDecl GhcPs
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
combine LImportDecl GhcPs
x LImportDecl GhcPs
y of
    Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
Nothing -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LImportDecl GhcPs
yforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LImportDecl GhcPs
-> [LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplifyHead LImportDecl GhcPs
x [LImportDecl GhcPs]
ys
    Just (LImportDecl GhcPs
xy, [Refactoring SrcSpan]
rs) -> forall a. a -> Maybe a
Just (LImportDecl GhcPs
xy forall a. a -> [a] -> [a]
: [LImportDecl GhcPs]
ys, [Refactoring SrcSpan]
rs)
simplifyHead LImportDecl GhcPs
x [] = forall a. Maybe a
Nothing

combine :: LImportDecl GhcPs
        -> LImportDecl GhcPs
        -> Maybe (LImportDecl GhcPs, [Refactoring R.SrcSpan])
combine :: LImportDecl GhcPs
-> LImportDecl GhcPs
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
combine x :: LImportDecl GhcPs
x@(L SrcSpanAnnA
loc ImportDecl GhcPs
x') y :: LImportDecl GhcPs
y@(L SrcSpanAnnA
_ ImportDecl GhcPs
y')
  -- Both (un/)qualified, common 'as', same names : Delete the second.
  | Bool
qual, Bool
as, Bool
specs = forall a. a -> Maybe a
Just (LImportDecl GhcPs
x, [forall a. RType -> a -> Refactoring a
Delete RType
Import (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LImportDecl GhcPs
y)])
    -- Both (un/)qualified, common 'as', different names : Merge the
    -- second into the first and delete it.
  | Bool
qual, Bool
as
  , Just (Bool
False, GenLocated SrcSpanAnnL [XRec GhcPs (IE GhcPs)]
xs) <- forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
x'
  , Just (Bool
False, GenLocated SrcSpanAnnL [XRec GhcPs (IE GhcPs)]
ys) <- forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
y' =
      let newImp :: GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc ImportDecl GhcPs
x'{ideclImportList :: Maybe
  (ImportListInterpretation, XRec GhcPs [XRec GhcPs (IE GhcPs)])
ideclImportList = forall a. a -> Maybe a
Just (ImportListInterpretation
Exactly, forall a an. a -> LocatedAn an a
noLocA (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnL [XRec GhcPs (IE GhcPs)]
xs forall a. [a] -> [a] -> [a]
++ forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnL [XRec GhcPs (IE GhcPs)]
ys))}
      in forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp, [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Import (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LImportDecl GhcPs
x) [] (forall a. Outputable a => a -> String
unsafePrettyPrint (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp))
                       , forall a. RType -> a -> Refactoring a
Delete RType
Import (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LImportDecl GhcPs
y)])
  -- Both (un/qualified), common 'as', one has names the other doesn't
  -- : Delete the one with names.
  | Bool
qual, Bool
as, forall a. Maybe a -> Bool
isNothing (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
x') Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
y') =
       let (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp, GenLocated SrcSpanAnnA (ImportDecl GhcPs)
toDelete) = if forall a. Maybe a -> Bool
isNothing (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
x') then (LImportDecl GhcPs
x, LImportDecl GhcPs
y) else (LImportDecl GhcPs
y, LImportDecl GhcPs
x)
       in forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp, [forall a. RType -> a -> Refactoring a
Delete RType
Import (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (ImportDecl GhcPs)
toDelete)])
  -- Both unqualified, same names, one (and only one) has an 'as'
  -- clause : Delete the one without an 'as'.
  | forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
x' forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
NotQualified, Bool
qual, Bool
specs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [XRec GhcPs ModuleName]
ass forall a. Eq a => a -> a -> Bool
== Int
1 =
       let (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp, GenLocated SrcSpanAnnA (ImportDecl GhcPs)
toDelete) = if forall a. Maybe a -> Bool
isJust (forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
x') then (LImportDecl GhcPs
x, LImportDecl GhcPs
y) else (LImportDecl GhcPs
y, LImportDecl GhcPs
x)
       in forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
newImp, [forall a. RType -> a -> Refactoring a
Delete RType
Import (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (ImportDecl GhcPs)
toDelete)])
  -- No hints.
  | Bool
otherwise = forall a. Maybe a
Nothing
    where
        eqMaybe:: Eq a => Maybe (LocatedA a) -> Maybe (LocatedA a) -> Bool
        eqMaybe :: forall a. Eq a => Maybe (LocatedA a) -> Maybe (LocatedA a) -> Bool
eqMaybe (Just LocatedA a
x) (Just LocatedA a
y) = LocatedA a
x forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
`eqLocated` LocatedA a
y
        eqMaybe Maybe (LocatedA a)
Nothing Maybe (LocatedA a)
Nothing = Bool
True
        eqMaybe Maybe (LocatedA a)
_ Maybe (LocatedA a)
_ = Bool
False

        qual :: Bool
qual = forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
x' forall a. Eq a => a -> a -> Bool
== forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
y'
        as :: Bool
as = forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
x' forall a. Eq a => Maybe (LocatedA a) -> Maybe (LocatedA a) -> Bool
`eqMaybe` forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
y'
        ass :: [XRec GhcPs ModuleName]
ass = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs [ImportDecl GhcPs
x', ImportDecl GhcPs
y']
        specs :: Bool
specs = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi (forall a b. a -> b -> a
const SrcSpan
noSrcSpan) (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
x') forall a. Eq a => a -> a -> Bool
==
                    forall from to. Biplate from to => (to -> to) -> from -> from
transformBi (forall a b. a -> b -> a
const SrcSpan
noSrcSpan) (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
y')

stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
stripRedundantAlias x :: LImportDecl GhcPs
x@(L SrcSpanAnnA
_ i :: ImportDecl GhcPs
i@ImportDecl {Bool
Maybe
  (ImportListInterpretation, XRec GhcPs [XRec GhcPs (IE GhcPs)])
Maybe (XRec GhcPs ModuleName)
ImportDeclQualifiedStyle
IsBootInterface
XRec GhcPs ModuleName
XCImportDecl GhcPs
ImportDeclPkgQual GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclImportList :: Maybe
  (ImportListInterpretation, XRec GhcPs [XRec GhcPs (IE GhcPs)])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclName :: XRec GhcPs ModuleName
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
..})
  -- Suggest 'import M as M' be just 'import M'.
  | forall a. a -> Maybe a
Just (forall l e. GenLocated l e -> e
unLoc XRec GhcPs ModuleName
ideclName) forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc Maybe (XRec GhcPs ModuleName)
ideclAs =
      [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant as" (forall a e. LocatedAn a e -> Located e
reLoc LImportDecl GhcPs
x) (forall e. e -> Located e
noLoc ImportDecl GhcPs
i{ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclAs=forall a. Maybe a
Nothing} :: Located (ImportDecl GhcPs)) [forall a. a -> Refactoring a
RemoveAsKeyword (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LImportDecl GhcPs
x)]]
stripRedundantAlias LImportDecl GhcPs
_ = []