{-# 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,toSS,rawIdea)
import Refact.Types hiding (ModuleName)
import qualified Refact.Types 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.Basic
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Unit.Types -- for 'NotBoot'

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


importHint :: ModuHint
importHint :: ModuHint
importHint Scope
_ ModuleEx {ghcModule :: ModuleEx -> Located HsModule
ghcModule=L SrcSpan
_ HsModule{hsmodImports :: HsModule -> [LImportDecl GhcPs]
hsmodImports=[LImportDecl GhcPs]
ms}} =
  -- Ideas for combining multiple imports.
  (((ModuleName, Maybe String), [LImportDecl GhcPs]) -> [Idea])
-> [((ModuleName, Maybe String), [LImportDecl GhcPs])] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([LImportDecl GhcPs] -> [Idea]
reduceImports ([LImportDecl GhcPs] -> [Idea])
-> (((ModuleName, Maybe String), [LImportDecl GhcPs])
    -> [LImportDecl GhcPs])
-> ((ModuleName, Maybe String), [LImportDecl GhcPs])
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName, Maybe String), [LImportDecl GhcPs])
-> [LImportDecl GhcPs]
forall a b. (a, b) -> b
snd) (
    [((ModuleName, Maybe String), LImportDecl GhcPs)]
-> [((ModuleName, Maybe String), [LImportDecl GhcPs])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [((ModuleName
n, Maybe String
pkg), LImportDecl GhcPs
i) | LImportDecl GhcPs
i <- [LImportDecl GhcPs]
ms
              , ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource (LImportDecl GhcPs -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
i) IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot
              , let i' :: ImportDecl GhcPs
i' = LImportDecl GhcPs -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
i
              , let n :: ModuleName
n = GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan ModuleName -> ModuleName)
-> GenLocated SrcSpan ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName ImportDecl GhcPs
i'
              , let pkg :: Maybe String
pkg  = FastString -> String
unpackFS (FastString -> String)
-> (StringLiteral -> FastString) -> StringLiteral -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> String) -> Maybe StringLiteral -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
i']) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  -- Ideas for removing redundant 'as' clauses.
  (LImportDecl GhcPs -> [Idea]) -> [LImportDecl GhcPs] -> [Idea]
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" (LImportDecl GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LImportDecl GhcPs
m) ([LImportDecl GhcPs] -> String
f [LImportDecl GhcPs]
ms) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> String
f [LImportDecl GhcPs]
x) [] [Refactoring SrcSpan]
rs
  | Just ([LImportDecl GhcPs]
x, [Refactoring SrcSpan]
rs) <- [[LImportDecl GhcPs]
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
simplify [LImportDecl GhcPs]
ms]]
  where f :: [LImportDecl GhcPs] -> String
