<commit_before>{-# LANGUAGE ScopedTypeVariables #-}
-- module Language.Haskell.Refact.Refactoring.AddRmParam(addOneParameter,rmOneParameter) where
module Language.Haskell.Refact.Refactoring.AddRmParam(addOneParameter) where

-- import PosSyntax
-- import TypedIds
-- import UniqueNames hiding (srcLoc)
-- import PNT
-- import TiPNT

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

import qualified GHC
import qualified RdrName               as GHC

import qualified Language.Haskell.GhcMod as GM
import Language.Haskell.GhcMod.Internal  as GM
import Language.Haskell.Refact.API

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Transform

import System.Directory
import Data.Maybe
import Data.List hiding (delete)
-- import RefacUtils
-- import Data.Char

import Data.Generics.Strafunski.StrategyLib.StrategyLib

import Control.Exception

-----------------------------------------------------------------------------------------------------
{- An argument can be added to the definition of a function or constant. Adding an argument to a constant
   definition will change the constant definition to a function definition.  The new parameter is always
   added as the first parameter of the function. A default parameter will be added as the first argument
   to each of the function's call site. Suppose a new  parameter named 'p' is added to function 'f',
   then default parameter will be defined automatically as p_f_i=undefined, where 'i' is an integer.
   To ensure that the default parameter name does not cause name clash in the client modules, we take the
   visble names both in the current module and in the client modules into account when creating the
   name.

-}
-----------------------------------------------------------------------------------------------------

addOneParameter :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]
addOneParameter settings opts fileName paramName (row,col) = do
  absFileName <- canonicalizePath fileName
  runRefacSession settings opts (compAdd absFileName paramName (row,col))

compAdd :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]
compAdd fileName paramName (row, col) = do
  if isVarId paramName
    then
      do
        parseSourceFileGhc fileName
        renamed <- getRefactRenamed
        parsed  <- getRefactParsed
        targetModule <- getRefactTargetModule
        logm $ "AddRmParam.compAdd:got targetModule"
        let (Just (modName,_)) = getModuleName parsed
        let maybePn = locToName (row, col) renamed
        case maybePn of
          Just pnt@(GHC.L _ pn) ->
            do
              logm $ "AddRmParam.compAdd:about to applyRefac for:pn=" ++ SYB.showData SYB.Parser 0 pn
              -- make sure this name is defined in this module
              if isFunOrPatName pn renamed
               then do
                  exported <- isExported pn
                  if exported
                    then do
                      assert False undefined
                    else do
                     (refactoredMod,_) <- applyRefac (doAddingParam undefined modName pn paramName Nothing False) (RSFile fileName)
                     return [refactoredMod]

               else error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
          Nothing -> error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
    else error $ "Invalid parameter name:" ++ paramName ++ "!"

{-
addOneParameter args
 = let fileName = args!!0
       paramName= args!!1
       row      = read (args!!2)::Int
       col      = read (args!!3)::Int
   in if isVarId paramName
      then do modName <-fileNameToModName fileName
              (inscps, exps, mod, tokList)<-parseSourceFile fileName
              let pnt@(PNT pn _ _)=locToPNT fileName  (row, col) mod
              --make sure this name is defined in this module
              if pn /= defaultPN && isFunOrPatName pn mod
               then if isExported pnt exps
                    then do clients <- clientModsAndFiles modName
                            info    <- mapM parseSourceFile $ map snd  clients
                            defaultArg <-mkTopLevelDefaultArgName pn paramName fileName modName
                                            ( map (\(x, _,_,_)->x) (concatMap inScopeInfo (map myfst info))) (hsDecls mod)
                            (mod',((ts',m), _))<-doAddingParam fileName  modName pn paramName
                                                    (Just defaultArg) True  mod tokList
                            refactoredClients<-mapM (addArgInClientMod pnt defaultArg modName) $ zip info (map snd clients)
                            writeRefactoredFiles False $ ((fileName,m),(ts',mod')):refactoredClients
                    else do (mod',((ts',m),_))<-doAddingParam fileName  modName pn paramName Nothing  False mod tokList
                            writeRefactoredFiles False [((fileName,m),(ts',mod'))]
               else error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
      else error "Invalid parameter name!\n"
-}

