content: {-# 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 x =
    case x of
      NoRawPkgQual -> Nothing
      RawPkgQual lit -> Just lit
  
  importHint :: ModuHint
  importHint _ ModuleEx {ghcModule=L _ HsModule{hsmodImports=ms}} =
    -- Ideas for combining multiple imports.
    concatMap (reduceImports . snd) (
      groupSort [((n, pkg), i) | i <- ms
                , ideclSource (unLoc i) == NotBoot
                , let i' = unLoc i
                , let n = unLoc $ ideclName i'
                , let pkg  = unpackFS . sl_fs <$> rawPkgQualToMaybe (ideclPkgQual i')]) ++
    -- Ideas for removing redundant 'as' clauses.
    concatMap stripRedundantAlias ms
  
  reduceImports :: [LImportDecl GhcPs] -> [Idea]
  reduceImports [] = []
  reduceImports ms@(m:_) =
    [rawIdea Hint.Type.Warning "Use fewer imports" (locA (getLoc m)) (f ms) (Just $ f x) [] rs
    | Just (x, rs) <- [simplify ms]]
    where f = unlines . map unsafePrettyPrint
  
  simplify :: [LImportDecl GhcPs]
           -> Maybe ([LImportDecl GhcPs], [Refactoring R.SrcSpan])
  simplify [] = Nothing
  simplify (x : xs) = case simplifyHead x xs of
      Nothing -> first (x:) <$> simplify xs
      Just (xs, rs) ->
        let deletions = filter (\case Delete{} -> True; _ -> False) rs
         in Just $ maybe (xs, rs) (second (++ deletions)) $ simplify xs
  
  simplifyHead :: LImportDecl GhcPs
               -> [LImportDecl GhcPs]
               -> Maybe ([LImportDecl GhcPs], [Refactoring R.SrcSpan])
  simplifyHead x (y : ys) = case combine x y of
      Nothing -> first (y:) <$> simplifyHead x ys
      Just (xy, rs) -> Just (xy : ys, rs)
  simplifyHead x [] = Nothing
  
  combine :: LImportDecl GhcPs
          -> LImportDecl GhcPs
          -> Maybe (LImportDecl GhcPs, [Refactoring R.SrcSpan])
  combine x@(L loc x') y@(L _ y')
    -- Both (un/)qualified, common 'as', same names : Delete the second.
    | qual, as, specs = Just (x, [Delete Import (toSSA y)])
      -- Both (un/)qualified, common 'as', different names : Merge the
      -- second into the first and delete it.
    | qual, as
    , Just (False, xs) <- first (== EverythingBut) <$> ideclImportList x'
    , Just (False, ys) <- first (== EverythingBut) <$> ideclImportList y' =
        let newImp = L loc x'{ideclImportList = Just (Exactly, noLocA (unLoc xs ++ unLoc ys))}
        in Just (newImp, [Replace Import (toSSA x) [] (unsafePrettyPrint (unLoc newImp))
                         , Delete Import (toSSA y)])
    -- Both (un/qualified), common 'as', one has names the other doesn't
    -- : Delete the one with names.
    | qual, as, isNothing (ideclImportList x') || isNothing (ideclImportList y') =
         let (newImp, toDelete) = if isNothing (ideclImportList x') then (x, y) else (y, x)
         in Just (newImp, [Delete Import (toSSA toDelete)])
    -- Both unqualified, same names, one (and only one) has an 'as'
    -- clause : Delete the one without an 'as'.
    | ideclQualified x' == NotQualified, qual, specs, length ass == 1 =
         let (newImp, toDelete) = if isJust (ideclAs x') then (x, y) else (y, x)
         in Just (newImp, [Delete Import (toSSA toDelete)])
    -- No hints.
    | otherwise = Nothing
      where
          eqMaybe:: Eq a => Maybe (LocatedA a) -> Maybe (LocatedA a) -> Bool
          eqMaybe (Just x) (Just y) = x `eqLocated` y
          eqMaybe Nothing Nothing = True
          eqMaybe _ _ = False
  
          qual = ideclQualified x' == ideclQualified y'
          as = ideclAs x' `eqMaybe` ideclAs y'
          ass = mapMaybe ideclAs [x', y']
          specs = transformBi (const noSrcSpan) (ideclImportList x') ==
                      transformBi (const noSrcSpan) (ideclImportList y')
  
  stripRedundantAlias :: LImportDecl GhcPs -> [Idea]
  stripRedundantAlias x@(L _ i@ImportDecl {..})
    -- Suggest 'import M as M' be just 'import M'.
    | Just (unLoc ideclName) == fmap unLoc ideclAs =
        [suggest "Redundant as" (reLoc x) (noLoc i{ideclAs=Nothing} :: Located (ImportDecl GhcPs)) [RemoveAsKeyword (toSSA x)]]
  stripRedundantAlias _ = []
  