src/Importify/Tree.hs
{-# 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@ wrapper for list of unused symbols.
newtype UnusedSymbols = UnusedSymbols { getUnusedSymbols :: [Symbol] }
-- | @newtype@ wrapper for list of unused symbols from @hiding@.
newtype UnusedHidings = UnusedHidings { getUnusedHidings :: [Symbol] }
-- | Remove a list of identifiers from 'ImportDecl's.
-- Next algorithm is used:
--
-- 1. Remove all identifiers inside specified list of types.
-- If list becomes empty then only type left.
-- @
-- import Module.Name (Type (HERE)) ⇒ import Module.Name (Type)
-- @
--
-- 2. Traverse every 'ImportSpec's and check matching with symbols.
-- @
-- import Module.Name (Type (something), HERE) ⇒ import Module.Name (Type (something))
-- @
--
-- 3. Translate empty imports into implicit import.
-- @
-- import Module.Name () ⇒ import Module.Name
-- @
--
-- 4. Remove all implicit imports preserving only initially implicit or empty.
removeImports :: UnusedSymbols -- ^ List of symbols which should be removed
-> UnusedHidings -- ^ List of hidings which should be removed
-> [InScoped ImportDecl] -- ^ Imports to be purified
-> [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
-- | Returns 'True' if the import is of either of the forms:
-- @
-- import Foo ()
-- import Foo
-- @
--
isVolatileImport :: InScoped ImportDecl -> Bool
isVolatileImport ImportDecl{ importSpecs = Just (ImportSpecList _ _ []) } = True
isVolatileImport ImportDecl{ importSpecs = Nothing } = True
isVolatileImport _ = False
-- | Traverses 'ImportDecl's to remove symbols from 'IThingWith' specs.
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
-- | Traverses 'ImportSpecList' to remove identifiers from those lists.
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
-- | Removes 'SrcSpanInfo' points of deleted elements.
removeSrcSpanInfoPoints :: (a -> Bool) -- ^ Keep entitity?
-> [a] -- ^ List of entities
-> SrcSpanInfo -- ^ Span info with points
-> ([a], SrcSpanInfo) -- ^ Kept entities and info w/o points
removeSrcSpanInfoPoints shouldKeepEntity entities SrcSpanInfo{..} =
let indexedEntities = zip [1..] entities
(neededEntities, unusedEntities) = partition (shouldKeepEntity . snd)
indexedEntities
pointsCount = length srcInfoPoints
unusedIds = filter (< pointsCount) -- don't remove index of ')'
$ map fst unusedEntities
newPoints = removeAtMultiple unusedIds srcInfoPoints
in (map snd neededEntities, SrcSpanInfo srcInfoSpan newPoints)
-- | Returns 'False' if 'ImportSpec' is not needed.
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 -- Do not remove if cnames list is not empty
-- | Returns 'False' if 'Name' is not needed. On top level
-- elements inside 'ImportSpec' annotated by 'ImportPart'. But
-- this constructor contains list of symbols. So it's needed if
-- at least one element inside list is needed.
isNameNeeded :: InScoped Name -> [Symbol] -> Bool
isNameNeeded (pullScopedInfo -> ImportPart symbols) unusedSymbols =
any (`notElem` unusedSymbols) symbols
isNameNeeded _ _ =
True
-- | Traverses 'ImportDecl's to remove empty non-@hiding@ import specs.
traverseToClean :: InScoped ImportDecl -> InScoped ImportDecl
traverseToClean decl@ImportDecl{ importSpecs = Just (ImportSpecList _ False []) } =
decl { importSpecs = Nothing }
traverseToClean decl = decl
-- | First remove all imports with no lists and then remove
-- 'ImportSpecList' from empty @hiding@ imports.
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