{-# LANGUAGE PatternGuards, ScopedTypeVariables, RecordWildCards #-}
module Hint.Import(importHint) where
import Hint.Type
import Util
import Control.Applicative
import Data.List
import Data.Maybe
importHint :: ModuHint
importHint _ x = concatMap (wrap . snd) (groupSortFst
[((fromNamed $ importModule i,importPkg i),i) | i <- universeBi x, not $ importSrc i]) ++
concatMap (\x -> hierarchy x ++ reduce1 x) (universeBi x) ++
multiExport x
wrap :: [ImportDecl S] -> [Idea]
wrap o = [ rawIdea Error "Use fewer imports" (toSrcSpan $ ann $ head o) (f o) (Just $ f x) []
| Just x <- [simplify o]]
where f = unlines . map prettyPrint
simplify :: [ImportDecl S] -> Maybe [ImportDecl S]
simplify [] = Nothing
simplify (x:xs) = case simplifyHead x xs of
Nothing -> (x:) <$> simplify xs
Just xs -> Just $ fromMaybe xs $ simplify xs
simplifyHead :: ImportDecl S -> [ImportDecl S] -> Maybe [ImportDecl S]
simplifyHead x [] = Nothing
simplifyHead x (y:ys) = case reduce x y of
Nothing -> (y:) <$> simplifyHead x ys
Just xy -> Just $ xy : ys
reduce :: ImportDecl S -> ImportDecl S -> Maybe (ImportDecl S)
reduce x y | qual, as, specs = Just x
| qual, as, Just (ImportSpecList _ False xs) <- importSpecs x, Just (ImportSpecList _ False ys) <- importSpecs y =
Just x{importSpecs = Just $ ImportSpecList an False $ nub_ $ xs ++ ys}
| qual, as, isNothing (importSpecs x) || isNothing (importSpecs y) = Just x{importSpecs=Nothing}
| not (importQualified x), qual, specs, length ass == 1 = Just x{importAs=Just $ head ass}
where
qual = importQualified x == importQualified y
as = importAs x `eqMaybe` importAs y
ass = mapMaybe importAs [x,y]
specs = importSpecs x `eqMaybe` importSpecs y
reduce _ _ = Nothing
reduce1 :: ImportDecl S -> [Idea]
reduce1 i@ImportDecl{..}
| Just (dropAnn importModule) == fmap dropAnn importAs
= [warn "Redundant as" i i{importAs=Nothing}]
reduce1 _ = []
newNames = let (*) = flip (,) in
["Control" * "Monad"
,"Data" * "Char"
,"Data" * "List"
,"Data" * "Maybe"
,"Data" * "Ratio"
,"System" * "Directory"
]
hierarchy :: ImportDecl S -> [Idea]
hierarchy i@ImportDecl{importModule=ModuleName _ x,importPkg=Nothing} | Just y <- lookup x newNames
= [warn "Use hierarchical imports" i (desugarQual i){importModule=ModuleName an $ y ++ "." ++ x}]
hierarchy i@ImportDecl{importModule=ModuleName _ "IO", importSpecs=Nothing,importPkg=Nothing}
= [rawIdea Warning "Use hierarchical imports" (toSrcSpan $ ann i) (ltrim $ prettyPrint i) (
Just $ unlines $ map (ltrim . prettyPrint)
[f "System.IO" Nothing, f "System.IO.Error" Nothing
,f "Control.Exception" $ Just $ ImportSpecList an False [IVar an $ toNamed x | x <- ["bracket","bracket_"]]]) []]
where f a b = (desugarQual i){importModule=ModuleName an a, importSpecs=b}
hierarchy _ = []
desugarQual :: ImportDecl S -> ImportDecl S
desugarQual x | importQualified x && isNothing (importAs x) = x{importAs=Just (importModule x)}
| otherwise = x
multiExport :: Module S -> [Idea]
multiExport x =
[ rawIdea Warning "Use import/export shortcut" (toSrcSpan $ ann hd)
(unlines $ prettyPrint hd : map prettyPrint imps)
(Just $ unlines $ prettyPrint newhd : map prettyPrint newimps)
[]
| Module l (Just hd) _ imp _ <- [x]
, let asNames = mapMaybe importAs imp
, let expNames = [x | EModuleContents _ x <- childrenBi hd]
, let imps = [i | i@ImportDecl{importAs=Nothing,importQualified=False,importModule=name} <- imp
,name `notElem_` asNames, name `elem_` expNames]
, length imps >= 3
, let newname = ModuleName an $ head $ map return ("XYZ" ++ ['A'..]) \\
[x | ModuleName (_ :: S) x <- universeBi hd ++ universeBi imp]
, let reexport (EModuleContents _ x) = x `notElem_` map importModule imps
reexport x = True
, let newhd = descendBi (\xs -> filter reexport xs ++ [EModuleContents an newname]) hd
, let newimps = [i{importAs=Just newname} | i <- imps]
]