content: {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeSynonymInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  
  module Language.Haskell.Refact.Refactoring.DupDef
    ( duplicateDef
    , compDuplicateDef ) where
  
  import qualified Data.Generics as SYB
  import qualified GHC.SYB.Utils as SYB
  
  import qualified GHC
  import qualified RdrName       as GHC
  
  import Data.List
  import Data.Maybe
  
  import qualified GhcMod       as GM
  import qualified GhcMod.Types as GM
  import Language.Haskell.Refact.API
  
  import Language.Haskell.GHC.ExactPrint.Types
  import Language.Haskell.GHC.ExactPrint.Transform
  
  import System.Directory
  
  -- ---------------------------------------------------------------------
  -- | 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 -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]
  duplicateDef settings opts fileName newName (row,col) = do
    absFileName <- canonicalizePath fileName
    runRefacSession settings opts (compDuplicateDef absFileName newName (row,col))
  
  compDuplicateDef :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]
  compDuplicateDef fileName newName (row, col) = do
    if isVarId newName
      then
        do
          parseSourceFileGhc fileName
          renamed <- getRefactRenamed
          parsed  <- getRefactParsed
          nm <- getRefactNameMap
          targetModule <- getRefactTargetModule
          logm $ "DupDef.compDuplicateDef:got targetModule"
  
          let (Just (modName,_)) = getModuleName parsed
          let maybePn = locToRdrName (row,col) parsed
          -- let maybePn = locToNameRdrPure nm (row, col) parsed
          case maybePn of
            Just lr@(GHC.L l _) ->
              do
                let pn = GHC.L l (rdrName2NamePure nm lr)
                logm $ "DupDef.compDuplicateDef:about to applyRefac for:pn=" ++ SYB.showData SYB.Parser 0 pn
                (refactoredMod,(isDone,nn)) <- applyRefac (doDuplicating pn newName) (RSFile fileName)
                logm $ "DupDef.com:isDone=" ++ show isDone
                case isDone of
                  DupDefFailed -> error "The selected identifier is not a function/simple pattern name, or is not defined in this module "
                  DupDefLowerLevel -> return [refactoredMod]
                  DupDefTopLevel -> do
                    if modIsExported modName renamed
                     then
                      do
                         logm $ "DupDef.compDuplicateDef:about to clientMods"
                         clients <- clientModsAndFiles targetModule
                         logm ("DupDef: clients=" ++ (showGhc clients)) -- ++AZ++ debug
                         refactoredClients <- mapM (refactorInClientMod (GHC.unLoc pn) modName nn)
                                                   clients
                         return $ refactoredMod:refactoredClients
                     else return [refactoredMod]
            Nothing -> error "Invalid cursor position!"
      else error $ "Invalid new function name:" ++ newName ++ "!"
  
  
  data DupDefResult = DupDefFailed | DupDefTopLevel | DupDefLowerLevel
                    deriving (Eq,Show)
  
  doDuplicating :: GHC.Located GHC.Name -> String
                -> RefactGhc (DupDefResult,GHC.Name)
  doDuplicating pn newName = do
     logm $ "DupDef.compDuplicateDef:doDuplicating entered"
     inscopes <- getRefactInscopes
     logm $ "DupDef.compDuplicateDef:doDuplicating got inscopes"
     reallyDoDuplicating pn newName inscopes
  
  
  reallyDoDuplicating :: GHC.Located GHC.Name -> String
                -> InScopes
                -> RefactGhc (DupDefResult,GHC.Name)
  reallyDoDuplicating pn newName _inscopes = do
     clearRefactDone
     parsed <- getRefactParsed
     newNameGhc <- mkNewGhcName Nothing newName
  
     -- Check if it is a top level dup
     parsed2 <- dupInModule newNameGhc parsed
     d <- getRefactDone
     if d
       then do
         putRefactParsed parsed2 emptyAnns
         return (DupDefTopLevel,newNameGhc)
       else do
         parsed' <- SYB.everywhereMStaged SYB.Parser (
                                        SYB.mkM    (dupInMatch   newNameGhc)
                                        `SYB.extM` (dupInPat     newNameGhc)
                                        `SYB.extM` (dupInLet     newNameGhc)
                                        `SYB.extM` (dupInLetStmt newNameGhc)
                                       ) parsed2
         putRefactParsed parsed' emptyAnns
         done <- getRefactDone
         if done then return (DupDefLowerLevel,newNameGhc)
                 else return (DupDefFailed,newNameGhc)
  
          where
          --1. The definition to be duplicated is at top level.
          dupInModule :: GHC.Name -> GHC.ParsedSource -> RefactGhc GHC.ParsedSource
          dupInModule newNameGhc p
            = do
                declsp <- liftT $ hsDecls p
                nm <- getRefactNameMap
                if not $ emptyList (findFunOrPatBind nm pn declsp)
                  then doDuplicating' newNameGhc p pn
                  else return p
  
          --2. The definition to be duplicated is a local declaration in a match
          dupInMatch newNameGhc (match::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
            = do
                nm <- getRefactNameMap
                declsp <- liftT $ hsDecls match
                logm $ "dupInMatch:declsp=" ++ showGhc declsp
                if not $ emptyList (findFunOrPatBind nm pn declsp)
                  then doDuplicating' newNameGhc match pn
                  else return match
  
          --3. The definition to be duplicated is a local declaration in a pattern binding
          dupInPat newNameGhc (pat@(GHC.L _ (GHC.ValD (GHC.PatBind _p _rhs _typ _fvs _))) :: GHC.LHsDecl GHC.RdrName)
            = do
              logm $ "dupInPat hit"
              doDuplicating' newNameGhc pat pn
          dupInPat _ pat = return pat
  
          --4: The defintion to be duplicated is a local decl in a Let expression
          dupInLet newNameGhc (letExp@(GHC.L _ (GHC.HsLet _ds _e)):: GHC.LHsExpr GHC.RdrName)
            = doDuplicating' newNameGhc 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 newNameGhc (letStmt@(GHC.L _ (GHC.LetStmt _ds)):: GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName))
            = doDuplicating' newNameGhc letStmt pn
          dupInLetStmt _ letStmt = return letStmt
  
  
          findFunOrPatBind nm (GHC.L _ n) ds
            = filter (\d->isFunBindP d || isSimplePatDecl d) $ definingDeclsRdrNames nm [n] ds True False
  
  
          doDuplicating' :: (SYB.Data t) => GHC.Name -> t -> GHC.Located GHC.Name -> RefactGhc t
          doDuplicating' newNameGhc t _ln = do
            logm $ "doDuplicating' entered"
            -- logm $ "doDuplicating' entered:t=" ++ SYB.showData SYB.Parser 0 t
            -- declsp <- liftT $ hsDecls t
            declsp <- liftT $ hsDeclsGeneric t
            nm <- getRefactNameMap
            if not $ emptyList (findFunOrPatBind nm pn declsp)
              then doDuplicating'' newNameGhc t pn
              else return t
  
  
          doDuplicating'' :: (SYB.Data t) => GHC.Name -> t -> GHC.Located GHC.Name
                         -> RefactGhc t
          doDuplicating'' newNameGhc parentr ln = do
            -- logm $ "doDuplicating'':parentr=" ++ SYB.showData SYB.Parser 0 parentr
            r <- hasDeclsSybTransform workerHsDecls workerBind parentr
            logm $ "doDuplicating'':done"
            return r
            where
                workerHsDecls :: forall t. HasDecls t => t -> RefactGhc t
                workerHsDecls t = do
                  logm $ "workerHsDecls hit"
                  ds <- liftT $ hsDecls t
                  ds' <- doDuplicating3 newNameGhc parentr ln ds
                  liftT $ replaceDecls t ds'
  
                workerBind :: (GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName))
                workerBind t@(GHC.L _ (GHC.PatBind{})) = do
                  logm $ "workerBind hit"
                  ds <- liftT $ hsDeclsPatBind t
                  ds' <- doDuplicating3 newNameGhc t ln ds
                  liftT $ replaceDeclsPatBind t ds'
                workerBind x = error $ "DupDef.doDuplicating'':workerBind got:" ++ showGhc x
  
          doDuplicating3 :: (SYB.Data t) => GHC.Name -> t -> GHC.Located GHC.Name
                         -> [GHC.LHsDecl GHC.RdrName]
                         -> RefactGhc [GHC.LHsDecl GHC.RdrName]
          doDuplicating3 newNameGhc parentr ln@(GHC.L _ n) declsp
             = do
                  logm $ "doDuplicating'' entered:ln" ++ showGhc ln
                  -- declsp <- liftT $ hsDecls parentr
                  nm <- getRefactNameMap
                  let
                      duplicatedDecls = definingDeclsRdrNames nm [n] declsp True False
  
                  logm $ "doDuplicating'':duplicatedDecls=" ++ showGhc duplicatedDecls
                  (f,d) <- hsFDNamesFromInsideRdr parentr
                      --f: names that might be shadowd by the new name,
                      --d: names that might clash with the new name
  
                  logm $ "doDuplicating'':(f,d)=" ++ show (f,d)
                  DN dv <- hsVisibleDsRdr nm n declsp --dv: names may shadow new name
                  let vars        = nub (f `union` d `union` map showGhc dv)
  
                  -- TODO: Where definition is of form tup@(h,t), test each element of it for clashes, or disallow
                  nameAlreadyInScope <- isInScopeAndUnqualifiedGhc newName Nothing
  
                  if elem newName vars || (nameAlreadyInScope && findNameInRdr nm n duplicatedDecls)
                     then error ("The new name'"++newName++"' will cause name clash/capture or ambiguity problem after "
                                 ++ "duplicating, please select another name!")
                     else do
                             setRefactDone
                             newdecls <- duplicateDecl declsp n newNameGhc
                             -- parentr' <- liftT $ replaceDecls parentr newdecls
                             -- return parentr'
                             return newdecls
  
  
  -- | 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 -> TargetModule
                      -> RefactGhc ApplyRefacResult
  refactorInClientMod oldPN serverModName newPName targetModule
    = do
         logm ("refactorInClientMod: (oldPN,serverModName,newPName)=" ++ (showGhc (oldPN,serverModName,newPName)))
         getTargetGhc targetModule
  
         let fileName = GM.mpPath targetModule
         renamed <- getRefactRenamed
         parsed  <- getRefactParsed
  
         logm $ "refactorInClientMod:got newPName:" ++ showGhcQual newPName
         let modNames = willBeUnQualImportedBy serverModName renamed
         logm ("refactorInClientMod: (modNames)=" ++ (showGhc (modNames))) -- ++AZ++ debug
  
         mustHide <- needToBeHided newPName parsed
         logm ("refactorInClientMod: (mustHide)=" ++ (showGhc (mustHide))) -- ++AZ++ debug
         if isJust modNames && mustHide
          then do
                  (refactoredMod,_) <- applyRefac (doDuplicatingClient serverModName [newPName]) (RSFile fileName)
                  return refactoredMod
          else return ((fileName,RefacUnmodifed),(emptyAnns,parsed))
     where
       needToBeHided :: GHC.Name -> GHC.ParsedSource -> RefactGhc Bool
       needToBeHided name parsed = do
           -- logDataWithAnns "refactorInClientMod.needToBeHided:parsed" parsed
           -- logm $ "refactorInClientMod.needToBeHided:name=" ++ showGhcQual name
           nm <- getRefactNameMap
           logm $ "refactorInClientMod.needToBeHided:nm=" ++ showGhcQual nm
           let usedUnqual = usedWithoutQualR name parsed
           logm ("refactorInClientMod: (usedUnqual)=" ++ (showGhc (usedUnqual))) -- ++AZ++ debug
           return $ usedUnqual || causeNameClashInExports nm oldPN name serverModName parsed
  
  doDuplicatingClient :: GHC.ModuleName -> [GHC.Name]
                -> RefactGhc ()
  doDuplicatingClient serverModName newPNames = do
    logm $ "doDuplicatingClient:newPNames=" ++ showGhc newPNames
    parsed  <- getRefactParsed
    parsed' <- addHiding serverModName parsed (map GHC.nameRdrName newPNames)
    putRefactParsed parsed' emptyAnns
    return ()
  
  
  
  --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 (gfromJust "willBeUnQualImportedBy" 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
  