-- ---------------------------------------------------------------------

doAddingParam :: FilePath -> GHC.ModuleName -> GHC.Name -> String -> Maybe String -> Bool
              -> RefactGhc ()
doAddingParam fileName modName pn newParam defaultArg isExported = do
    parsed <- getRefactParsed
    r <- applyTP (once_tdTP (failTP `adhocTP` inMod
                                    -- `adhocTP` inMatch
                                    -- `adhocTP` inPat
                                    -- `adhocTP` inLet
                                    -- `adhocTP` inAlt
                                    -- `adhocTP` inLetStmt
                            )
                           `choiceTP` failure) parsed
    putRefactParsed r emptyAnns
    return ()
      where
             --1.pn is declared in top level
             -- inMod (mod@(HsModule loc name exps imps ds):: HsModuleP)
             --   | definingDecls [pn] ds False  False/=[]
             --   = do mod'<-doAdding mod  ds
             --        if isExported && isExplicitlyExported pn mod
             --          then addItemsToExport mod' (Just pn) False (Left [pNtoName (fromJust defaultArg)])
             --          else return mod'
             -- inMod _ = mzero
             inMod (modu :: GHC.HsModule GHC.RdrName) = do
               nm <- getRefactNameMap
               if definingDeclsRdrNames nm [pn] modu /= []
                then
                 do
                    ds <- liftT $ hsDecls modu
                    modu' <- doAdding modu ds
                    if isExported && isExplicitlyExported pn modu
                      then addItemsToExport modu' (Just pn) False (Left [(fromJust defaultArg)])
                      else return modu'
                else return mzero

