{-# 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