{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.Refact.DupDef(duplicateDef) where

import qualified Data.Generics as SYB
import qualified GHC.SYB.Utils as SYB

import qualified GHC
import qualified OccName               as GHC

import Data.List
import Data.Maybe

import Language.Haskell.GhcMod
import Language.Haskell.Refact.Utils
import Language.Haskell.Refact.Utils.GhcUtils
import Language.Haskell.Refact.Utils.GhcVersionSpecific
import Language.Haskell.Refact.Utils.LocUtils
import Language.Haskell.Refact.Utils.Monad
import Language.Haskell.Refact.Utils.MonadFunctions
import Language.Haskell.Refact.Utils.TypeSyn
import Language.Haskell.Refact.Utils.TypeUtils

-- ---------------------------------------------------------------------
-- | This refactoring duplicates a definition (function binding or
-- simple pattern binding) at the same level with a new name provided by
-- the user. The new name should not cause name clash/capture.
duplicateDef :: RefactSettings -> Cradle -> FilePath -> String -> SimpPos -> IO [FilePath]
duplicateDef settings cradle fileName newName (row,col) =
  runRefacSession settings cradle (comp fileName newName (row,col))

comp :: FilePath -> String -> SimpPos
     -> RefactGhc [ApplyRefacResult]
comp fileName newName (row, col) = do
      if isVarId newName
        then do
                getModuleGhc fileName
                renamed <- getRefactRenamed
                parsed  <- getRefactParsed

                let (Just (modName,_)) = getModuleName parsed
                let maybePn = locToName (row, col) renamed
                case maybePn of
                  Just pn ->
                       do
                          -- refactoredMod@((_fp,ismod),(_toks',renamed')) <- applyRefac (doDuplicating pn newName) (Just modInfo) fileName
                          (refactoredMod@((_fp,ismod),(_toks',renamed')),_) <- applyRefac (doDuplicating pn newName) (RSFile fileName)
                          case (ismod) of
                            False -> error "The selected identifier is not a function/simple pattern name, or is not defined in this module "
                            True -> return ()

                          if modIsExported modName renamed
                           then do clients <- clientModsAndFiles modName
                                   logm ("DupDef: clients=" ++ (showGhc clients)) -- ++AZ++ debug
                                   refactoredClients <- mapM (refactorInClientMod (GHC.unLoc pn) modName 
                                                             (findNewPName newName renamed')) clients
                                   return $ refactoredMod:refactoredClients
                           else  return [refactoredMod]
                  Nothing -> error "Invalid cursor position!"
        else error $ "Invalid new function name:" ++ newName ++ "!"



doDuplicating :: GHC.Located GHC.Name -> String
              -> RefactGhc ()
doDuplicating pn newName = do
   inscopes <- getRefactInscopes
   renamed  <- getRefactRenamed
   reallyDoDuplicating pn newName inscopes renamed


reallyDoDuplicating :: GHC.Located GHC.Name -> String
              -> InScopes -> GHC.RenamedSource
              -> RefactGhc ()
reallyDoDuplicating pn newName inscopes renamed = do

   renamed' <- everywhereMStaged SYB.Renamer (SYB.mkM dupInMod
                                  `SYB.extM` dupInMatch
                                  `SYB.extM` dupInPat
                                  `SYB.extM` dupInLet
                                  `SYB.extM` dupInLetStmt
                                 ) renamed
   putRefactRenamed renamed'
   return ()

        where
        --1. The definition to be duplicated is at top level.
        -- dupInMod :: (GHC.HsGroup GHC.Name)-> RefactGhc (GHC.HsGroup GHC.Name)
        dupInMod (grp :: (GHC.HsGroup GHC.Name))
          | not $ emptyList (findFunOrPatBind pn (hsBinds grp)) = doDuplicating' inscopes grp pn
        dupInMod grp = return grp

        --2. The definition to be duplicated is a local declaration in a match
        dupInMatch (match@(GHC.Match _pats _typ rhs)::GHC.Match GHC.Name)
          | not $ emptyList (findFunOrPatBind pn (hsBinds rhs)) = doDuplicating' inscopes match pn
        dupInMatch match = return match

        --3. The definition to be duplicated is a local declaration in a pattern binding
        dupInPat (pat@(GHC.PatBind _p rhs _typ _fvs _) :: GHC.HsBind GHC.Name)
          | not $ emptyList (findFunOrPatBind pn (hsBinds rhs)) = doDuplicating' inscopes pat pn
        dupInPat pat = return pat

        --4: The defintion to be duplicated is a local decl in a Let expression
        dupInLet (letExp@(GHC.HsLet ds _e):: GHC.HsExpr GHC.Name)
          | not $ emptyList (findFunOrPatBind pn (hsBinds ds)) = doDuplicating' inscopes letExp pn
        dupInLet letExp = return letExp

        --5. The definition to be duplicated is a local decl in a case alternative.
        -- Note: The local declarations in a case alternative are covered in #2 above.

        --6.The definition to be duplicated is a local decl in a Let statement.
        dupInLetStmt (letStmt@(GHC.LetStmt ds):: GHC.Stmt GHC.Name)
           -- was |findFunOrPatBind pn ds /=[]=doDuplicating' inscps letStmt pn
           |not $ emptyList (findFunOrPatBind pn (hsBinds ds)) = doDuplicating' inscopes letStmt pn
        dupInLetStmt letStmt = return letStmt


        -- findFunOrPatBind :: (SYB.Data t) => GHC.Located GHC.Name -> t -> [GHC.LHsBind GHC.Name]
        findFunOrPatBind (GHC.L _ n) ds = filter (\d->isFunBindR d || isSimplePatBind d) $ definingDeclsNames [n] ds True False


        doDuplicating' :: (HsValBinds t) => InScopes -> t -> GHC.Located GHC.Name
                       -> RefactGhc (t)
        doDuplicating' _inscps parentr ln@(GHC.L _ n)
           = do let
                    declsr = hsBinds parentr

                    duplicatedDecls = definingDeclsNames [n] declsr True False
                    -- (after,before)  = break (definesP pn) (reverse declsp)

                (f,d) <- hsFDNamesFromInside parentr
                    --f: names that might be shadowd by the new name,
                    --d: names that might clash with the new name

                let dv = hsVisibleNames ln declsr --dv: names may shadow new name
                let vars        = nub (f `union` d `union` dv)

                newNameGhc <- mkNewGhcName Nothing newName
                -- TODO: Where definition is of form tup@(h,t), test each element of it for clashes, or disallow
                nameAlreadyInScope <- isInScopeAndUnqualifiedGhc newName Nothing

                -- logm ("DupDef: nameAlreadyInScope =" ++ (show nameAlreadyInScope)) -- ++AZ++ debug
                -- logm ("DupDef: ln =" ++ (show ln)) -- ++AZ++ debug

                if elem newName vars || (nameAlreadyInScope && findEntity ln duplicatedDecls) 
                   then error ("The new name'"++newName++"' will cause name clash/capture or ambiguity problem after "
                               ++ "duplicating, please select another name!")
                   else do newBinding <- duplicateDecl declsr parentr n newNameGhc
                           -- let newDecls = replaceDecls declsr (declsr ++ newBinding)
                           let newDecls = replaceBinds declsr (declsr ++ newBinding)
                           return $ replaceBinds parentr newDecls



-- | Find the the new definition name in GHC.Name format.
findNewPName :: String -> GHC.RenamedSource -> GHC.Name
findNewPName name renamed = gfromJust "findNewPName" res
  where
     res = somethingStaged SYB.Renamer Nothing
            (Nothing `SYB.mkQ` worker) renamed

     worker  (pname::GHC.Name)
        | (GHC.occNameString $ GHC.getOccName pname) == name = Just pname
     worker _ = Nothing


-- | Do refactoring in the client module. That is to hide the
-- identifer in the import declaration if it will cause any problem in
-- the client module.
refactorInClientMod :: GHC.Name -> GHC.ModuleName -> GHC.Name -> GHC.ModSummary
                    -> RefactGhc ApplyRefacResult
refactorInClientMod oldPN serverModName newPName modSummary
  = do
       logm ("refactorInClientMod: (serverModName,newPName)=" ++ (showGhc (serverModName,newPName))) -- ++AZ++ debug
       let fileName = gfromJust "refactorInClientMod" $ GHC.ml_hs_file $ GHC.ms_location modSummary
       -- modInfo@(t,ts) <- getModuleGhc fileName
       getModuleGhc fileName

       renamed <- getRefactRenamed
       parsed <- getRefactParsed

       let modNames = willBeUnQualImportedBy serverModName renamed
       logm ("refactorInClientMod: (modNames)=" ++ (showGhc (modNames))) -- ++AZ++ debug

       -- if isJust modNames && needToBeHided (pNtoName newPName) exps parsed
       mustHide <- needToBeHided newPName renamed parsed
       logm ("refactorInClientMod: (mustHide)=" ++ (showGhc (mustHide))) -- ++AZ++ debug
       if isJust modNames && mustHide
        then do
                -- refactoredMod <- applyRefac (doDuplicatingClient serverModName [newPName]) (Just modInfo) fileName
                (refactoredMod,_) <- applyRefac (doDuplicatingClient serverModName [newPName]) (RSFile fileName)
                return refactoredMod
        else return ((fileName,unmodified),([],renamed))
   where
     needToBeHided :: GHC.Name -> GHC.RenamedSource -> GHC.ParsedSource -> RefactGhc Bool
     needToBeHided name exps parsed = do
         let usedUnqual = usedWithoutQualR name parsed
         logm ("refactorInClientMod: (usedUnqual)=" ++ (showGhc (usedUnqual))) -- ++AZ++ debug
         return $ usedUnqual || causeNameClashInExports oldPN name serverModName exps

doDuplicatingClient :: GHC.ModuleName -> [GHC.Name]
              -> RefactGhc ()
doDuplicatingClient serverModName newPNames = do
  renamed  <- getRefactRenamed
  renamed' <- addHiding serverModName renamed newPNames
  putRefactRenamed renamed'
  return ()

{-
--Do refactoring in the client module.
-- that is to hide the identifer in the import declaration if it will cause any problem in the client module.
refactorInClientMod serverModName newPName (modName, fileName)
  = do (inscps, exps,parsed ,ts) <- parseSourceFile fileName
       let modNames = willBeUnQualImportedBy serverModName parsed
       if isJust modNames && needToBeHided (pNtoName newPName) exps parsed
        then do (parsed', ((ts',m),_))<-runStateT (addHiding serverModName parsed [newPName]) ((ts,unmodified),fileName)
                return ((fileName,m), (ts',parsed'))
        else return ((fileName,unmodified),(ts,parsed))
   where
     needToBeHided name exps parsed
         =usedWithoutQual name (hsModDecls parsed)
          || causeNameClashInExports newPName name parsed exps
-}