{-
             --2. pn is declared locally in the where clause of a match.
             inMatch (match@(HsMatch loc1 name pats rhs ds)::HsMatchP)
               | definingDecls [pn] ds False  False/=[]  = doAdding match  ds
             inMatch _ = mzero

             --3. pn is declared locally in the where clause of a pattern binding.
             inPat (pat@(Dec (HsPatBind loc p rhs ds))::HsDeclP)
               | definingDecls [pn] ds False  False/=[]  = doAdding pat  ds
             inPat _ = mzero

             --4: pn is declared locally in a  Let expression
             inLet (letExp@(Exp (HsLet ds e))::HsExpP)
               | definingDecls [pn] ds False False /=[] = doAdding letExp  ds
             inLet _ = mzero

             --5. pn is declared locally in a  case alternative.
             inAlt (alt@(HsAlt loc p rhs ds)::HsAltP)
               | definingDecls [pn] ds False  False/=[] = doAdding  alt  ds
             inAlt _ = mzero

             --6.pn is declared locally in a let statement.
             inLetStmt (letStmt@(HsLetStmt ds stmts):: HsStmtP)
               | definingDecls [pn] ds False  False/=[]  = doAdding letStmt ds
             inLetStmt _ = mzero
-}
             failure = idTP `adhocTP` mod
               where modu (m::GHC.ParsedSource) = error "Refactoring failed"

             doAdding parent ds
               = if paramNameOk pn newParam ds
                   then
                    do ds' <- addParamsToDecls ds pn [mkRdrName newParam] True  --addFormalParam pn newParam ds
                       defaultParamPName <-if isNothing defaultArg
                                           then mkLocalDefaultArgName pn newParam modName parent
                                           else return (fromJust defaultArg)
                       parent' <- addDefaultActualArg False pn defaultParamPName (replaceDecls parent ds')
                       parent''<- addDefaultActualArgDecl defaultParamPName  parent' pn isExported
                       ds'' <- addArgToSig pn (hsDecls parent'')
                       return (replaceDecls parent'' ds'')
                   else error " Refactoring failed."
{-
doAddingParam fileName modName pn newParam defaultArg isExported mod tokList
    =  runStateT (applyTP (once_tdTP (failTP `adhocTP` inMod
                                             `adhocTP` inMatch
                                             `adhocTP` inPat
                                             `adhocTP` inLet
                                             `adhocTP` inAlt<commit_msg>Brute force fix compile<commit_after>{-# LANGUAGE ScopedTypeVariables #-}
-- module Language.Haskell.Refact.Refactoring.AddRmParam(addOneParameter,rmOneParameter) where
module Language.Haskell.Refact.Refactoring.AddRmParam(addOneParameter) where

-- import PosSyntax
-- import TypedIds
-- import UniqueNames hiding (srcLoc)
-- import PNT
-- import TiPNT

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

import qualified GHC
import qualified RdrName               as GHC

import qualified Language.Haskell.GhcMod as GM
import Language.Haskell.GhcMod.Internal  as GM
import Language.Haskell.Refact.API

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Transform

import System.Directory
import Data.Maybe
import Data.List hiding (delete)
-- import RefacUtils
-- import Data.Char

import Data.Generics.Strafunski.StrategyLib.StrategyLib

import Control.Exception

-----------------------------------------------------------------------------------------------------
{- An argument can be added to the definition of a function or constant. Adding an argument to a constant
   definition will change the constant definition to a function definition.  The new parameter is always
   added as the first parameter of the function. A default parameter will be added as the first argument
   to each of the function's call site. Suppose a new  parameter named 'p' is added to function 'f',
   then default parameter will be defined automatically as p_f_i=undefined, where 'i' is an integer.
   To ensure that the default parameter name does not cause name clash in the client modules, we take the
   visble names both in the current module and in the client modules into account when creating the
   name.

-}
-----------------------------------------------------------------------------------------------------

addOneParameter :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]
addOneParameter settings opts fileName paramName (row,col) = do
  absFileName <- canonicalizePath fileName
  runRefacSession settings opts (compAdd absFileName paramName (row,col))

compAdd :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]
compAdd fileName paramName (row, col) = do
  if isVarId paramName
    then
      do
        parseSourceFileGhc fileName
        renamed <- getRefactRenamed
        parsed  <- getRefactParsed
        targetModule <- getRefactTargetModule
        logm $ "AddRmParam.compAdd:got targetModule"
        let (Just (modName,_)) = getModuleName parsed
        let maybePn = locToName (row, col) renamed
        case maybePn of
          Just pnt@(GHC.L _ pn) ->
            do
              logm $ "AddRmParam.compAdd:about to applyRefac for:pn=" ++ SYB.showData SYB.Parser 0 pn
              -- make sure this name is defined in this module
              if isFunOrPatName pn renamed
               then do
                  exported <- isExported pn
                  if exported
                    then do
                      assert False undefined
                    else do
                     (refactoredMod,_) <- applyRefac (doAddingParam undefined modName pn paramName Nothing False) (RSFile fileName)
                     return [refactoredMod]

               else error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
          Nothing -> error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
    else error $ "Invalid parameter name:" ++ paramName ++ "!"

{-
addOneParameter args
 = let fileName = args!!0
       paramName= args!!1
       row      = read (args!!2)::Int
       col      = read (args!!3)::Int
   in if isVarId paramName
      then do modName <-fileNameToModName fileName
              (inscps, exps, mod, tokList)<-parseSourceFile fileName
              let pnt@(PNT pn _ _)=locToPNT fileName  (row, col) mod
              --make sure this name is defined in this module
              if pn /= defaultPN && isFunOrPatName pn mod
               then if isExported pnt exps
                    then do clients <- clientModsAndFiles modName
                            info    <- mapM parseSourceFile $ map snd  clients
                            defaultArg <-mkTopLevelDefaultArgName pn paramName fileName modName
                                            ( map (\(x, _,_,_)->x) (concatMap inScopeInfo (map myfst info))) (hsDecls mod)
                            (mod',((ts',m), _))<-doAddingParam fileName  modName pn paramName
                                                    (Just defaultArg) True  mod tokList
                            refactoredClients<-mapM (addArgInClientMod pnt defaultArg modName) $ zip info (map snd clients)
                            writeRefactoredFiles False $ ((fileName,m),(ts',mod')):refactoredClients
                    else do (mod',((ts',m),_))<-doAddingParam fileName  modName pn paramName Nothing  False mod tokList
                            writeRefactoredFiles False [((fileName,m),(ts',mod'))]
               else error "Invalid cursor position or identifier is not a function/pattern name defined in this module!\n"
      else error "Invalid parameter name!\n"
-}

-- ---------------------------------------------------------------------

doAddingParam :: FilePath -> GHC.ModuleName -> GHC.Name -> String -> Maybe String -> Bool
              -> RefactGhc ()
