{-# LANGUAGE ViewPatterns #-}
module Importify.Tree
( UnusedHidings (..)
, UnusedSymbols (..)
, removeImports
) where
import Universum
import Data.Generics.Aliases (mkT)
import Data.Generics.Schemes (everywhere)
import Data.List (partition)
import Extended.Data.List (removeAtMultiple)
import Language.Haskell.Exts (CName, ImportDecl (..), ImportSpec (..),
ImportSpecList (..), Name (..), Namespace (..),
SrcSpanInfo (..))
import Language.Haskell.Names (NameInfo (..), Scoped (..), Symbol)
import Importify.Syntax (InScoped, pullScopedInfo)
newtype UnusedSymbols = UnusedSymbols { getUnusedSymbols :: [Symbol] }
newtype UnusedHidings = UnusedHidings { getUnusedHidings :: [Symbol] }
removeImports :: UnusedSymbols
-> UnusedHidings
-> [InScoped ImportDecl]
-> [InScoped ImportDecl]
removeImports (UnusedSymbols symbols) (UnusedHidings hidings) decls =
(volatileImports ++)
$ cleanDecls
$ everywhere (mkT traverseToClean)
$ everywhere (mkT $ traverseToRemove hidings True)
$ everywhere (mkT $ traverseToRemove symbols False)
$ everywhere (mkT $ traverseToRemoveThing symbols) decls
where
volatileImports = filter isVolatileImport decls
isVolatileImport :: InScoped ImportDecl -> Bool
isVolatileImport ImportDecl{ importSpecs = Just (ImportSpecList _ _ []) } = True
isVolatileImport ImportDecl{ importSpecs = Nothing } = True
isVolatileImport _ = False
traverseToRemoveThing :: [Symbol]
-> InScoped ImportSpec
-> InScoped ImportSpec
traverseToRemoveThing
symbols
(IThingWith (Scoped ni srcSpan@SrcSpanInfo{..}) name cnames)
=
case newCnames of
[] -> IAbs (toScope emptySpan) (NoNamespace $ toScope emptySpan) name
_ -> IThingWith (toScope newSpanInfo) name newCnames
where
emptySpan :: SrcSpanInfo
emptySpan = SrcSpanInfo srcInfoSpan []
toScope :: SrcSpanInfo -> Scoped SrcSpanInfo
toScope = Scoped ni
(newCnames, newSpanInfo) = removeSrcSpanInfoPoints isCNameNotInSymbols
cnames
srcSpan
isCNameNotInSymbols :: InScoped CName -> Bool
isCNameNotInSymbols (pullScopedInfo -> GlobalSymbol symbol _) = symbol `notElem` symbols
isCNameNotInSymbols _ = False
traverseToRemoveThing _ spec = spec
traverseToRemove :: [Symbol]
-> Bool
-> InScoped ImportSpecList
-> InScoped ImportSpecList
traverseToRemove symbols
yes'CleanIt
specList@(ImportSpecList (Scoped ni oldSpanInfo) isHiding specs)
| isHiding == yes'CleanIt = newSpecs
| otherwise = specList
where
(neededSpecs, newSpanInfo) = removeSrcSpanInfoPoints (isSpecNeeded symbols)
specs
oldSpanInfo
newSpecs = ImportSpecList (Scoped ni newSpanInfo)
isHiding
neededSpecs
removeSrcSpanInfoPoints :: (a -> Bool)
-> [a]
-> SrcSpanInfo
-> ([a], SrcSpanInfo)
removeSrcSpanInfoPoints shouldKeepEntity entities SrcSpanInfo{..} =
let indexedEntities = zip [1..] entities
(neededEntities, unusedEntities) = partition (shouldKeepEntity . snd)
indexedEntities
pointsCount = length srcInfoPoints
unusedIds = filter (< pointsCount)
$ map fst unusedEntities
newPoints = removeAtMultiple unusedIds srcInfoPoints
in (map snd neededEntities, SrcSpanInfo srcInfoSpan newPoints)
isSpecNeeded :: [Symbol] -> InScoped ImportSpec -> Bool
isSpecNeeded symbols (IVar _ name) = isNameNeeded name symbols
isSpecNeeded symbols (IAbs _ _ name) = isNameNeeded name symbols
isSpecNeeded symbols (IThingAll _ name) = isNameNeeded name symbols
isSpecNeeded symbols (IThingWith _ name []) = isNameNeeded name symbols
isSpecNeeded _ (IThingWith _ _ (_:_)) = True
isNameNeeded :: InScoped Name -> [Symbol] -> Bool
isNameNeeded (pullScopedInfo -> ImportPart symbols) unusedSymbols =
any (`notElem` unusedSymbols) symbols
isNameNeeded _ _ =
True
traverseToClean :: InScoped ImportDecl -> InScoped ImportDecl
traverseToClean decl@ImportDecl{ importSpecs = Just (ImportSpecList _ False []) } =
decl { importSpecs = Nothing }
traverseToClean decl = decl
cleanDecls :: [InScoped ImportDecl] -> [InScoped ImportDecl]
cleanDecls = map removeHidingList . filter isDeclNeeded
where
removeHidingList :: InScoped ImportDecl -> InScoped ImportDecl
removeHidingList decl@ImportDecl{ importSpecs = Just (ImportSpecList _ True []) } =
decl { importSpecs = Nothing }
removeHidingList decl = decl
isDeclNeeded :: InScoped ImportDecl -> Bool
isDeclNeeded = isJust . importSpecs