--Check here:
-- | get the module name or alias name by which the duplicated
-- definition will be imported automatically.
willBeUnQualImportedBy :: GHC.ModuleName -> GHC.RenamedSource -> Maybe [GHC.ModuleName]
willBeUnQualImportedBy modName (_,imps,_,_)
   = let
         ms = filter (\(GHC.L _ (GHC.ImportDecl (GHC.L _ modName1) _qualify _source _safe isQualified _isImplicit _as h))
                    -> modName == modName1
                       && not isQualified
                              && (isNothing h  -- not hiding
                                  ||
                                   (isJust h && ((fst (fromJust h))==True))
                                  ))
                      imps
         in if (emptyList ms) then Nothing
                      else Just $ nub $ map getModName ms

         where getModName (GHC.L _ (GHC.ImportDecl _modName1 _qualify _source _safe _isQualified _isImplicit as _h))
                 = if isJust as then (fromJust as)
                                else modName
               -- simpModName (SN m loc) = m

{- ++AZ++ original
--Check here:
--get the module name or alias name by which the duplicated definition will be imported automatically.
willBeUnQualImportedBy::HsName.ModuleName->HsModuleP->Maybe [HsName.ModuleName]
willBeUnQualImportedBy modName parsed
   = let imps = hsModImports parsed
         ms   = filter (\(HsImportDecl _ (SN modName1 _) qualify  as h)->modName==modName1 && (not qualify) && 
                          (isNothing h || (isJust h && ((fst (fromJust h))==True)))) imps
         in if ms==[] then Nothing
                      else Just $ nub $ map getModName ms

         where getModName (HsImportDecl _ (SN modName _) qualify  as h)
                 = if isJust as then simpModName (fromJust as)
                                else modName
               simpModName (SN m loc) = m

-}