doAddingParam fileName modName pn newParam defaultArg isExported = do
    assert False undefined
    {-
    parsed <- getRefactParsed
    r <- applyTP (once_tdTP (failTP `adhocTP` inMod
                                    -- `adhocTP` inMatch
                                    -- `adhocTP` inPat
                                    -- `adhocTP` inLet
                                    -- `adhocTP` inAlt
                                    -- `adhocTP` inLetStmt
                            )
                           `choiceTP` failure) parsed
    putRefactParsed r emptyAnns
    return ()
      where
             --1.pn is declared in top level
             -- inMod (mod@(HsModule loc name exps imps ds):: HsModuleP)
             --   | definingDecls [pn] ds False  False/=[]
             --   = do mod'<-doAdding mod  ds
             --        if isExported && isExplicitlyExported pn mod
             --          then addItemsToExport mod' (Just pn) False (Left [pNtoName (fromJust defaultArg)])
             --          else return mod'
             -- inMod _ = mzero
             inMod (modu :: GHC.HsModule GHC.RdrName) = do
               nm <- getRefactNameMap
               if definingDeclsRdrNames nm [pn] modu /= []
                then
                 do
                    ds <- liftT $ hsDecls modu
                    modu' <- doAdding modu ds
                    if isExported && isExplicitlyExported pn modu
                      then addItemsToExport modu' (Just pn) False (Left [(fromJust defaultArg)])
                      else return modu'
                else return mzero

{-
             --2. pn is declared locally in the where clause of a match.
             inMatch (match@(HsMatch loc1 name pats rhs ds)::HsMatchP)
               | definingDecls [pn] ds False  False/=[]  = doAdding match  ds
             inMatch _ = mzero

             --3. pn is declared locally in the where clause of a pattern binding.
             inPat (pat@(Dec (HsPatBind loc p rhs ds))::HsDeclP)
               | definingDecls [pn] ds False  False/=[]  = doAdding pat  ds
             inPat _ = mzero

             --4: pn is declared locally in a  Let expression
             inLet (letExp@(Exp (HsLet ds e))::HsExpP)
               | definingDecls [pn] ds False False /=[] = doAdding letExp  ds
             inLet _ = mzero

             --5. pn is declared locally in a  case alternative.
             inAlt (alt@(HsAlt loc p rhs ds)::HsAltP)
               | definingDecls [pn] ds False  False/=[] = doAdding  alt  ds
             inAlt _ = mzero

             --6.pn is declared locally in a let statement.
             inLetStmt (letStmt@(HsLetStmt ds stmts):: HsStmtP)
               | definingDecls [pn] ds False  False/=[]  = doAdding letStmt ds
             inLetStmt _ = mzero
-}
             failure = idTP `adhocTP` mod
               where modu (m::GHC.ParsedSource) = error "Refactoring failed"

             doAdding parent ds
               = if paramNameOk pn newParam ds
                   then
                    do ds' <- addParamsToDecls ds pn [mkRdrName newParam] True  --addFormalParam pn newParam ds
                       defaultParamPName <-if isNothing defaultArg
                                           then mkLocalDefaultArgName pn newParam modName parent
                                           else return (fromJust defaultArg)
                       parent' <- addDefaultActualArg False pn defaultParamPName (replaceDecls parent ds')
                       parent''<- addDefaultActualArgDecl defaultParamPName  parent' pn isExported
                       ds'' <- addArgToSig pn (hsDecls parent'')
                       return (replaceDecls parent'' ds'')
                   else error " Refactoring failed."
-}
-- ---------------------------------------------------------------------
{-
doAddingParam fileName modName pn newParam defaultArg isExported mod tokList
    =  runStateT (applyTP (once_tdTP (failTP `adhocTP` inMod
                                             `adhocTP` inMatch
                                             `adhocTP` inPat
                                             `adhocTP` inLet
                                             `adhocTP` inAlt
{'fraction_non_alphanumeric': 0.10051948051948052, 'fraction_numerical': 0.0012467532467532467, 'mean_word_length': 1.5979757085020243, 'pattern_counts': {'":': 0, '<': 53, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 42, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7244993', 'n_tokens_mistral': 5018, 'n_tokens_neox': 4832, 'n_words': 1693}