f = [String] -> String
unlines ([String] -> String)
-> ([LImportDecl GhcPs] -> [String])
-> [LImportDecl GhcPs]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LImportDecl GhcPs -> String) -> [LImportDecl GhcPs] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> String
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 [] = Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
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 -> ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LImportDecl GhcPs
xLImportDecl GhcPs -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. a -> [a] -> [a]
:) (([LImportDecl GhcPs], [Refactoring SrcSpan])
 -> ([LImportDecl GhcPs], [Refactoring SrcSpan]))
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
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 = (Refactoring SrcSpan -> Bool)
-> [Refactoring SrcSpan] -> [Refactoring SrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case Delete{} -> Bool
True; Refactoring SrcSpan
_ -> Bool
False) [Refactoring SrcSpan]
rs
       in ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (([LImportDecl GhcPs], [Refactoring SrcSpan])
 -> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan]))
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall a b. (a -> b) -> a -> b
$ ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> (([LImportDecl GhcPs], [Refactoring SrcSpan])
    -> ([LImportDecl GhcPs], [Refactoring SrcSpan]))
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([LImportDecl GhcPs]
xs, [Refactoring SrcSpan]
rs) (([Refactoring SrcSpan] -> [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ([Refactoring SrcSpan]
-> [Refactoring SrcSpan] -> [Refactoring SrcSpan]
forall a. [a] -> [a] -> [a]
++ [Refactoring SrcSpan]
deletions)) (Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
 -> ([LImportDecl GhcPs], [Refactoring SrcSpan]))
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
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 -> ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LImportDecl GhcPs
yLImportDecl GhcPs -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. a -> [a] -> [a]
:) (([LImportDecl GhcPs], [Refactoring SrcSpan])
 -> ([LImportDecl GhcPs], [Refactoring SrcSpan]))
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
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) -> ([LImportDecl GhcPs], [Refactoring SrcSpan])
-> Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (LImportDecl GhcPs
xy LImportDecl GhcPs -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. a -> [a] -> [a]
: [LImportDecl GhcPs]
ys, [Refactoring SrcSpan]
rs)
simplifyHead LImportDecl GhcPs
x [] = Maybe ([LImportDecl GhcPs], [Refactoring SrcSpan])
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 SrcSpan
loc ImportDecl GhcPs
x') y :: LImportDecl GhcPs
y@(L SrcSpan
_ ImportDecl GhcPs
y')
  -- Both (un/)qualified, common 'as', same names : Delete the second.
  | Bool
qual, Bool
as, Bool
specs = (LImportDecl GhcPs, [Refactoring SrcSpan])
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (LImportDecl GhcPs
x, [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Import (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS 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, Located [LIE GhcPs]
xs) <- ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
x'
  , Just (Bool
False, Located [LIE GhcPs]
ys) <- ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
y' =
      let newImp :: LImportDecl GhcPs
newImp = SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc ImportDecl GhcPs
x'{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
False, [LIE GhcPs] -> Located [LIE GhcPs]
forall e. e -> Located e
noLoc (Located [LIE GhcPs] -> [LIE GhcPs]
forall l e. GenLocated l e -> e
unLoc Located [LIE GhcPs]
xs [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ Located [LIE GhcPs] -> [LIE GhcPs]
forall l e. GenLocated l e -> e
unLoc Located [LIE GhcPs]
ys))}
      in (LImportDecl GhcPs, [Refactoring SrcSpan])
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (LImportDecl GhcPs
newImp, [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Import (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LImportDecl GhcPs
x) [] (ImportDecl GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (LImportDecl GhcPs -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LImportDecl GhcPs
newImp))
                       , RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Import (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LImportDecl GhcPs
y)])
  -- Both (un/qualified), common 'as', one has names the other doesn't
  -- : Delete the one with names.
  | Bool
qual, Bool
as, Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
isNothing (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
x') Bool -> Bool -> Bool
|| Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
isNothing (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
y') =
       let (LImportDecl GhcPs
newImp, LImportDecl GhcPs
toDelete) = if Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
isNothing (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
x') then (LImportDecl GhcPs
x, LImportDecl GhcPs
y) else (LImportDecl GhcPs
y, LImportDecl GhcPs
x)
       in (LImportDecl GhcPs, [Refactoring SrcSpan])
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (LImportDecl GhcPs
newImp, [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Import (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LImportDecl GhcPs
toDelete)])
  -- Both unqualified, same names, one (and only one) has an 'as'
  -- clause : Delete the one without an 'as'.
  | ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
x' ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
NotQualified, Bool
qual, Bool
specs, [GenLocated SrcSpan ModuleName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpan ModuleName]
ass Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
       let (LImportDecl GhcPs
newImp, LImportDecl GhcPs
toDelete) = if Maybe (GenLocated SrcSpan ModuleName) -> Bool
forall a. Maybe a -> Bool
isJust (ImportDecl GhcPs -> Maybe (GenLocated SrcSpan ModuleName)
forall pass.
ImportDecl pass -> Maybe (GenLocated SrcSpan ModuleName)
ideclAs ImportDecl GhcPs
x') then (LImportDecl GhcPs
x, LImportDecl GhcPs
y) else (LImportDecl GhcPs
y, LImportDecl GhcPs
x)
       in (LImportDecl GhcPs, [Refactoring SrcSpan])
-> Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
forall a. a -> Maybe a
Just (LImportDecl GhcPs
newImp, [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Import (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LImportDecl GhcPs
toDelete)])
  -- No hints.
  | Bool
otherwise = Maybe (LImportDecl GhcPs, [Refactoring SrcSpan])
forall a. Maybe a
Nothing
    where
        eqMaybe:: Eq a => Maybe (Located a) -> Maybe (Located a) -> Bool
        eqMaybe :: Maybe (Located a) -> Maybe (Located a) -> Bool
eqMaybe (Just Located a
x) (Just Located a
y) = Located a
x Located a -> Located a -> Bool
forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
`eqLocated` Located a
y
        eqMaybe Maybe (Located a)
Nothing Maybe (Located a)
Nothing = Bool
True
        eqMaybe Maybe (Located a)
_ Maybe (Located a)
_ = Bool
False

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

stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
stripRedundantAlias x :: LImportDecl GhcPs
x@(L SrcSpan
loc i :: ImportDecl GhcPs
i@ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (GenLocated SrcSpan ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
IsBootInterface
SourceText
GenLocated SrcSpan ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (GenLocated SrcSpan ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: GenLocated SrcSpan ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass.
ImportDecl pass -> Maybe (GenLocated SrcSpan ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclName :: forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
..})
  -- Suggest 'import M as M' be just 'import M'.
  | ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan ModuleName
ideclName) Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== (GenLocated SrcSpan ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpan ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpan ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Maybe (GenLocated SrcSpan ModuleName)
ideclAs =
      [String
-> LImportDecl GhcPs
-> LImportDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Redundant as" LImportDecl GhcPs
x (SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc ImportDecl GhcPs
i{ideclAs :: Maybe (GenLocated SrcSpan ModuleName)
ideclAs=Maybe (GenLocated SrcSpan ModuleName)
forall a. Maybe a
Nothing} :: LImportDecl GhcPs) [SrcSpan -> Refactoring SrcSpan
forall a. a -> Refactoring a
RemoveAsKeyword (LImportDecl GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LImportDecl GhcPs
x)]]
stripRedundantAlias LImportDecl GhcPs
_ = []