HaRe-0.6: refactorer/RefacCleanImps.hs
module RefacCleanImps(cleanImports,mkImpExplicit,addToExport,rmFromExport) where
import PosSyntax
import Maybe
import TypedIds
import List hiding (delete)
import RefacUtils
import UniqueNames hiding (srcLoc)
import HsName hiding (ModuleName)
import SourceNames
import PNT
import RefacMoveDef(liftingInClientMod)
import PFE0 (findFile)
import PrettyPrint hiding (group)
import NamesEntities
import Ents
import Relations
import Modules(mImp',mExpListEntry)
import AST4ModSys (toImport',toExpListEntry')
import HsIdent(HsIdentI(..))
{- This refactoring trys to remove the unnecessary import declarations from the module-}
cleanImports args
= do let fileName= ghead "filename" args
(inscps, _, mod'', toks) <- parseSourceFile fileName
let mod = rmPrelude mod''
inscps' =relToList inscps
imp_Ents_List <- getImportedEnts inscps' (hsModImports mod)
(mod',((toks',m),_))<-runStateT (doCleanImports imp_Ents_List (inscps', mod))
((toks,unmodified),(-1000,0))
writeRefactoredFiles False [((fileName,m),(toks', mod'))]
doCleanImports imp_Ents_List (inscps, mod@(HsModule _ modName exps imps decls))
= do -- imp_usedEnts_List ::[(ImportDeclP, [PNames])]
let imp_usedEnts_List =map (getUsedEnts mod) imp_Ents_List
mod' <- checkEachImport mod (imp_usedEnts_List, imp_usedEnts_List)
combineImports mod' (hsModImports mod')
-- remove an import declaration from the module.
rmOneImport mod@(HsModule loc modName exps imps decls) imp
= do imps' <- delete imp imps
return (HsModule loc modName exps (imps\\[imp]) decls)
checkEachImport mod@(HsModule loc modName exps imps decls) ([],_)
=return mod
checkEachImport mod@(HsModule loc modName exps imps decls) ((i@(imp,inscpEnts,usedEnts):is), origList)
= if usedEnts == [] -- this import decl is not used at all.
then do mod'<- (do m'<-rmOneImport mod imp
if inscpEnts==[] && modIsExported1 (qualifier imp) mod
then rmItemsFromExport m' (Left ([qualifier imp], []))
else return m')
checkEachImport mod' (is, (origList \\ [i]))
else if any (\(x,y,z)->(usedEnts == z && length inscpEnts >= length y)
|| (usedEnts \\ z ==[] && length usedEnts <length z)) (origList \\ [i])
then do mod'<-rmOneImport mod imp
checkEachImport mod' (is,(origList \\[i]))
else checkEachImport mod (is, origList)
--getImportedEnts::[(QName,Entity)]->[HsImportDeclP]->[(HsImportDeclP,[(QName,Entity)])]
getImportedEnts inscps imps
= do importedEnts<-mapM getImportedEnts' imps
return $ zip imps importedEnts
where
getImportedEnts' (imp@(HsImportDecl loc (SN modName _) qual as h)::HsImportDeclP)
= do fileName <- PFE0.findFile modName
(_, exps, mod, toks) <- parseSourceFile fileName
return $ relToList (mImp' (listToRel exps)
(toImport' (HsImportDecl loc modName qual (as' as) h)))
where as' Nothing = Nothing
as' (Just (SN modName _)) = Just modName
getUsedEnts mod@(HsModule _ _ exps imps decls) (imp@(HsImportDecl _ (SN modName _) _ as h),inscpEnts)
= if modIsExported1 (qualifier imp) mod
then (imp, inscpEnts, inscpEnts)
else case h of
(Just (False, ents)) ->if ents == []
then (imp, inscpEnts,[])
else (imp, inscpEnts, usedEnts' (exps, decls))
_ -> (imp, inscpEnts, usedEnts' (exps, decls))
where
usedEnts'= (nub.ghead "getUsedEnts'"). applyTU (full_tdTU (constTU [] `adhocTU` inPnt))
where
inPnt pnt@(PNT pname ty loc)
| isTopLevelPNT pnt
=let ent'=pntToEnt pnt
in if isJust (find (==ent') inscpEnts)
then return [ent']
else return []
inPnt _ = return []
--- THIS FUNCTION SHOULD GO TO THE API.
modIsExported1 modName mod
= if isNothing exps
then False
else isJust $ find (\x->getModName x == Just modName) (fromJust exps)
where
exps = hsModExports mod
getModName (ModuleE (SN modName _)) = Just modName
getModName _ = Nothing
unqualify ((SN (Qual _ id) l), ent) = ((SN (UnQual id) l), ent)
unqualify x = x
qualifier (HsImportDecl _ (SN modName _) qual Nothing h) = modName
qualifier (HsImportDecl _ _ qual (Just (SN modName _)) h) = modName
combineImports mod [] = return mod
combineImports mod@(HsModule _ _ _ imps _) (i:is)
= case i of
(HsImportDecl _ modName@(SN modName' _) qual as (Just(False, ents)))
->let sub_is= filter (\x-> case x of
(HsImportDecl _ modName1 qual1 as1 (Just(False,ents1)))
->modName1 == modName && qual==qual1 && as == as1
_ ->False ) is
in if sub_is==[] then combineImports mod is
else do let ents=concatMap importedEnts sub_is
mod'<-foldM rmOneImport mod sub_is
let (imps1, imps2) = break (==i) imps
i' <-addItemsToImport modName' Nothing (Right ents) i
combineImports (mod' {hsModImports =((imps1++[i']++(tail imps2)) \\ sub_is)}) (is \\ sub_is)
_ ->combineImports mod is
where
importedEnts (HsImportDecl _ _ False Nothing (Just(False,ents))) =ents
importedEnts _ =[]
pntToEnt pnt@(PNT pn@(PN (UnQual s) (G modName s1 loc)) ty _)
= let t= if hasNameSpace pnt == ValueName then HsVar else HsCon
in ((SN (UnQual s) (getSrcLoc loc)), (Ent modName (t (SN s (getSrcLoc loc))) (fmap pIdtoId ty)))
pntToEnt pnt@(PNT pn@(PN (Qual modName s) (G modName1 s1 loc)) ty _)
= let t= if hasNameSpace pnt == ValueName then HsVar else HsCon
in ((SN (Qual modName s) (getSrcLoc loc)) , (Ent modName1 (HsVar (SN s (getSrcLoc loc))) (fmap pIdtoId ty)))
pIdtoId pn@(PN i orig) = (SN i (srcLoc pn))
getSrcLoc (N (Just loc)) = loc
getSrcLoc (N Nothing) = loc0
-- this refactoring makes the all the used enitities from a import decl explicit in the import declaration.
mkImpExplicit args
=do let fileName= ghead "filename" args
row = read (args!!1)::Int
col = read (args!!2)::Int
modName <- fileNameToModName fileName
(inscps, _, mod, toks) <- parseSourceFile fileName
let imp'=locToImport fileName row col mod
unless (isJust imp')
$ error ("Invalid cursor position! "++
"Please point the cursor to the beginning position of the module name." )
let inscps' = relToList inscps
imp = fromJust imp'
[(imp, importedEnts)] <- getImportedEnts inscps' [imp]
(mod',((toks',_),_))<-runStateT (doExplicitImport mod (imp,importedEnts))
((toks,unmodified),(-1000,0))
writeRefactoredFiles False [((fileName,True),(toks', mod'))]
locToImport fileName row col mod
= applyTU (once_buTU (failTU `adhocTU` worker)) mod
where
worker (imp@(HsImportDecl l (SN modName (SrcLoc _ _ row1 col1)) _ _ _)::HsImportDeclP)
| row1 == row && col1 == col
=Just imp
worker _ = Nothing
doExplicitImport mod (imp@(HsImportDecl l m qual as _),importedEnts)
= do let used =usedEnts importedEnts mod
(imps1, imps2) = break (==imp) (hsModImports mod)
imp' <-update imp ( if (used==[]) then (HsImportDecl l m qual as (Just(False, [])))
else (HsImportDecl l m qual as (Just (False, used)))) imp
return (mod {hsModImports=(imps1++[imp']++imps2)})
where
usedEnts importedEnts = combineEntSpecs. (nub.ghead "usdEnts'").
applyTU (full_tdTU (constTU [] `adhocTU` inPnt))
where
inPnt pnt@(PNT pname ty loc)
| isTopLevelPNT pnt
=let ent'=pntToEnt pnt
in if isJust (find (==ent') importedEnts)
then return [pNTtoEntSpec pnt]
else return []
inPnt _ = return []
combineEntSpecs [] = []
combineEntSpecs (e:es)
= case e of
Abs pnt -> if findDup pnt es then combineEntSpecs es else (e:combineEntSpecs es)
where findDup pnt es = any (\x->case x of
ListSubs i is -> pNTtoName i== pNTtoName pnt
Abs i -> pNTtoName i== pNTtoName pnt
_ -> False) es
ListSubs p _ -> if findDup p es then combineEntSpecs (doCombine e es) else (e:combineEntSpecs es)
where findDup pnt es = any (\x->case x of
ListSubs p' _ ->pNTtoName p == pNTtoName p'
_ -> False) es
doCombine (ListSubs p cs) es
= let (es1, es2) = break (\x-> case x of
ListSubs p' _ ->pNTtoName p == pNTtoName p'
_ ->False) es
(ListSubs _ cs') = ghead "doCombine" es2
in (es1++[ListSubs p (cs++cs')]++tail es2)
_ -> (e: combineEntSpecs es)
pNTtoEntSpec pnt@(PNT pn@(PN _ (G modName s1 loc)) ty _)
= case ty of
ConstrOf i _ -> ListSubs (pIdToPNT i) [HsCon pnt']
Type _ -> Abs pnt'
_ -> Var pnt'
where
pIdToPNT (PN id orig) =PNT (PN (UnQual id) orig) Value (N Nothing)
pnt'= rmQualifier pnt
where rmQualifier (PNT (PN (Qual modName s) l) ty loc)= (PNT (PN (UnQual s) l) ty loc)
rmQualifier x = x
-- this refactoring adds an user-selected top-level identifier to the export list.
addToExport args
=do let fileName= ghead "filename" args
row = read (args!!1)::Int
col = read (args!!2)::Int
modName <- fileNameToModName fileName
(inscps, exps, mod, toks) <- parseSourceFile fileName
let pnt = locToPNT fileName (row, col) mod
unless (pnt/=defaultPNT) $ error "Invalid cursor position!\n" -- this refactoring does not handle module names.
unless (isTopLevelPNT pnt) $ error "The selected identifier is not a top level identifier!\n"
(mod',((toks',_),_))<-runStateT (doAddingToExport pnt mod)
((toks,unmodified),(-1000,0))
clients <-clientModsAndFiles modName
refactoredClients <-mapM (refactorInClientMod modName (pNTtoPN pnt)) clients
writeRefactoredFiles False $ ((fileName,True),(toks', mod')):refactoredClients
where
doAddingToExport pnt mod
= do let pn = pNTtoPN pnt
unless (not (isExplicitlyExported pn mod || modIsExported mod))
$ error "The indentifier is already exported!\n"
let exps=fromJust $ hsModExports mod
newEnt = EntE (pNTtoEntSpec pnt)
insertEEnt mod newEnt
insertEEnt mod e@(EntE ent)
= let exps = fromJust $ hsModExports mod
in case ent of
ListSubs i is ->
let (exps1,exps2)=break (\i'->case i' of
(EntE (ListSubs i'' _)) ->(i''==i)
(EntE (Abs i'')) ->(i''== i)
_ -> False) exps
in if exps2 == []
then do addItemsToExport mod Nothing False (Right [e])
return $ (mod {hsModExports=Just ([e]++exps)})
else do let e'=ghead "insertEnt" exps2
exps'<- case e' of
(EntE (ListSubs i'' is')) ->
do e''<-update e' (EntE (ListSubs i (is'++is))) e'
-- there is a problem with pretty-printing (EntE ...)
return $ Just (exps1++(e'':tail exps2))
(EntE (Abs i'')) ->
do e''<-update e'(EntE (ListSubs i'' is)) e'
return $ Just (exps1 ++(e'':tail exps2))
return $ (mod {hsModExports=exps'})
_ -> do addItemsToExport mod Nothing False (Right [e])
return $ (mod {hsModExports=Just ([e]++exps)})
refactorInClientMod serverModName pn (modName, fileName)
= liftingInClientMod serverModName [pn] (modName, fileName)
--This refactoring removes an user-selected entry from the export list if none of the idenitifiers exported
--by this entry is used by other modules.
-- NOTE: This refactoring DOES NOT HANDLE SUB-ENTRIES in the export list. (Can this be improved?)
rmFromExport args
=do let fileName= ghead "filename" args
row = read (args!!1)::Int
col = read (args!!2)::Int
modName <- fileNameToModName fileName
(inscps, exps, mod, toks) <- parseSourceFile fileName
let eEntry' = locToEEntry row col mod toks
unless (eEntry'/=Nothing) $ error "Invalid cursor position!\n"
let eEntry = fromJust eEntry'
ents = exportedEnts inscps eEntry
if isDuplicatedEntry inscps (eEntry, ents) (fromJust (hsModExports mod))
then do (mod',((toks',m),_))<-runStateT (doRmFromExport mod eEntry)
((toks,unmodified),(-1000,0))
writeRefactoredFiles False [((fileName, m),(toks',mod'))]
else do clients<-clientModsAndFiles modName
refactoredClients <- mapM (refactorInClientMod ents) clients
(mod',((toks',m),_))<-runStateT (doRmFromExport mod eEntry)
((toks,unmodified),(-1000,0))
writeRefactoredFiles False $ ((fileName,m),(toks',mod')):refactoredClients
where
-- Calculates all the entities exported by this entry.
exportedEnts inscps eEntry = relToList (mExpListEntry inscps (toExpListEntry' eEntry))
-- Returns True if this entry is duplicated or covered by another entry in the export list.
isDuplicatedEntry inscps (eEntry, ents) exps
=let ents'= map (mExpListEntry' inscps) (map toExpListEntry' (exps \\[eEntry]))
in any (\e->intersect e ents==ents) ents'
where mExpListEntry' inscps entry= relToList (mExpListEntry inscps entry)
-- Removes an entry from the export list.
doRmFromExport mod eEntry = rmItemsFromExport mod (Right [eEntry])
-- get the user selected entry from the export list.
locToEEntry row col mod toks
=if isJust exps
then let (_, e2) =break (\e->let (startLoc, endLoc) =getStartEndLoc toks e
in startLoc<=(row,col) && (row,col)<=endLoc) (fromJust exps)
in if e2==[] then Nothing else Just (head e2)
else Nothing
where exps = hsModExports mod
refactorInClientMod ents (modName, fileName)
= do (inscps, exps, mod ,ts) <-parseSourceFile fileName
-- The following condition is too strong.
if findEnt ents (hsModDecls mod) || (intersect (map impEntToExpEnt ents) exps) /= []
then error $ "This entity can not be removed as it is used by the client module '"++(render.ppi) modName++"'!"
else do let pnsToBeHided =findPns ents (hsModImports mod)
if pnsToBeHided/=[]
then do (mod', ((ts',m),_))<-runStateT (rmItemsFromImport mod pnsToBeHided)
((ts,unmodified),(-1000,0))
return ((fileName,m), (ts',mod'))
else return ((fileName,unmodified), (ts,mod))
findEnt ents
= (fromMaybe False).(applyTU (once_tdTU (failTU `adhocTU` worker)))
where
worker (pnt::PNT)
|isTopLevelPNT pnt && isJust (find (==(pntToEnt pnt)) ents) = Just True
worker _ = Nothing
impEntToExpEnt ((SN (UnQual s) loc1), e) = ((SN s loc1), e)
impEntToExpEnt ((SN (Qual modName s) loc1),e) = ((SN s loc1), e)
findPns ents
= (nub.ghead "findPns").(applyTU (full_tdTU (constTU [] `adhocTU` worker)))
where
worker (pnt::PNT)
|isTopLevelPNT pnt && isJust (find (==(pntToEnt pnt)) ents) = return [pNTtoPN pnt]
worker _ = return []